url ファイルが D&D されたら URL を挿入する
http://xyzzy.s53.xrea.com/wiki/index.php?cmd=read&page=tips%2FURL%A5%B7%A5%E7%A1%BC%A5%C8%A5%AB%A5%C3%A5%C8%A4%F2D%A1%F5D%A4%B5%A4%EC%A4%BF%A4%E9URL%A4%F2%C1%DE%C6%FE%A4%B9%A4%EB にインスパイヤされました。
今回の改造にあたって加えられた新たなオリジナリティは以下。
- *insert-url-string-func-alist* で挿入する文字列を生成するようにしました。
- *before-find-file-hook* にフックすると url ファイルが xyzzy で開けなくなるので、*drag-and-drop-hook* にセットするようにしました。
以下の環境で動作確認しました。
- Windows XP Home Edition SP2
- xyzzy 0.2.2.235
『応用例』を追加しました。
url ファイルを D&D すると、カレントバッファのカーソル位置に内容を挿入します。
*insert-url-string-func-alist* は、挿入文字列を生成する関数の連想リストで、要素に関数のペアをセットします。先頭の要素から car 部の関数を実行していき、関数が non-nil を返した要素の cdr 部の関数を使用して挿入文字列を生成します。
*insert-url-string-default-func* には、デフォルトの挿入文字列生成関数をセットします。*insert-url-string-func-alist* で生成関数を決定できなかった場合に使用されます。
以下のものが定義済みです。
- html-mode,
- //www1.odn.ne.jp/ymtz/html_plus-mode.html">html+-mode, xml-mode のマイナーモード XHTML1.0/1.1:『<a href="URL">ファイル名</a>\n』という文字列を挿入する
- lisp-mode, lisp-interaction-mode
- 『* ファイル名\n <URL>\n』という文字列を挿入する
- text-mode
- 『* ファイル名\n URL\n』という文字列を挿入する
- デフォルト
- 『ファイル名\nURL\n』という文字列を挿入する
コード
;; url ファイルが D&D されたら URL を挿入する ; * tips/URLショートカットをD&DされたらURLを挿入する - XyzzyWiki ; <http://xyzzy.s53.xrea.com/wiki/index.php?cmd=read&page=tips%2FURL%A5%B7%A5%E7%A1%BC%A5%C8%A5%AB%A5%C3%A5%C8%A4%F2D%A1%F5D%A4%B5%A4%EC%A4%BF%A4%E9URL%A4%F2%C1%DE%C6%FE%A4%B9%A4%EB> ; から朴りました。 ; url ファイルが D&D されたら URL を挿入するか否か (defvar *insert-url-string-enable* t) ; デフォルトの挿入文字列生成関数 ; 引数 : name - 文字列 - url ファイルのファイル名 ; 引数 : url - 文字列 - url ファイルの InternetShortcut セクション->URL キーの値 ; 戻り値: 挿入する文字列 (defvar *insert-url-string-default-func* #'(lambda (name url) (format nil "~A~%~A~%" name url))) ; 関数の連想リスト ; car の関数が non-nil を返すとき cdr の関数で挿入文字列を生成する ; car の関数の引数はドロップされた url ファイルのパス (defvar *insert-url-string-func-alist* (list (cons #'(lambda (&optional f) (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)))) (let* ((rs #'(lambda (str alst) (dolist (var alst str) (setq str (substitute-string str (car var) (cdr var)))))) (getu #'(lambda (url) (funcall rs url '(("&" . "&") ("<" . "<") (">" . ">") ("\"" . """))))) (getn #'(lambda (name) (funcall rs name '(("&" . "&") ("<" . "<") (">" . ">")))))) #'(lambda (name url) (format nil "<a href=\"~A\">~A</a>~%" (funcall getu url) (funcall getn name))))) (cons #'(lambda (&optional f) (member buffer-mode '("lisp-mode" "lisp-interaction-mode") :test #'string=)) #'(lambda (name url) (format nil "* ~A~% <~A>~%" name url))) (cons #'(lambda (&optional f) (string= buffer-mode "text-mode")) #'(lambda (name url) (format nil "* ~A~% ~A~%" name url))) )) ; ドロップされた url ファイルをごみ箱へ移動するか否か (defvar *insert-url-string-kill-shortcut-file* nil) (defun insert-url-string-get-func (&optional f) (or (some #'(lambda (x) (if (funcall (car x) f) (cdr x))) *insert-url-string-func-alist*) *insert-url-string-default-func*)) ;(require "api") (unless (fboundp 'GetPrivateProfileString) (require "wip/winapi") (c:define-dll-entry winapi:DWORD GetPrivateProfileString (winapi:LPCSTR winapi:LPCSTR winapi:LPCSTR winapi:LPCSTR winapi:DWORD winapi:LPCSTR) "kernel32" "GetPrivateProfileStringA")) (defun insert-url-string (f) (let* ((name (pathname-name f)) (sec (si:make-string-chunk "InternetShortcut")) (key (si:make-string-chunk "URL")) (non (si:make-string-chunk "")) (sz 508) (url (si:make-chunk nil sz)) (file (si:make-string-chunk (map-slash-to-backslash f))) (func (insert-url-string-get-func f))) ;(win-user::GetPrivateProfileString sec key non url sz file) (GetPrivateProfileString sec key non url sz file) (setq url (si:unpack-string url 0)) (insert (funcall func name url)) (if *insert-url-string-kill-shortcut-file* (delete-file f :recycle t)) (selected-buffer))) (setq *drag-and-drop-hook* #'(lambda (window files) (and *insert-url-string-enable* (not (minibuffer-window-p window)) (let ((i 0) (n (list-length files))) (while (< i n) (let ((f (nth i files))) (when (string-equal "url" (pathname-type f)) (insert-url-string f) (or (delete f files) (setq files nil) (return)) (decf i) (decf n))) (incf i)))) (if files (ed::default-drag-and-drop-hook window files) t)))
応用例
以下の関数は、unDonut で現在のタブの URL とタイトルを、カレントバッファのカーソル位置に挿入します。
DonutP.API を使用するので、COM サーバの登録が行われていなければ動作しません。DonutP にもあるメソッドとプロパティしか使用していないので、DonutP でも使えると思います。
引数には、対象のタブの数を指定します。
例えば 3 と指定すると、現在のタブから右方向に 3 個のタブが対象となります。また、負の値を指定すると、左方向になります。
0 を指定すると、すべてのタブが対象となります。
省略時は、1 を指定したときと同じく現在のタブのみが対象となります。
戻り値は、挿入した URL とタイトルの数です。
M-x などでインタラクティブに呼び出すときには、C-u に続けて数字を入力すれば、関数に引数が渡せます。つまり、『C-u 3 M-x insert-url-string-undonut-current-tab』で 『(insert-url-string-undonut-current-tab 3)』を評価したときと同様になります。
インタラクティブに前置引数のみで呼び出したときには、すべてのタブが対象となります。つまり、『C-u M-x insert-url-string-undonut-current-tab』で、『(insert-url-string-undonut-current-tab 0)』を評価したときと同様になります。
(defun insert-url-string-undonut-current-tab (&optional (arg 1)) (interactive "*p") (let ((dntp (ole-create-object "DonutP.API"))) (if dntp (let ((cnt #{dntp.GetTabCount[]})) (if (> cnt 0) (let* ((all (or (zerop arg) (eq *prefix-args* 'universal-argument))) (idx (if all 0 #{dntp.TabIndex})) (inc (if (or all (plusp arg)) #'1+ #'1-)) (ins #'(lambda () (let ((doc #{dntp.GetDocumentObject[idx]})) (if doc (let ((url #{doc.URL}) (title #{doc.title})) (if (string= title "") (setq title url)) (insert (funcall (insert-url-string-get-func) title url)) (< -1 (setq idx (funcall inc idx)) cnt))))))) (dotimes (i (cond (all (- cnt idx)) ((minusp arg) (- arg)) (t arg)) i) (unless (funcall ins) (return (1+ i))))))))))
