blechmusikの日記

キー・カスタマイズ・ソフトウェア "DvorakJ" の覚え書きをはじめとして様々なことを書いています。

テキストの角括弧内の情報を展開して出力する

[02-3]と書いたら 02 と 03 のように必要な桁数まで0で埋めたり*1、[a-z]と書いたらaからzまで出力する*2など、テキストの角括弧内の情報を展開して出力してみた*3。出力例はつぎのとおりである。

(mapc #'(lambda (x)
          (print-text-with-expansion x
				     :pre-text ";;-> "))
      '("http://example.com/[8-10]/"
        "http://example.com/[08-10]/"
        "http://example.com/[008-010]/"))
;;-> http://example.com/8/
;;-> http://example.com/9/
;;-> http://example.com/10/
;;-> http://example.com/08/
;;-> http://example.com/09/
;;-> http://example.com/10/
;;-> http://example.com/008/
;;-> http://example.com/009/
;;-> http://example.com/010/
(progn 
  (princ ";;->")
  (mapc #'(lambda (x)
	    (print-text-with-expansion x 
				       :pre-text " "
				       :terprip nil))
	'("[あ-の]")))
;;-> あ ぃ い ぅ う ぇ え ぉ お か が き ぎ く ぐ け げ こ ご さ ざ し じ す ず せ ぜ そ ぞ た だ ち ぢ っ つ づ て で と ど な に ぬ ね の
(progn 
  (princ ";;->")
  (mapc #'(lambda (x)
	    (print-text-with-expansion x 
				       :pre-text " "
				       :terprip nil))
	'("[A-Z]")))
;;-> A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
(progn 
  (princ ";;->")
  (mapc #'(lambda (x)
	    (print-text-with-expansion x 
				       :pre-text " "
				       :terprip nil))
	'("[a-z]")))
;;-> a b c d e f g h i j k l m n o p q r s t u v w x y z

ソースは以下の通りだ。処理系はsbclを想定しているので、使用している処理系に適合するよう適宜書き換えればよいだろう。

コマンドプロンプトから操作しやすいようにした -> テキストの角括弧内の情報を展開して出力するツールを改良した - blechmusik2の日記

(ql:quickload :cl-ppcre)

(defun number->string (n &optional (figure 1))
  (format nil "~V,1,,'0@A" figure n))

(defun string->char-code (x)
  (char-code (coerce x 'character)))

(defun char-code->string (n)
  (string (code-char n)))

(defun parse-text-by-square-bracket (text)
  (let ((pattern "^(.*?)\\[(\\d+|\\S)-(\\d+|\\S)\\](.*?)$"))
    (labels ((rec (acc next)
               (cond ((null next) next)
                     ((ppcre:scan pattern next)
                      (ppcre:register-groups-bind (pre start end post)
                          (pattern next)
                        (let* ((number-mode (and (numberp (read-from-string start))
                                                 (numberp (read-from-string end))))
                               (fn-for-start-and-end (if number-mode
                                                         #'read-from-string
                                                         #'string->char-code))
                               (fn-for-each-elem (if number-mode
                                                     #'number->string
                                                     #'(lambda (a b) (char-code->string a)))))
                          (rec (cons (loop for n
                                        from (funcall fn-for-start-and-end start)
                                        to (funcall fn-for-start-and-end end)
                                        collect (funcall fn-for-each-elem n (length start)))
                                     (cons pre acc))
                               post))))
                     (t (reverse (cons next acc))))))
      (rec nil text))))

(defun print-with-expansion (lst &key (terprip t) (pre-text "") (post-text ""))
  ;; scheme ver. http://toro.2ch.net/test/read.cgi/tech/1327819028/241
  ;; cl ver. http://paste.lisp.org/display/128244
  (labels ((rec (acc next)
             (cond
               ((null next)
                (princ pre-text)
                (mapc #'princ (reverse acc))
                (princ post-text)
                (when terprip (terpri)))
               ((consp (car next))
                (mapc (lambda (x)
                        (rec (cons x acc) (cdr next)))
                      (car next)))
               (t
                (rec (cons (car next) acc) (cdr next))))))
    (rec nil lst)))


(defun print-text-with-expansion (text &key (terprip t) (pre-text "") (post-text ""))
  (print-with-expansion (parse-text-by-square-bracket text)
                        :terprip terprip
                        :pre-text pre-text
                        :post-text post-text))


;; (sb-ext:save-lisp-and-die "print-text-with-expansion.exe"
;;                           :toplevel #'(lambda ()
;;                                         (mapc #'(lambda (x) (print-text-with-expansion x))
;;                                               (cdr sb-ext:*posix-argv*)))
;;                           :compression t
;;                           :executable t)

*1:いわゆるゼロパディングを指す。

*2:当該文字の文字コードを判別して処理する。

*3:Lisp Scheme Part34【入門】Common Lisp その9【質問よろず】の最近のレスを参考にした。