tc2 で「ます。」を 2 ストローク

この記事は 漢直 Advent Calendar : ATND の中のある 1 日です。

Eamcs での T-Code 入力 tc2 をちょっ便利にしてみます。

AZIK の特殊拡張では「ます」を「ms」、「こと」を「kt」、「から」を「kr」で打てます。これらを T-Code 打つと一文字 2 ストロークですから、それぞれ 4 ストロークで、 AZIK の倍の打鍵が必要になります。

tc2 でも AZIK と同様に 2 ストロークで入力できるようにしたいと思います。

tc2 には入力フィルタという仕組みがあり、打鍵の結果をいじることができます。

;; "-shift" 付のレイアウトを指定します。
(tcode-set-key-layout "qwerty-jis-shift")

(progn ;; フィルターによる拡張入力。
 (defun my-t-code-filter (x)
   (or (cdr (assoc x '((?で . "です。")
                       (?ま . "ます。")
                       (?し . "した。")
                       (?事 . "こと")
                       (?〜 . "から")
                       (?消 . "削")
                       (?願 . "お願いします。")
                       (?以 . "以上、")
                       (?メ . "foo.bar.baz@gmail.com")
                       (?住 . "横浜市中区上野町123-42")
                       )))
       x))

 (setq tcode-input-filter-functions
       '((tcode-katakana-mode . japanese-katakana)
         ((and (boundp 'tcode-bushu-prefix-list)
           tcode-bushu-prefix-list)
          . tcode-bushu-prefix-convert)
         (tcode-alnum-2-byte . tcode-1-to-2)
         (tcode-shift-state . my-t-code-filter)))
 )

これで、「ます。」は「Shift+ま」（「Md」）、「こと」は「Shift+事」（「Uf」）、「から」は「Shift+〜」（「<m」）で入力できるようになります。シフトキーは必要でするが 2 ストロークになりました。

また、「Shift+メ」でメールアドレスを入力したり、「Shift+住」で住所を入力したりするのもいいですね。

Climacs の Dired

あまり興味を持ってもらえない Climacs の Dired ではあるが、ないと不便だと思うので実装した。まだ、一覧表示してファイルを開くことしかできない。

• command-table, syntax, mode の関係?
• 色の付け方は?
• Presenttation を使うべきか?

と、分からないところが多い。

ソースは github にあるけど、ここにも貼り付けておく。

;;; -*- mode: lisp; indent-tabs: nil -*-

(in-package :info.read-eval-print.climacs.dired)

