[Mew-Win32 01404] mew-browse.el (Re: mew-w32-url-mailto)
Hideyuki SHIRAI ( 白井秀行 )
shirai at example.com
1999年 5月 20日 (木) 15:30:20 JST
白> おぉ、そう来ましたか。たしかに、Win32 向けじゃないから、
白> mew-win32.el に入れるべき内容じゃないですね。
北口> # 名前その他気に入らなければ、適当に変更して下さい。
白> それでは、名前をそろえて、UNIX とかでも動くようにしましょうか。
白> ちょっと待っててくださいね。
'mew-browse.el' と名前を変えて汎用品にしました。これで、私の
~/.emacs もすっきり :-)
mew-url-mailto() と url-mail の乗っ取り部分を mew-browse.el にい
れるかどうか悩んだんですが、やめました。
# なぜか、defaliase だと Emacs 19.28(Mule for Win32 含む)で動か
# なかったし……
お後はよろしく > 北口さん
--
白井秀行 (mailto:shirai at example.com)
-------------- next part --------------
;;; mew-browse.el --- Handling URI with browse-url.el
;; Author: Hideyuki SHIRAI <shirai at example.com>
;; Modify: Shuichi Kitaguchi <kit at example.com>
;; Created: May 19, 1999
;; Revised: May 20, 1999
;;;
;;; ~/.emacs settings.
;;;
;; (require 'mew-browse)
;;; SHIFT + (Middle|Right)-Click = browse-url or mew-user-agent-compose
;;; for Emacs
;; (define-key global-map [S-mouse-2] 'browse-url-at-mouse)
;;; for XEmacs
;; (define-key global-map [(shift button2)] 'browse-url-at-mouse)
;;
;;; Appending URI to specified file.
;;
;; mew-browse-noask ... ask or not when browse
;; mew-browse-append-file ... URL collection file name
;; mew-browse-append-always-file ... always, append URL to file (for dial-up)
;; mew-browse-append-always-mailto ... always, URL is mailto: (for emacs19.28)
;; mew-browse-append-file-sort ... always, sort URL file
;;
;;; example:
;; (setq mew-browse-noask nil)
;; (setq mew-browse-append-file "~/.browse")
;; (setq mew-browse-append-always-file nil)
;; (setq mew-browse-append-always-mailto nil)
;; (setq mew-browse-append-file-sort nil)
;;
;;; Use mew-browse-url-mailto instead of url-mailto in W3.
;; (defun mew-url-mailto (url)
;; (interactive)
;; (if (or (not (boundp 'mew-mail-path)) (null mew-mail-path))
;; (save-excursion (mew)))
;; (mew-browse-url-mailto url))
;;
;; (cond
;; ((locate-library "url-mail")
;; (eval-after-load "url-mail"
;; '(fset 'url-mailto (symbol-function 'mew-url-mailto))))
;; ((locate-library "url")
;; (eval-after-load "url"
;; '(fset 'url-mailto (symbol-function 'mew-url-mailto)))))
;;
(eval-when-compile (require 'mew))
(if (string-match "XEmacs" emacs-version)
(defvar mew-browse-button [(button2)] "*Mouse button in message mode.")
(defvar mew-browse-button [mouse-2] "*Mouse button in message mode."))
(setq browse-url-browser-function 'mew-browse-url)
(add-hook 'mew-init-hook
(lambda ()
(progn
(define-key mew-message-mode-map mew-browse-button 'browse-url-at-mouse)
)))
(defvar mew-browse-url-mailto-switch-func nil
"*Which do you like, nil, 'switch-to-buffer-other-window or 'switch-to-buffer-other-frame ?")
(setq browse-url-regexp "\\(\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]+\\)\\|\\(\\([^-A-Za-z0-9!_.%]\\|^\\)[-A-Za-z0-9._!%]+@[A-Za-z0-9][-A-Za-z0-9._!]+[A-Za-z0-9]\\)")
(defvar mew-browse-noask t "*Ask or not when browse.")
(defvar mew-browse-append-file nil "*URL collection file.")
(defvar mew-browse-append-always-file nil "*For dialup user")
(defvar mew-browse-append-always-mailto nil "*For emacs19.28")
(defvar mew-browse-append-file-sort nil "*Sort URL file.")
(defun mew-browse-url (url &optional args)
"browse URL or mew-user-agent-compose."
(interactive)
(if (or (not (boundp 'mew-mail-path)) (null mew-mail-path))
(save-excursion (mew)))
(let* ((append-buffer (and mew-browse-append-file
(string= buffer-file-name
(expand-file-name mew-browse-append-file))))
(append-nil (or append-buffer (not mew-browse-append-file)))
(append-all (and (not append-nil) mew-browse-append-always-file))
(append-ask (and (not append-nil) (not mew-browse-append-always-file)))
(browse-all (or append-buffer mew-browse-noask))
(browse-ask (and (not append-buffer) (not mew-browse-noask))))
(string-match "\\([a-zA-Z0-9][-a-zA-Z0-9!_=?#$@~`%&*+|\\/.,:]+\\)" url)
(setq url (substring url (match-beginning 0) (match-end 0)))
(if (not (string-match ":" url)) ;; emacs19.28 only
(if (and (not mew-browse-append-always-mailto)
(not (y-or-n-p (format "mailto:%s(y) or ftp://%s(n)? " url url))))
(setq url (concat "ftp://" url))
(setq url (concat "mailto:" url))))
(cond
((and append-all browse-all)
(mew-browse-url-append url)
(mew-browse-url-start url))
((and append-ask browse-all)
(if (y-or-n-p (format "Append %s? " url))
(mew-browse-url-append url))
(mew-browse-url-start url))
((and append-nil browse-all)
(mew-browse-url-start url))
((and append-all browse-ask)
(mew-browse-url-append url)
(if (y-or-n-p (format "Browse %s? " url))
(mew-browse-url-start url)))
((and append-nil browse-ask)
(if (y-or-n-p (format "Browse %s? " url))
(mew-browse-url-start url)))
(t ;; (and append-ask browse-ask)
(if (y-or-n-p (format "Browse %s(y) or Append(n)? " url))
(mew-browse-url-start url)
(mew-browse-url-append url)))
)))
(defun mew-browse-url-append (url)
(let ((file (expand-file-name mew-browse-append-file))
(beg))
(save-excursion
(find-file file)
(set-buffer (current-buffer))
(goto-char (point-min))
(while (search-forward url nil t)
(progn
(beginning-of-line)
(setq beg (point))
(forward-line)
(delete-region beg (point))))
(goto-char (point-max))
(insert url "\n")
(if mew-browse-append-file-sort
(sort-lines nil (point-min) (point-max)))
(write-file file)
(kill-buffer (current-buffer))
(message "Append %s to %s done." url file)
)))
(defun mew-browse-url-start (url)
(message "Browse %s." url)
(cond
((string-match "^mailto:" url)
(mew-browse-url-mailto url))
((and (symbolp mew-ext-prog-url) (fboundp mew-ext-prog-url))
(funcall mew-ext-prog-url url))
((equal mew-ext-prog-url "w3")
(require 'w3)
(w3-fetch-other-frame url))
(t
(apply (function start-process)
(format "*mew %s*" mew-ext-prog-url)
mew-buffer-tmp mew-ext-prog-url
(append mew-ext-prog-url-args (list url))))))
(defun mew-browse-url-mailto (url)
(interactive)
(let (tmp to subject body other)
(and (boundp 'url-working-buffer)
url-working-buffer
(get-buffer url-working-buffer)
(kill-buffer url-working-buffer))
(and (functionp 'url-view-url) (url-view-url t)
(setq other (cons (cons (capitalize "x-url-from") (url-view-url t)) other)))
(while (string-match "[ \t]+" url)
(setq url (concat (substring url 0 (match-beginning 0))
(substring url (match-end 0)))))
(if (string-match "^mailto:" url)
(setq tmp (mew-browse-url-mailto-decamp (substring url (match-end 0))))
(setq tmp (mew-browse-url-mailto-decamp url)))
(if (string-match "^\\([^?]+\\)" tmp)
(progn
(setq to (mew-browse-url-mailto-hex-to-string
(substring tmp (match-beginning 1) (match-end 1))))
(setq tmp (substring tmp (match-end 0)))))
(while (string-match "^[?&]\\([^=]+\\)=\\([^&]*\\)" tmp)
(let ((hname (substring tmp (match-beginning 1) (match-end 1)))
(hvalue (mew-browse-url-mailto-hex-to-string
(substring tmp (match-beginning 2) (match-end 2)))))
(setq tmp (substring tmp (match-end 0)))
(cond
((string-match "^to$" hname)
(if to
(setq to (concat to ", " hvalue))
(setq to hvalue)))
((string-match "^subject$" hname)
(setq subject hvalue))
((string-match "^body$" hname)
(setq body hvalue))
(t
(setq other (cons (cons (capitalize hname) hvalue) other))))))
(let ((mew-x-mailer mew-x-mailer))
(and (functionp 'url-view-url) (url-view-url t)
(setq mew-x-mailer
(concat mew-x-mailer " / " url-package-name "-" url-package-version)))
(mew-user-agent-compose to subject other nil mew-browse-url-mailto-switch-func))
(if body
(save-excursion
(goto-char (point-max))
(insert body "\n")))))
(defun mew-browse-url-mailto-decamp (str)
(save-match-data
(while (string-match "&" str)
(setq str (concat (substring str 0 (match-beginning 0))
"&"
(substring str (match-end 0)))))
str))
(defun mew-browse-url-mailto-hex-to-string (str)
(save-match-data
(while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" str)
(setq str (concat (substring str 0 (match-beginning 0))
(make-string
1
(mew-browse-url-mailto-2hexs-to-int
(substring str (match-beginning 1) (match-end 1))))
(substring str (match-end 0)))))
str))
(defun mew-browse-url-mailto-2hexs-to-int (hex)
(+ (* 16 (mew-hexchar-to-int (aref hex 0)))
(mew-hexchar-to-int (aref hex 1))))
(provide 'mew-browse)
;;; mew-browse.el ends here
Mew-win32 メーリングリストの案内