Perl風の正規表現をxyzzyの正規表現に変換するリーダーマクロ

regexp-reader.l

;;; regexp-reader for xyzzy

;;  #/(a+)b/
;;    -> "\\(a+\\)b"
;;  #/(a|b|xyz){2,3}/
;;    -> "\\(a\\|b\\|xyz\\)\\{2,3\\}"
;;   #/[^\[\-\]\d]+/)
;;    -> "[^][0-9-]+"

;;; -*- mode:Lisp; coding:shift-jis -*-

(defun regexp-reader (s sc n)
  (with-output-to-string (os)
    (labels
	((start ()
	   (do ((c #1=(read-char s) #1#))
	       ((char= c #\/))
	     (case c
	       ((#\( #\) #\{ #\} #\| #\/) (format os "\\~A" c))
	       (#\\ (escape #1#))
	       (#\[ (char-class))
	       (t (princ c os)))))
	 (print-code (s &rest code)
	   (let ((code (parse-integer (format nil "~{~A~}" code) :radix 16)))
	     (princ (code-char code) s)))
	 (escape (c)
	   (case c
	     ((#\( #\) #\{ #\} #\| #\/) (princ c os))
	     (#\t (princ #\TAB os))
	     (#\n (princ #\LFD os))
	     (#\r (princ #\RET os))
	     (#\f (princ #\C-l os))
	     (#\d (princ "[0-9]" os))
	     (#\D (princ "[^0-9]" os))
	     (#\s (princ "[ \t\n\r\f]" os))
	     (#\S (princ "[^ \t\n\r\f]" os))
	     (#\x (print-code os #1# #1#))
	     (#\X (print-code os #1# #1# #1# #1#))
	     (t (format os "\\~A" c))))
	 (char-class ()
	   (princ #\[ os)
	   (when (char= #\^ (peek-char nil s))
	     (princ #1# os))
	   (format os "~A]"
	     (with-output-to-string (cs)
	       (do ((c #1# #1#)
		    (hyphen ""))
		   ((char= c #\]) (princ hyphen cs))
		 (case c
		   (#\\
		    (let ((e #1#))
		      (case e
			(#\- (setq hyphen "-"))
			(#\] (princ #\] os))
			(#\w (princ "0-9A-Za-z_" cs))
			(#\d (princ "0-9" cs))
			(#\s (princ " \t\n\r\f" cs))
			(#\t (princ #\TAB cs))
			(#\n (princ #\LFD cs))
			(#\r (princ #\RET cs))
			(#\f (princ #\C-l cs))
			(#\x (print-code cs #1# #1#))
			(#\X (print-code cs #1# #1# #1# #1#))
			(t (princ e cs)))))
		   (#\/ (error "‘[’に対応する‘]’がありません" 'simple-error))
		   (t (princ c cs))))))))
      (start))))

(set-dispatch-macro-character #\# #\/ #'regexp-reader)

(in-package "editor")
(defun regexp-reader-colorize ()
  (unless (local-variable-p 'regexp-keyword-list)
    (make-local-variable 'regexp-keyword-list))
  (setf regexp-keyword-list
	(append regexp-keyword-list
		(compile-regexp-keyword-list
		 '(("#/.*?[^\\]/" t (:color 9 0)))))))

(add-hook '*lisp-mode-hook* 'regexp-reader-colorize)
(add-hook '*lisp-interaction-mode-hook* 'regexp-reader-colorize)