(define-syntax-command-table dired-table :errorp nil
  :inherit-from '(drei:movement-table climacs-gui:window-table))

;;;;;; presentation
;;(define-presentation-type dired ()
;;  :inherit-from 't)
;;
;;(define-presentation-method presentation-typep (object (type dired))
;;  (pathnamep object))
;;
;;(define-presentation-method present (object (type dired) stream
;;                                            (view textual-view)
;;                                            &key)
;;  (let ((stat (sb-posix:stat (namestring object)))
;;        (name (if (directory-pathname-p object)
;;                  (car (last (pathname-directory object)))
;;                  (file-namestring object))))
;;    (format stream
;;            "  ~o ~a ~a ~6,d ~a ~a"
;;            (sb-posix:stat-mode stat)
;;            (file-author object)
;;            (sb-posix:group-name (sb-posix:getgrgid (sb-posix:stat-gid stat)))
;;            (sb-posix:stat-size stat)
;;            (dt:|yyyy-mm-dd hh:mm| (dt:from-posix-time (sb-posix:stat-mtime stat)))
;;            name)))


;;;; dired-syntax
(define-syntax dired-syntax (fundamental-syntax)
  ()
  (:name "Dired")
  (:command-table dired-table))

(defmethod name-for-info-pane ((syntax dired-syntax) &key pane)
  (declare (ignore pane))
  (format nil "Dired"))

(defmethod display-syntax-name ((syntax dired-syntax)
                                (stream extended-output-stream) &key pane)
  (declare (ignore pane))
  (princ "Dired" stream))


;;;; dired-mode
(define-syntax-mode dired-mode ()
  ((path :initarg :path))
  (:documentation "A mode for Directory editing.")
  (:applicable-syntaxes fundamental-syntax))


(defmethod syntax-command-tables append ((syntax dired-mode))
  '(dired-table))

(defun ensure-pathname-for-dired (path)
  (make-pathname :directory (namestring path)
                 :name :wild))

;;(defun make-buffer-contents (path)
;;  (loop for x in (directory (ensure-pathname-for-dired path))
;;                               do (defmethod presentation-type-of ((object (eql x)))
;;                                    'dired)
;;                               nconc (list x #\Newline)))

(defun make-buffer-contents (path)
  (str (namestring  path) #\Newline
       (trivial-shell:shell-command #"""ls -al #,(namestring path)""")))

(defun make-dired-buffer (path)
  (let ((buffer (make-new-buffer)))
    (insert-buffer-sequence buffer 0 (make-buffer-contents path))
    (clear-undo-history buffer)
    buffer))


(defun find-directory (path)
  (cond ((null path)
         (display-message "No file name given.")
         (beep))
        ((not (directory-pathname-p path))
         (display-message "~A is a not directory name." path)
         (beep))
        ((not (probe-file path))
         (display-message "~A is a not found." path)
         (beep))
        (t
         (let* ((buffer (make-dired-buffer path))
                (view (climacs-core::make-new-view-for-climacs
                       *esa-instance* 'textual-drei-syntax-view
                       :name (namestring path)
                       :buffer buffer)))
           (unless (climacs-core::buffer-pane-p (current-window))
             (climacs-core::other-window (or (find-if (^ typep _window 'climacs-core::climacs-pane)
                                                      (windows *esa-instance*))
                                             (climacs-core::split-window t))))
           (setf (offset (point buffer)) (offset (point view))
                 (syntax view) (make-syntax-for-view view 'dired-syntax)
                 (file-write-time buffer) nil
                 (needs-saving buffer) nil
                 (name buffer) (namestring path))
           (enable-mode view 'dired-mode :path path)
           (setf (current-view (current-window)) view)
           (evaluate-attribute-line view)
           (setf (filepath buffer) (pathname path)
                 (read-only-p buffer) t)
           (beginning-of-buffer (point view))
           buffer))))

(define-command (com-dired :name t :command-table esa-io-table)
    ((path 'pathname
           :prompt "Dired (directory): "
           :prompt-mode :raw
           :default (esa-io::directory-of-current-buffer)
           :default-type 'pathname
           :insert-default t))
  "Prompt for a directory name then edit that directory."
  (handler-case (find-directory path)
    (file-error (e)
      (display-message "~a" e))))

(defun dired-find-file (path)
  (unless path
    (let* ((dir (slot-value (syntax (current-view)) 'path))
           (mark (point))
           (line (region-to-string (beginning-of-line (clone-mark mark))
                                   (end-of-line (clone-mark mark)))))
      (ppcre:register-groups-bind (d file)
          ("(.)(?:[^ ]+ +){7}(.*\)" line)
        (setf path (merge-pathnames (str file (when (string= "d" d) "/")) dir)))))
  (when path
    (if (directory-pathname-p path)
        (find-directory path)
        (find-file path))))


(define-command (com-dired-find-file :name t :command-table dired-table)
    ((path 'pathname
           :prompt "File: "
           :prompt-mode :raw
           :default-type 'pathname))
  "Find file."
  (dired-find-file path))

(set-key 'com-dired-find-file 'dired-table '((#\Newline)))

(set-key `(drei-commands::com-forward-line ,*numeric-argument-marker*) 'dired-table
         '((#\n)))

(set-key `(drei-commands::com-backward-line ,*numeric-argument-marker*) 'dired-table
         '((#\p)))

(set-key `(climacs-commands::com-kill-view (current-view)) 'dired-table
         '((#\q)))

McCLIM (Climacs) でビットマプフォン使って日本語を表示する

トゥルータイプフォントなら (require :mcclim-freetype) で日本語表示できていたが、ビットマップフォントで日本語表示する法方がようやく分った。

clim-clx::*clx-text-family+face-map* で "adobe-xxxxx" を使うようになっているのを "*-*" に変更してしまう。

フォントサイズの指定は Climacs でビットマップフォントを使った時のフォンサイズ変更 を参照。

(setq clim-clx::*clx-text-family+face-map*
  '(:fix
    ("*-*"
     (:roman               "medium-r"
      :bold                "bold-r"
      :italic              "medium-o"
      :bold-italic         "bold-o"
      :italic-bold         "bold-o"))
    :sans-serif
    ("*-*"
     (:roman               "medium-r"
      :bold                "bold-r"
      :italic              "medium-o"
      :bold-italic         "bold-o"
      :italic-bold         "bold-o"))
    :serif
    ("*-*"
     (:roman               "medium-r"
      :bold                "bold-r"
      :italic              "medium-i"
      :bold-italic         "bold-i"
      :italic-bold         "bold-i"))))

McCLIM の CLX バックエンドの文字を描画する所に 1 行追加する。

Index: Backends/CLX/medium.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp,v
retrieving revision 1.91
diff -u -r1.91 medium.lisp
--- Backends/CLX/medium.lisp    15 Nov 2009 11:27:26 -0000      1.91
+++ Backends/CLX/medium.lisp    15 Dec 2010 12:03:10 -0000
@@ -1101,6 +1101,7 @@
           (multiple-value-bind (halt width)
               (xlib:draw-glyphs mirror gc x y string
                                 :start start :end end
+                                :size 16
                                 :translate #'translate)))))))

 (defmethod medium-buffering-output-p ((medium clx-medium))
cvs diff: Diffing Backends/Graphic-Forms

これで、ビットマップフォントでも日本語表示ができるようになった。

Climacs で uim T-Code

Climacs で T-Code で uim を使わずにと思っていたが、uim を使った方が楽だし便利だと思いなおす。

ということで mcclim-uim が T-Code では動かなかったのを修正した。

https://github.com/quek/mcclim-uim

(require :mcclim-uim) すれば Climacs（McCLIM）で uim が動くはず。

さて、だれか使う人いるのかな? SKK も動くはず。

何だか短いので Climacs のカスタマイズのコードでも載せておく。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :mcclim)
  (require :mcclim-freetype)
  (require :climacs)
  (require :mcclim-uim)
  )

;; フォントを大きく。
(setf mcclim-truetype::*dpi* 96)

;; C-h をバックスペースにするために、C-h のキーストロークを削除。
(clim:remove-keystroke-from-command-table 'esa:help-table
                                          '(:keyboard #\h 512)
                                          :errorp nil)
;; C-h でバックスペース
(esa:set-key `(drei-commands::com-backward-delete-object
               ,clim:*numeric-argument-marker*
               ,clim:*numeric-argument-marker*)
             'drei:deletion-table
             '((#\h :control)))
;; C-m newline and indent
(esa:set-key 'drei-lisp-syntax::com-newline-indent-then-arglist
             'drei-lisp-syntax:lisp-table
             '((#\m :control)))
;; C-/ undo
(esa:set-key 'drei-commands::com-undo
             'drei:editing-table
             '((#\/ :control)))
;; C-i で補完
(esa:set-key 'drei-lisp-syntax::com-indent-line-and-complete-symbol
             'drei-lisp-syntax:lisp-table
             '((#\i :control)))

;; Climacs 起動
(climacs:climacs-rv :width 900 :height 1000 :new-process t)

Emacs の SLIME から Climacs 関係の関数を呼ぶ時は

Emacs の SLIME から Climacs 関係の関数を呼ぼうとすると、スペシャル変数が nil になっていて動いてくれない。

次のように clim:*application-frame* に Climacs のアプリケーションフレームをバインドし、 drei:with-bound-drei-special-variables を使うとスペシャル変数がバインドされてうまく動いてくれる。

もちろん、Climacs は動かしておく必要がある。

(defmacro with-climacs (&body body)
  `(let ((clim:*application-frame* (clim:find-application-frame 'climacs-gui:climacs)))
     (drei:with-bound-drei-special-variables (clim:*application-frame*)
       ,@body)))

(with-climacs
  (values
    (esa:current-buffer)
    (drei:drei-instance)
    (clim:point)
    (or (drei-buffer:end-of-buffer-p (clim:point))
        (drei-buffer:object-after (clim:point)))))
;;=> #<CLIMACS-GUI:CLIMACS-BUFFER size:78 {1005426701}>
;;   #<CLIMACS-GUI:CLIMACS-PANE TEXTUAL-DREI-SYNTAX-VIEW {1005190AD1}>
;;   #<DREI-BUFFER:DELEGATING-RIGHT-STICKY-MARK 50 {1005426731}>
;;   #\(

送別会

金曜日に送別会を開いてもらいました。退職日は今月末なのですが、タイミングがいいので今日ちょっと書きます。

楽しかった。仕事以外でもプログラムやそのブログを書いている人たちと一緒に仕事できたことが楽しかった。

おもしろかった（興味深い）。そこにいる人たちはみんな興味深い人たちだった。

勉強になった。 SIer、システム開発会社などとはいろいろ違っていてとても勉強になった。

まだもう少しありますが、ありがとうございました。

Climacs で T-Code

以前、 uim を使って McCLIM で日本語入力 みたいなことをやっていた。

今回は Common Lisp だけでどうにかできないかと、あがいてみた。

(in-package :clim-user)
(use-package :climacs)
(use-package :climacs-gui)

(progn
  (make-command-table 'tcode-table :errorp nil
                      :inherit-from '(drei:editor-table global-climacs-table))

  (let (on)
    (define-command (com-tcode-mode-toggle :name t :command-table global-climacs-table) ()
      (when (setf on (not on))
        (esa:simple-command-loop 'tcode-table on))))

  (esa:set-key 'com-tcode-mode-toggle 'global-climacs-table '((#\\ :control)))

  (macrolet ((m (k1 k2 c)
               (let ((com-name (intern (format nil "com-tcode-key-~c-~c" k1 k2))))
                 `(progn
                    (define-command (,com-name :name t :command-table tcode-table) ()
                      (drei-core:insert-character ,c))
                    (esa:set-key ',com-name 'tcode-table '((,k1) (,k2)))))))
    (m #\f #\u #\あ)
    (m #\d #\e #\い)
    (m #\f #\e #\う))
  )

こんな感じで地味にできそうではある。

esa:simple-command-loop を使うのがいいかは分かってない。

マイナーモードというものが Climacs では見付けられなかったので、 esa:simple-command-loop を使ってみた。