UNICODE エスケープする

Lisp xyzzy

以下の環境で動作確認しました。

文字列を UNICODE エスケープします。
*escape-unicode-string-format-alist* は、エスケープに使用するフォーマットの連想リストで、要素に関数とフォーマットのペアをセットします。先頭の要素から関数を実行し、関数が non-nil を返した要素のフォーマットを使用します。
*escape-unicode-string-default-format* はデフォルトのフォーマットです。*escape-unicode-string-format-alist* でフォーマットを決定できなかった場合に、この変数のフォーマットを使用します。
フォーマットは関数 format の出力書式で、引数には UNICODE の文字コード値が渡されます。
以下のフォーマットが定義済みです。

html-mode,
//www1.odn.ne.jp/ymtz/html_plus-mode.html">html+-mode, xml-mode のマイナーモード XHTML1.0/1.1:『&#x~4,'0X;』(ex. foo => foo)
//www.geocities.jp/kiaswebsite/xyzzy/jscript-mode.html" title="kia's website - xyzzy関連 - jscript-mode.l">jscript-mode:『\u~:@(~4,'0X~)』(ex. foo => \u0066\u006F\u006F)
デフォルト
『%u~:@(~4,'0X~)』(ex. foo => %u0066%u006F%u006F)

コード

;; 文字列を UNICODE エスケープする

; デフォルトのフォーマット
(defvar *escape-unicode-string-default-format* "%u~:@(~4,'0X~)")

; フォーマットの連想リスト
; car の関数が non-nil を返すとき cdr のフォーマットを使用する
(defvar *escape-unicode-string-format-alist*
  (list
   (cons #'(lambda ()
             (or (member buffer-mode '("html-mode" "html+-mode") :test #'string=)
                 (and (string= buffer-mode "xml-mode")
                      (string-match "^xml:XHTML1\\.\\(?:0-\\(?:Strict\\|Frameset\\|Transitional\\)\\|1\\)$"
                                    mode-name))))
         "&#x~4,'0X;")
   (cons  #'(lambda () (string= buffer-mode "jscript-mode"))
          "\\u~:@(~4,'0X~)")
   ))

; 引数  : str - 文字列 - 対象の文字列
; 引数  : test - 関数 - 指定した関数が non-nil を返した文字のみエスケープする
;         関数は文字の UNICODE の文字コード値を引数とする
;         以下のキーワードパッケージシンボルがプリセットとして指定できる
;         * :non-ascii - 128 (#x80) 以上で non-nil
;         * :non-latin1 - 256 (#x100) 以上で non-nil
;         nil を指定するとテストを行わずに全ての文字をエスケープする
;         省略時は nil
; 戻り値: エスケープされた文字列
(defun escape-unicode-string (str &optional test)
  (and test
       (not (functionp test))
       (setq test
             (let ((n (case test
                        (:non-ascii 127)
                        (:non-latin1 255)
                        (t (error (make-condition 'type-error
                                                  :datum test
                                                  :expected-type 'function))))))
               #'(lambda (code) (> code n)))))
  (let* ((fmt (or (some #'(lambda (x) (if (funcall (car x)) (cdr x)))
                        *escape-unicode-string-format-alist*)
                  *escape-unicode-string-default-format*))
         (cts (if test
                  #'(lambda (c)
                      (let ((code (char-unicode c)))
                        (format nil "~:[~C~;~*~@?~]" (funcall test code) c
                                fmt code)))
                #'(lambda (c) (format nil fmt (char-unicode c))))))
    (apply #'concat (map 'list cts str))))

; リージョンを UNICODE エスケープする
(defun escape-unicode-string-region (from to &optional (test :non-ascii))
  (interactive "*r")
  (let ((str (escape-unicode-string (buffer-substring from to) test)))
    (delete-region from to)
    (insert str)))

; セレクションを UNICODE エスケープする
(defun escape-unicode-string-selection (&optional (test :non-ascii))
  (interactive "*")
  (case (get-selection-type)
    ((1 2)
     (ed::map-selection #'(lambda (start end)
                            (escape-unicode-string-region start end test))))
    (3 (error "セレクションが矩形選択です"))
    (t (error "セレクションがありません"))))