[xyzzy:04713] ポップアップメニューとか

[YAMAMOTO Taizo <ymtz@xxxxxxxxxxxxxxx>]

やまもと%YMTZです。

ディレクトリ構造をポップアップメニューにマップするための
関数を書いたので、暇な人は使ってみてください。
ちなみに、ルートで実行すると、どんなことになるのか知りません(^^;)

＃本当は電信八号でデコードしたディレクトリを見るために
＃作ったのですが、時間が無くてそこまで行ってません。

;;; 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 '(("いわゆるすべてのファイル(*.*)" . "*.*"))))))

;;; create mime dir-list & menu
(defun create-mime-dir-list (src func)
  (let* ((dlst (sort (directory src :directory-only t :absolute t) #'string-lessp))
	 (flst (sort (directory src :file-only t) #'string-lessp))
	 (lst (append (mapcar #'(lambda (x) (list (file-namestring
						   (string-right-trim "/\\" x )
						   ;x
						  ) (create-mime-dir-list x func))) dlst)
		      (mapcar #'(lambda (x) (list x #'(lambda () (interactive) (apply func (list (append-trail-slash src) x))))) flst))))
    lst))

(defun create-mime-menu (dlst)
  (let ((mnu (create-popup-menu)) (dn 0) (fn 0))
    (dolist (item dlst)
      (let ((icar (car item))
	    (icadr (cadr item)))
	(cond ((functionp icadr)
	       (when (and (not (zerop dn)) (zerop fn))
		 (add-menu-separator mnu))
	       (incf fn)
	       (add-menu-item mnu 'mime-menu icar icadr))
	      (t
	       (incf dn)
	       (add-popup-menu mnu (create-mime-menu icadr) icar)))))
    mnu))

;;; how to use
(setq *app-popup-menu*
      (create-mime-menu
       (create-mime-dir-list "c:/my documents" 'sample-function)))

----
    YAMAMOTO Taizo / 山本 泰三
        mailto:ymtz@xxxxxxxxxxxxxxx
        mailto:yamamoto@xxxxxxxxx
        http://www1.odn.ne.jp/ymtz/