[xyzzy:06112] Re: Q: filer "]" 送る機能

[KAMEI Tetsuya <kamei@xxxxxxxxxxxx>]

ryo_h さん、とーいさん、こんにちは。

	2001年2月8日(木)[18:53:48]の、
	[xyzzy:06109] Re: Q: filer "]"送る機能
	への返事です。

そすると、とりあえずこうかな。文字数の制限はまだあるけど。

(defun filer-send-to ()
  (unless (zerop (filer-count-marks))
    (let* ((send-to (get-special-folder-location :send-to))
	   (dests (nconc (sort (directory send-to :file-only t :recursive t) #'string-lessp)
			 *filer-send-to-list*)))
      (multiple-value-bind (result data)
	  (dialog-box '(dialog 0 0 184 107
			(:caption "送っちゃうよ")
			(:font 9 "ＭＳ Ｐゴシック")
			(:control
			 (:listbox list nil #x50b10001 2 3 118 103)
			 (:button IDOK "送る" #x50030001 128 7 52 14)
			 (:button IDCANCEL "送らない" #x50030000 128 27 52 14)))
		      (list (cons 'list (mapcar #'(lambda (x)
						    (if (consp x)
							(car x)
						      (substitute-string x "\\.\\(lnk\\|pif\\)$" "")))
						dests))
			    '(list . 0))
		      '((list :index t :must-match t :enable (IDOK))))
	(when result
	  (let* ((selected (nth (cdr (assoc 'list data)) dests))
		 (dest (if (consp selected)
			   (cdr selected)
			 (merge-pathnames selected send-to)))
		 (link (truename (ed::filer-read-link dest))))
	    (if (file-directory-p link)
		(filer-copy (append-trail-slash link))
	      (shell-execute dest (filer-get-directory)
			     (format nil "~{\"~a\"~^ ~}"
				     (mapcar #'(lambda (x)
						 (file-namestring
						  (substitute-string x "/$" "")))
					     (filer-get-mark-files)))))))))))

-- 
亀井哲弥(Tetsuya Kamei)
kamei@xxxxxxxxxxxx