[Date Prev] [Date Index] [Date Next]
[Thread Prev] [Thread Index] [Thread Next]

[xyzzy:03988] den8-go-out

den8 + xyzzy 使いのみなさん，こんにちは。Toy です。

メールの本文の中から URL やメールアドレスを抽出して，ブラウ
ザを呼びだしたり，クリップボードにコピーしたりするものを作っ
てみました。しばらく使ってみて，自分の中ではまあまあ使えるネ
タかな？と思ったのでちょっと恥ずかしいですが公開してみます。
ちなみに，みなさんはこういうときどうしているのでしょうか？

いろいろ無駄な部分とかあるかもしんないですが，なにかありまし
たらぜひぜひ指摘してやってください。m(_ _)m

[いじれる変数]
   初期化ファイルあたりに書いていただけるといいかも
   ● メールアドレス抽出
        1. おれは電子メールアドレスもほしいんじゃー！
           (setq *toy-den8-get-email-address* 1)
        2. おれは電子メールアドレスもほしいんじゃー！
           でも頭に mailto 付けてもらえる？
           (setq *toy-den8-get-email-address* 2)
   ● クリップボード
        kill-ring をいじっちゃいやーん
        (setq *toy-den8-copy-to-clipboard* t)

(注意) mailto なしのメールアドレスについては，Go out ボタン
       を押しても，自動的にクリップボードにコピーされます。

みなさんのお役にたてるといいな。

P.S.	[xyzzy:02621] の stay-here 環境をお持ちの方は，
	; for stay-here
	(defun my-den8-go-out ()
	  (interactive)
	  (my-den8-stay-here
	    (toy-den8-go-out)))
	ってな感じでどうぞ。
---------------------------------------------------->(ここから)

;;
;; toy-den8-go-out
;;
(require "den8view")

; 電子メールアドレスも吸い取る
; (0: いらん，1: ほしいっす，2: じゃ mailto の方向で…)
(defvar *toy-den8-get-email-address* 0)

; kill-ring をいじっちゃいやーん
(defvar *toy-den8-copy-to-clipboard* nil)

; 各プロトコルのヘッダ
(defvar *toy-den8-protocol-header*
  "\\(http\\|https\\|ftp\\|news\\|nntp\\|wais\\|telnet\\|mailto\\|gopher\\|rlogin\\)")

; お出かけですか？
(defun toy-den8-go-out ()
  (interactive)
  (let ((lines nil)				; 読み込んだ行のリスト
	(URL-list nil))				; 読み込んだ URL のリスト
    ; URL リストの生成
    (pop-to-buffer "*Den8 View*")
    (save-excursion
      (goto-char (point-min))
      ; ヘッダの部分はパス
      (scan-buffer "--------" :tail t)
      (save-restriction
	(narrow-to-region (point) (point-max))
	; URL の吸い出し
	(while (not (eobp))
	  (unless (scan-buffer
		   (concat "\\("
			   *toy-den8-protocol-header*
			   "://[-a-zA-Z0-9_/~.#@%?&=;+(),'$!*:]*\\|[-a-zA-Z0-9_.]+@[-a-zA-Z0-9_.]+\\)")
		   :regexp t)
	    (return))
	  (goto-char (match-end 0))
	  (let ((picked (buffer-substring (match-beginning 0)(match-end 0))))
	    (if (string-match
		 (concat *toy-den8-protocol-header* ".*") picked)
		(setq URL-list (cons picked URL-list))
	      (case *toy-den8-get-email-address*
		(1 (setq URL-list (cons picked URL-list)))
		(2 (setq URL-list (cons (concat "mailto:" picked) URL-list)))))))))
    ; URL リストの整理
    (setq URL-list (sort (uniq URL-list) #'string-lessp))
    ; エラーメッセージ
    (and (null URL-list)
	 (error "URL がなっしん"))
    ; ダイアログ作成
    (multiple-value-bind (result data)
	(dialog-box '(dialog 0 0 282 100
		      (:caption "Go out for a walk")
		      (:font 9 "ＭＳ Ｐゴシック")
		      (:control
		       (:listbox list nil #x50b10101 7 7 207 86)
		       (:button IDOK "Go out (&G)" #x50010001 223 7 52 16)
		       (:button IDCANCEL "Cancel" #x50010000 223 26 52 16)
		       (:button IDCLIP "Clip it! (&C)" #x50010000 223 45 52 16)))
		    (list (cons 'list URL-list)
			  (cons 'list 0))
		    '((list :column (1 30) :must-match t :enable (IDOK open))))
      ; ブラウザの呼び出し
      (when result
	(let ((URL (cdar data)))		; 選択された URL
	  (cond ((and (eq result 'IDOK)
		      (string-match
		       (concat *toy-den8-protocol-header* ".*") URL))
		 (shell-execute URL t))
		((or (eq result 'IDCLIP)
		     (eq result 'IDOK))
		 (if *toy-den8-copy-to-clipboard*
		     (copy-to-clipboard URL)
		   (progn
		     (setq *clipboard-newer-than-kill-ring-p* nil
			   *kill-ring-newer-than-clipboard-p* t)
		     (ed::kill-new URL))))))))))

; リストから重複を取り除く
; Thanx to Tomoaki Ohno
(defun uniq (%list)
  (cond ((null %list) nil)
	(t (cons (car %list)
		 (uniq (remove (car %list) %list :test #'equal))))))

---------------------------------------------------->(ここまで)

---- 
Toy
  E-mail : s5087@xxxxxxxxxxxxxxxxxxxxx
Index Home