66MHz.com

自分の.xyzzyに書いているコードや遊びで作ったコードを置いてあります。 再利用していただければ幸いです。 ちなみに、buf2htmlでもう少し見やすくする予定です。

• Zope関連
• diff関連
• ミニバッファ関連
• ステータスバー関連
• リファレンス関連
• FTP関連
• フック変数
• 構造
• 起動時フロー
• ポップアップメニュー関連
• ポップアップ関連
• ファイラ関連
• Win32API関連
• 簡易WWWサーバ

使い方は想像して下さい。

何かを作るときに調べたことを忘れないように覚書としてまとめておきます。 できれば、へなちょこリファレンス向けに書いておきたいです。 適当な単語を用いているので、適宜読み替えて下さい。

基本的にZopeはファイルの編集から全てをブラウザから出来るようになっています。 が、ちゃんとクライアントのエディタで編集するためのプロダクトExternalEditorがあったります。 で、それをxyzzyから直接呼び出すためのものです（もちろんExternalEditorのWindows用helperの導入が必要です）。 C-x C-f で http://host/target で読み込むことができます。

*before-find-file-hook*と*find-file-hook*に引っ掛けています。 重複の読み込みはしないようにチェックしてます。

ブラウザを常時表示しておかないと、毎回パスワードを聞かれるので注意して下さい。 bx:navigateでやるという手もありますが、今回はshell-executeでやってます。 ange-ftpとかWebDAVがサポートできればもう少しスマートに出来ますが、一番作り込みの少ない方向で。

