Trac の WikiName を !WikiName にエスケープしたり戻したり #xyzzy

gistfile1.cl

;; M-x trac-escape-wikiname-buffer
;; M-x trac-escape-wikiname-region
;;   Trac の WikiName がリンクにならないように !WikiName という形式にエスケープする。
;; 
;; M-x trac-unescape-wikiname-buffer
;; M-x trac-unescape-wikiname-region
;;   !WikiName を WikiName に戻す。
;;   C-u M-x で実行すると {{{ }}} やリンクの中の !WikiName も元に戻す。
;;

(defparameter *trac-pre-beg-pattern* "{{{")                                ; Preformatted text start
(defparameter *trac-pre-end-pattern* "}}}")                                ; Preformatted text end
(defparameter *trac-link-pattern* "\\[.+?\\]")                             ; Link, Plugin
(defparameter *trac-url-pattern* "[a-z]+://[^ \n]+")                       ; URL

;; MyClass     => !MyClass
;; My/Class    => !My/Class
;; MyClass2    => !MyClass2
;; MyClassFOO  => MyClassFOO
;; P/Invoke    => P/Invoke
;; IAction     => IAction
(defparameter *trac-wikiname-pattern* "\\b\\(?:[A-Z][a-z][a-z/]*\\)\\{2,\\}") ; WikiName

(defun trac-escape-wikiname-buffer ()
  "Trac の WikiName がリンクにならないように ! でエスケープ"
  (interactive "*")
  (trac-escape-wikiname-region (point-min) (point-max)))

(defun trac-unescape-wikiname-buffer ()
  "Trac の WikiName のエスケープを解除"
  (interactive "*")
  (trac-unescape-wikiname-region (point-min) (point-max)))

(defun trac-escape-wikiname-region (s e)
  "リージョン内の Trac の WikiName がリンクにならないように ! でエスケープ"
  (interactive "*r")
  (walk-trac-wikiname s e #'(lambda (str beg end)
                              (when (and (char/= (char-before beg) #\!)
                                         (not (alpha-char-p (char-after end))))
                                (insert "!")))
                      :tail nil :bare-wikiname-only t))

(defun trac-unescape-wikiname-region (s e)
  "リージョン内の Trac の WikiName のエスケープを解除"
  (interactive "*r")
  (walk-trac-wikiname s e #'(lambda (str beg end)
                              (when (char= (char-before beg) #\!)
                                (delete-backward-char)))
                      :tail nil :bare-wikiname-only (not *prefix-args*)))

(defun walk-trac-wikiname (s e fn &key bare-wikiname-only tail)
  (if (< e s) (rotatef s e))
  (save-excursion
    (save-restriction
      (narrow-to-region s e)
      (goto-char s)
      (multiple-value-bind (patterns num-pre num-wikiname)
          (if bare-wikiname-only
              (values
               ;; {{{ }}} やリンクの中は置換しないようにするため先にマッチさせる
               (list *trac-pre-beg-pattern*
                     *trac-link-pattern*
                     *trac-url-pattern*
                     *trac-wikiname-pattern*)
               1 4)
            (values
             ;; {{{ }}} やリンクの中も置換する
             (list *trac-wikiname-pattern*)
             nil 1))
        (let ((regexp (format nil "\\(?:~{\\(~A\\)~^\\|~}\\)" patterns)))
          (while (scan-buffer regexp :regexp t :tail nil :no-dup t)
            (let ((pre (and num-pre (match-string num-pre)))
                  (str (match-string num-wikiname))
                  (beg (match-beginning num-wikiname))
                  (end (match-end num-wikiname)))
              (if pre
                  ;; 閉じ }}} がない場合はそこで終了
                  (or (scan-buffer *trac-pre-end-pattern*)
                      (return))
                (progn
                  (when str
                    (funcall fn str beg end))
                  (goto-char (match-end 0)))))))
        ))))