;;; invoke zope object
(defun invoke-zope-object (loc)
  (unless (string-matchp "^\\(http://.*\\)/\\([^/]+\\)$" loc)
    (return-from invoke-zope-object nil))
  (dolist (buf (buffer-list))
    (when (string= loc (get-buffer-alternate-file-name buf))
      (message "Old Zope Object")
      (return-from invoke-zope-object buf)))
  (shell-execute
   (format nil "~A/externalEdit_/~A"
           (match-string 1)
           (match-string 2)) t)
  (message "invoke ~A" loc)
  (throw nil 'silent-quit))
(add-hook '*before-find-file-hook* 'invoke-zope-object)

;;; mark zope object
(defun mark-zope-object ()
  (when (string-matchp "^.+-.+-\\(.*\\)\\.\\w+$"
                       (file-namestring (get-buffer-file-name)))
    (set-buffer-alternate-file-name
     (concat "http://" (substitute-string (match-string 1) "," "/")))))
(add-hook '*find-file-hooks* 'mark-zope-object)
    

ソースレビュー時にソースの差分をdiffで採るときに面倒だったので、二画面ファイラから選択できるようにしました。

(defun my-filer-diff-file ()
  (let ((file1 (ed::filer-fetch-file nil nil))
        (file2 (ed::filer-fetch-file nil t)))
    (unless (and file1 file2)
      (error "diffするファイルを指定して"))
    (diff file1 file2)
    (and (find-buffer ed::*diff-new-buffer-name*)
         (find-buffer ed::*diff-old-buffer-name*)
         (filer-cancel))))
(define-key filer-keymap #\M-f 'my-filer-diff-file)
    

ミニバッファ内での編集のときに、行数に応じて自動的にenlarge-windowします。 標準であるような気がしないでもないですが、emacsのを見よう見真似で取り合えず。

(defun minibuf-resize ()
  (when (minibuffer-window-p (selected-window))
    (let ((l (save-excursion
               (goto-char (point-max))
               (current-line-number)))
          (h (window-height)))
      (when (< 10 l)
        (setq l 10))
      (unless (= l h)
        (enlarge-window (- l h))
        (refresh-screen)))))
(add-hook '*post-command-hook* 'minibuf-resize)

【13 Aug 2003】トラブルが起き難いようにrefresh-screenを追加(中野さんより)

ステータスバーにアスキーコード／ユニコード／行番号／桁位置とか表示できます。 かなり便利です。

(setq *status-bar-format* "cupT")

現在は特になし

会社で、sambaは入ってないけどFTPは使える機械で作業させられそうなので なんとかならんかなぁ、と作り始めたもの。結局なんともなりませんでした。 残骸ですが晒しておきます。

ログインして、ファイルを取ってくるだけです。保存はできません。 C-x C-fで、find-file: ftp://www.odn.ne.jp/index.html とかしてください。 他にログインするアカウントに応じてホームディレクトリを変更したりする機能が必要かと思います。 エラー処理も弱いです。*before-find-file-hook*でいろいろやってます。 ちなみに、フック変数は、その過程で調べたものです。

ange-ftpの"ange"は、作者の"Andy"から来ていると最近知ったので、挑戦して見ましたが、 「素直にvi使った方が早かった」ということが分かりました。

なお、実装に当たってはwww/www-ftp.lを参考にさせていただきました。

~/site-lisp/ftpts.lの内容

;;; FTP transparent support
;;; ftpts.l

(require "wip/ftp")

(export '(*ftpts-log-buffer-name*
          *ftpts-log-buffer*
          ftpts-toggle-log))

(defvar *ftpts-ftp-port* 21
  "ftpts: FTPポート番号")
(defvar *ftpts-passive-mode* nil
  "ftpts: PASSIVEモードの使用")
(defvar *ftpts-use-log-buffer* nil
  "ftpts: ログバッファの使用")
(defvar *ftpts-log-buffer-name* "*ftpts log*"
  "ftpts: ログバッファ名")
(defvar *ftpts-log-buffer* nil
  "ftpts: ログバッファ")
(defvar *ftpts-user* "anonymous"
  "ftpts: ログインユーザ名")
(defvar *ftpts-pass* ""
  "ftpts: ログインパスワード")

(defun ftpts-toggle-log ()
  (interactive)
  (if *ftpts-use-log-buffer*
      (delete-buffer *ftpts-log-buffer-name*))
  (setq *ftpts-use-log-buffer*
        (not *ftpts-use-log-buffer*)))

(defun read-passwd (&optional (prompt "password: ") &key default)
  "ftpts: wip/ftp.lのgetpassに初期値を与えられる様に変更"
  (let ((pw (make-vector 16
                         :element-type 'character
                         :initial-contents default
                         :fill-pointer (length default)
                         :adjustable t)))
    (loop
      (minibuffer-prompt "~A~v@{~a~:*~}" prompt (length pw) #\*)
      (let ((c (read-char *keyboard*)))
        (case c
          (#\RET (return pw))
          (#\C-g (quit))
          (#\C-q (vector-push-extend (read-char *keyboard*) pw))
          (#\C-h (or (zerop (length pw))
                     (vector-pop pw)))
          (t (vector-push-extend c pw)))))))

(defun ftpts-log-buffer ()
  "ftpts: ログバッファの取得"
  (unless (and *ftpts-log-buffer*
               (find-buffer *ftpts-log-buffer-name*))
    (when (setq *ftpts-log-buffer*
                (switch-to-buffer *ftpts-log-buffer-name*))
      (make-local-variable 'kept-undo-information)
      (setq kept-undo-information nil)
      (make-local-variable 'need-not-save)
      (setq need-not-save t)))
  *ftpts-log-buffer*)

(defun find-location (loc)
  "ftpts: *before-find-file-hook* 用のフック関数"
  ; マッチするか？
  (unless (string-matchp "^ftp://\\([^/:]*\\)\\(:\\([^/]+\\)\\)?/?\\(.*\\)$" loc)
    (return-from find-location nil))
  ; 既に読み込んでいるか？
  (dolist (buf (buffer-list))
    (if (string= loc (get-buffer-alternate-file-name buf))
        (return-from find-location buf)))
  ; FTP経由で読込み
  (let ((host (match-string 1))
        (port (match-string 3))
        (target (match-string 4))
        (*ftp-passive-mode* *ftpts-passive-mode*)
        (*standard-output*
         (if *ftpts-use-log-buffer*
             (make-buffer-stream (ftpts-log-buffer))
           *standard-output*)))
    (format t "logging to ~A ... now ~A\n" host
            (format-date-string "%d %b %Y %H:%M:%S %Z"))
    (let* ((user (read-string "name: " :default *ftpts-user*))
           (pass (read-passwd "password: " :default *ftpts-pass*))
           (ftp (ftp-connect host (or port *ftpts-ftp-port*)))
           (name (file-namestring target))
           buf)
      (unwind-protect
          (progn
            (ftp-login ftp user pass)
            (ftp-ascii ftp)
            (switch-to-buffer (setq buf (create-new-buffer name)))
            (make-local-variable 'kept-undo-information)
            (setq kept-undo-information nil)
            (ftp-get ftp target (make-buffer-stream buf))
            (cond
             ((>= (ftp-reply-code ftp) 500)
              (delete-buffer buf)
              nil)
             (t
              (setq *ftpts-user* user)
              (setq *ftpts-pass* pass)
              (set-buffer-modified-p nil buf)
              (set-buffer-alternate-file-name loc buf)
              (setq kept-undo-information t)
              buf)))
        (ftp-quit ftp)))))

(add-hook '*before-find-file-hook* 'find-location)
    

フック変数をまとめておきます。 フック変数しか対応する方法が無かったりするので、あることを知っている方がよいかも。 ~/lispとChangeLog.htmlでgrepに引っ掛ったものだけです。 漏れや誤りがある筈なので、通報をお願いします（MLを見る方が良いことは分かってるんですが、数千件もあるので…）。 下のリストはcsv-modeで編集したものを、html化して貼り付けています。感謝＞大久保さん

• *evalhook*と*applyhook*は除いています。
• 2列目は呼び出され方を示しています。
• run-hooks
• run-hook-with-args-until-success
• run-hook-with-args-while-success
• funcall
• post-buffer-modified-hookは特殊なので、 ChangeLog.htmlのxyzzy 0.2.1.186を参照。

【04 Feb 2002】何か天の声を聞いたような気がするので、*post-command-hook*と*pre-command-hook*を入れ替えて見ました。

【11 Mar 2002】xyzzy 0.2.2.224に上がったので幾つか追加

lispがどのようにシステムに関わっているのかを示します。 誤解を恐れず描いてしまえば、xyzzyは以下の図に構成されています。 基本的にはemacs系と同じだと思います。

┏━━━━━━━━┓┏━━━━━━━━┓┏━━━━━━━┓┏━━━━━┓www-mode
┃ユーザ層        ┃┃初期設定ファイル┃┃ ユーザ関数群 ┃┃ユーザDLL ┃2ch-mode
┃                ┃┃                ┃┃              ┃┃          ┃kamail ...
┗━━━━━━━━┛┗━━━━━━━━┛┗━━━━━━━┛┗━━━━━┛
┏━━━━┯━━━┓┏━━━━━━━━━━━━━━━━━━━━━━━━┓c-mode
┃アプリ層│lisp層┃┃                  標準関数群                    ┃grep ...
┃        │      ┃┃           （ビルトイン関数を含む）             ┃
┃        ┝━━━┫┣━━┯━━━━━━━━━━━━┯━━━━━━━━┫car
┃        │exe層 ┃┃GUI │xyzzy lisp インタプリタ │ビルトイン関数群┃cdr ...
┗━━━━┷━━━┛┗━━┷━━━━━━━━━━━━┷━━━━━━━━┛
┏━━━━━━━━┓┏━━━━━━━━━━━━━━━━━━━━━━━━┓
┃OS層            ┃┃                Windows Service                 ┃
┃                ┃┠─────┬────────┬─────────┨
┃                ┃┃   通信   │   メモリ制御   │ ファイルシステム ┃
┗━━━━━━━━┛┗━━━━━┷━━━━━━━━┷━━━━━━━━━┛

ビルトイン関数

ビルトイン関数というプリミティブな関数群が存在する。実体はC++の関数 として実装されているが、lisp関数のインターフェースを持っている。 詳細は、~/lisp/builtin.lを参照のこと。

標準関数群

ビルトイン関数を元に作成されたxyzzyの標準関数群により、エディタ としての機能が提供されている。標準関数群はxyzzy lispで記述されている。

初期設定ファイル

ユーザが任意に機能を追加する場合には、初期設定ファイル ~/.xyzzy及び~/site-lisp/siteinit.lに記述する。 各機能はxyzzy lispで記述する。 初期設定ファイルの評価時期については、起動時フローを参照のこと。

ユーザ関数群

より大きな単位で機能の追加を追加する場合には、~/site-lisp等に 別個にファイルを作成する。各機能はxyzzy lispで記述を行なう。

ユーザDLL

任意の外部DLLを呼出すことが可能である。

xyzzy起動時に特定のlispファイルが評価される順番が決まっている以外は、 xyzzy lisp インタプリタから見た場合に、xyzzyの標準関数群／初期設定ファイル／ユーザ関数群の違いは ほとんど無いはずです。 他のマクロ機能を持つエディタとはこの点が根本的に異なり、 xyzzyの拡張性の高さに繋がっていると思います。

起動時のフローです。~/xyzzy.exeを起動すると、 最初はinit.ccから~/lisp/startup.lが呼び出されます。 以降の主なフローは以下のとおりです。

init.cc:

1. startupをload-library

startup.l:

1. loadupをload-library

loadup.l:

1. estartupをload-library （estartup.lで、e:startupを定義）
2. historyをload-library （history.lで、load-history-fileを定義）
3. app-menuをload-library （app-menu.lで、init-app-menusを定義）
4. siteinitをload-library

2. ダンプが未だならダンプ
3. e:startupを実行

estartup.lのe:startup:

1. フレームを初期化
2. *pre-startup-hook*を実行
3. .xyzzyを実行
4. ヒストリを初期化 （history.lのload-history-fileで、*load-history-hook*を実行）
5. メニューを初期化 （app-menu.lのinit-app-menusで、*init-app-menus-hook*を実行）
6. *scratch*を作成
7. *post-startup-hook*を実行

まとめると、起動時にユーザが変更可能な部分は、以下の順番で実行されます。 何故、siteinit.lがダンプされて.xyzzyが毎回評価されるのかも、このフローから分かります。

ディレクトリ構造をそのままポップアップメニューにする例です。 以前xyzzy-MLに投げた物の再録です。アイテムを選択した場合に、任意の関数を実行可能です。 元々電信八号を使ってたときに、MIME部分をもっと簡単に見たいっていう思いから作りました。 でも今は、穂浪さんちのDatula-modeにお世話になってます。

【25 Jan 2002】どうもデフォルトの create-menu を潰していたので、関数名を修正しました。

;;; ディレクトリ階層に応じたポップアップメニューの作成
; メニューの作成
(defun create-dir-menu (dlst &optional m)
  (long-operation
    (let ((mnu (or m (create-popup-menu))) (dn 0) (fn 0))
      (dolist (item dlst)
        (let ((icar (car item))
              (icadr (cadr item)))
          (cond ((functionp icadr)
                 (and (not (zerop dn))
                      (zerop fn)
                      (add-menu-separator mnu))
                 (incf fn)
                 (add-menu-item mnu 'dir-menu icar icadr))
                (t
                 (incf dn)
                 (add-popup-menu mnu (create-dir-menu icadr) icar)))))
      mnu)))

; ディレクトリリストの作成
(defun create-dir-list (src func)
  (let* ((d (directory src :directory-only t :absolute t))
         (f (directory src :file-only t))
         (dlst (sort d #'string-lessp))
         (flst (sort f #'string-lessp)))
    (append
     (mapcar
      #'(lambda (x)
          (list (file-namestring (string-right-trim "/\\" x ))
                (create-dir-list x func)))
      dlst)
     (mapcar
      #'(lambda (x)
          (list x
                #'(lambda () (interactive)
                    (apply func (list (append-trail-slash src) x)))))
      flst))))

;;; サンプル
(setq *app-popup-menu*
      (create-dir-menu
       (create-dir-list "c:/My Documents" 'sample-function)))
(defun sample-function (dir file)
  (interactive)
  (set-default-directory
   (prog1
       (default-directory)
     (set-default-directory dir)
     (file-name-dialog
        :save nil
        :title "サンプルです"
        :default file
        :filter '(("いわゆるすべてのファイル(*.*)" . "*.*"))))))

補完を一覧表示出来て便利です。 *Completion*バッファを表示するよりも、Windowsっぽくて好きです。

【02 Feb 2002】dabbrevをrequireし忘れてたのを修正

;;; ポップアップ
(require "dabbrev")
(global-set-key #\C-\; 'dabbrev-popup)
(setq *popup-completion-list-default* :always)
(setq *minibuffer-popup-completion-list* :never)

非常に高機能なファイラが搭載されていますが、キーバインドが良く分からないので以下の様に書いておくと便利かも。 ちなみに、ファイラもキーバインドを変更可能です。

;;; ガイドテキストの変更
(setq *filer-guide-text*
      '("(A)ttr (B)yteCompile (C)opy (D)elete (E)xtract (F)ind (G)o (J)ump m(K)dir <L>Cd (M)ove re(N)ame"
        "c(O)mpress <P>Sync (Q)uit (R)ename (S)ync desk(T)op (U)sage <V>List <W>View <Y>Shortcut <Z>Property"
        "<C-g>Quit (C-u)sage (M-g)rep (M-v)iew (M-r)eplace <*>Load <.>Mask <\\>Root <<>Top <>>Bottom <@>Copy <=>Compare <^>Media <]>Send"
        "</>Mark_group <Home>Invert <F3>Exec <F6>Sort <C-Home>Invert_all <S-Home>Erase_mark <S-C-Home>Mark_all <Space>Mark"
        "<TAB>Switch <End>Update <Enter>Ok <Apps/S-F10>Menu <Backspace>Updir"))

以下はおまけです。

【04 Aug 2002】*filer-directories*の例を追加

;;; 削除したファイルをゴミ箱へ
(setq *filer-use-recycle-bin* t)
;;; デフォルトのファイルマスクを変更
(setq *filer-primary-file-mask* '("*"))
(setq *filer-secondary-file-mask* '("*"))
;;; My Documentsやデスクトップへ直接ディレクトリ移動できるように追加
(setq *filer-directories*
      '((" [ｽﾌﾟｰﾙ]" . "c:/spool")))
(pushnew (cons " [ﾃﾞｽｸﾄｯﾌﾟ]" (get-special-folder-location :desktop))
         *filer-directories*)
(pushnew (cons " [My Documents]" (get-special-folder-location :personal))
         *filer-directories*)
    

WindowsのINIファイルから値を取得するには、Win32APIのGetPrivateProfileString()を使います。 html+-modeで、インターネットショートカットのリンク先を取得するために使用しています。

[InternetShortcut]
URL=http://www.microsoft.com/isapi/redir.dll?prd=ie&pver=5.0&ar=IStart
Modified=A02F5BEB343DC10148

;;; INIファイルの読み込み
(require "foreign")
(require "wip/winapi")

(c:define-dll-entry
  winapi:DWORD GetPrivateProfileString
  (winapi:LPCSTR winapi:LPCSTR winapi:LPCSTR
   winapi:LPCSTR winapi:DWORD winapi:LPCSTR)
  "kernel32" "GetPrivateProfileStringA")

(let* ((sec (si:make-string-chunk "InternetShortcut"))
       (key (si:make-string-chunk "URL"))
       (non (si:make-string-chunk ""))
       (sz 500)
       (url (si:make-chunk nil sz))
       (file (si:make-string-chunk (map-slash-to-backslash
                                    "c:/WINDOWS/Favorites/MSN.url"))))
  (GetPrivateProfileString sec key non url sz file)
  (insert (si:unpack-string url 0)))

簡単なWWWサーバです。 eval してから wwwsvr を動かします。 ブラウザから http://localhost/ を参照すると、xyzzyのバッファの一覧を返します。 ファイル名をクリックすると、そのファイルを表示します。

• コードを見れば分かりますが、レスポンスはいい加減に生成しています。
• リクエストされたものを、一旦 eval してから返すと、サーバサイドスクリプト っぽくて面白いかも。
• MLの過去ログを眺めていたら [xyzzy:05998] ぐらいで、 Toyさんと亀井さんがstreamの話をしてたので、気分転換用に書いて見ました。

;;; 簡易WWWサーバ
; メイン関数
(defun wwwsvr ()
  (interactive)
  ; バッファ準備
  (switch-to-buffer "*wwwsvr log*")
  (delete-region (point-min) (point-max))
  (make-local-variable 'kept-undo-information)
  (setq kept-undo-information nil)
  (make-local-variable 'need-not-save)
  (setq need-not-save t)
  (with-output-to-selected-buffer
    (long-operation
      (with-open-stream (ls (make-listen-socket nil 80))
        (wwwsvr-log "[ server started ]")
        (loop
          (with-open-stream (sock (accept-connection ls))
            (wwwsvr-log "[ connection accepted ]")
            (multiple-value-bind (method target)
                (wwwsvr-receive sock)
              (wwwsvr-send sock method target)))
          (wwwsvr-log "[ connection closed ]"))))))

; 受信関数
(defun wwwsvr-receive (sock)
  (let (line method target)
    (while (and (setq line (read-line sock nil))
                (not (string= line "")))
      (when (string-match
             "^\\(.*\\) /\\([^ ]*\\) HTTP/[0-9]*\.[0-9]*$" line)
        (setq method (match-string 1))
        (setq target (match-string 2)))
      (wwwsvr-log line))
    (wwwsvr-log (format nil "request received (~S ~S)" method target))
    (values method target)))

; 送信関数
(defun wwwsvr-send (sock method target)
  (let (line)
    (format sock "HTTP/1.0 200 OK\n\n")
    (cond ; 対象が存在する場合
          ; ※ここで色々するとサーバサイドスクリプトとして
          ; 　lispが使えて面白いかも
          ((find-buffer target)
           (with-input-from-buffer ((find-buffer target))
             (while (setq line (read-line *standard-input* nil))
               (princ line sock)
               (princ "\n" sock)))
           (wwwsvr-log "[ target sent ]"))
          ; 無指定の場合
          ; ※バッファのリストを返す
          ((string= target "")
           (format sock "<html><body><h3>buffers list</h3><hr><ol>\n")
           (format sock "~:{<li><a href=\"/~A\">~A</a></li>~}\n"
                   (mapcar #'(lambda (x) (list x x))
                           (mapcar 'buffer-name (buffer-list))))
           (format sock "</ol><hr></body></html>\n")
           (wwwsvr-log "[ buffers list sent ]"))
          ; 見つからなかった場合
          ; ※見つからない旨を通知
          (t
           (format sock "<html><body>missing ~S</body></html>" target)
           (wwwsvr-log "[ error message sent ]")))))

; ログ表示用関数
(defun wwwsvr-log (s)
  (format t "<~A> ~A\n" (format-date-string "%Y-%m-%d %H:%M:%S") s)
  (refresh-screen))