X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-mule.el;h=c37c7102de557c24332b8975a4b114c868dbd5bd;hb=4ac381c94e0dea68f64ceccfe34cb8cf41926db8;hp=48cff6f2d2cc37ddff6979761b16443fa7204cdd;hpb=904f224e492403eb92709aa60d90858c2d1b714d;p=elisp%2Fwanderlust.git diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 48cff6f..c37c710 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -1,7 +1,6 @@ -;;; wl-mule.el -- Wanderlust modules for Mule compatible Emacsen. -;; (Mule2.3@19.28, Mule2.3@19.34, Emacs 20.x) +;;; wl-mule.el --- Wanderlust modules for Mule compatible Emacsen. -;; Copyright 1998,1999,2000 Yuuichi Teranishi +;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi ;; Author: Yuuichi Teranishi ;; Keywords: mail, net news @@ -25,10 +24,10 @@ ;; ;;; Commentary: -;; +;; For Mule2.3@19.34, Emacs 20.x ;;; Code: -;; +;; (eval-when-compile (require 'wl-folder) @@ -53,76 +52,74 @@ Special commands: "Highlight current folder line." (interactive) (save-excursion - (let ((highlights (list "opened" "closed")) + (end-of-line) + (let ((end (point)) + (start (progn (beginning-of-line) (point))) (inhibit-read-only t) - (fld-name (wl-folder-get-folder-name-by-id - (get-text-property (point) 'wl-folder-entity-id))) - fregexp fsymbol bol eol matched type extent num type) - (beginning-of-line) - (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) - (if (and numbers (nth 0 numbers) (nth 1 numbers)) - (progn - (setq fsymbol - (let ((unsync (nth 0 numbers)) - (unread (nth 1 numbers))) - (cond ((and unsync (eq unsync 0)) - (if (and unread (> unread 0)) - 'wl-highlight-folder-unread-face - 'wl-highlight-folder-zero-face)) - ((and unsync - (>= unsync wl-folder-many-unsync-threshold)) - 'wl-highlight-folder-many-face) - (t - 'wl-highlight-folder-few-face)))) - (put-text-property bol eol 'face fsymbol) - (setq matched t))) - (catch 'highlighted - (while highlights - (setq fregexp (symbol-value - (intern (format "wl-highlight-folder-%s-regexp" - (car highlights))))) - (if (not wl-highlight-group-folder-by-numbers) - (setq fsymbol (intern (format "wl-highlight-folder-%s-face" - (car highlights))))) - (when (looking-at fregexp) - (put-text-property bol eol 'face fsymbol) - (setq matched t) - (throw 'highlighted nil)) - (setq highlights (cdr highlights)))) - (if (not matched) - (if (looking-at (format "^[ ]*\\(%s\\|%s\\)" - wl-folder-unsubscribe-mark - wl-folder-removed-mark)) - (put-text-property bol eol 'face - 'wl-highlight-folder-killed-face) - (put-text-property bol eol 'face - 'wl-highlight-folder-unknown-face))) - (if wl-use-highlight-mouse-line - (wl-highlight-folder-mouse-line))))) - + (text-face + (cond ((and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-opened-regexp)) + 'wl-highlight-folder-opened-face) + ((and (wl-folder-buffer-group-p) + (looking-at wl-highlight-folder-closed-regexp)) + 'wl-highlight-folder-closed-face) + (t + (if (looking-at (format "^[ \t]*\\(%s\\|%s\\)" + wl-folder-unsubscribe-mark + wl-folder-removed-mark)) + 'wl-highlight-folder-killed-face + 'wl-highlight-folder-unknown-face))))) + (if (and wl-highlight-folder-by-numbers + numbers (nth 0 numbers) (nth 1 numbers) + (re-search-forward "[0-9-]+/[0-9-]+/[0-9-]+" end t)) + (let* ((unsync (nth 0 numbers)) + (unread (nth 1 numbers)) + (face (cond + ((and unsync (zerop unsync)) + (if (and unread (zerop unread)) + 'wl-highlight-folder-zero-face + 'wl-highlight-folder-unread-face)) + ((and unsync + (>= unsync wl-folder-many-unsync-threshold)) + 'wl-highlight-folder-many-face) + (t + 'wl-highlight-folder-few-face)))) + (if (numberp wl-highlight-folder-by-numbers) + (progn + (put-text-property start (match-beginning 0) 'face text-face) + (put-text-property (match-beginning 0) (point) 'face face)) + ;; Remove previous face. + (put-text-property start (point) 'face nil) + (put-text-property start (point) 'face face)) + (goto-char start)) + (put-text-property start end 'face text-face))) + (when wl-use-highlight-mouse-line + (wl-highlight-folder-mouse-line)))) + (defun wl-highlight-plugged-current-line ()) (defun wl-plugged-set-folder-icon (folder string) string) -(defun wl-folder-init-icons ()) ; dummy. -(defun wl-plugged-init-icons ()) ; dummy. - -(defun wl-xmas-setup-folder ()) ; dummy -(defun wl-xmas-setup-summary ()) -(defun wl-xmas-setup-draft-toolbar ()) - -(defun wl-message-overload-functions () - (local-set-key "l" 'wl-message-toggle-disp-summary) - (local-set-key [mouse-2] 'wl-message-refer-article-or-url) - (local-set-key [mouse-4] 'wl-message-wheel-down) - (local-set-key [mouse-5] 'wl-message-wheel-up) - (local-set-key [S-mouse-4] 'wl-message-wheel-down) - (local-set-key [S-mouse-5] 'wl-message-wheel-up)) +(defun wl-message-define-keymap () + (let ((keymap (make-sparse-keymap))) + (define-key keymap "D" 'wl-message-delete-current-part) + (define-key keymap "l" 'wl-message-toggle-disp-summary) + (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime) + (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime) + (define-key keymap "w" 'wl-draft) + (define-key keymap [mouse-4] 'wl-message-wheel-down) + (define-key keymap [mouse-5] 'wl-message-wheel-up) + (define-key keymap [S-mouse-4] 'wl-message-wheel-down) + (define-key keymap [S-mouse-5] 'wl-message-wheel-up) + (set-keymap-parent wl-message-button-map keymap) + (define-key wl-message-button-map [mouse-2] + 'wl-message-button-dispatcher) + keymap)) (defun wl-message-wheel-up (event) (interactive "e") - (if (string-match wl-message-buf-name (buffer-name)) + (if (string-match (regexp-quote wl-message-buffer-name) + (regexp-quote (buffer-name))) (wl-message-next-page) (let ((cur-buf (current-buffer)) proceed) @@ -137,7 +134,8 @@ Special commands: (defun wl-message-wheel-down (event) (interactive "e") - (if (string-match wl-message-buf-name (buffer-name)) + (if (string-match (regexp-quote wl-message-buffer-name) + (regexp-quote (buffer-name))) (wl-message-prev-page) (let ((cur-buf (current-buffer)) proceed) @@ -152,7 +150,6 @@ Special commands: (defun wl-draft-key-setup () (define-key wl-draft-mode-map "\C-c\C-y" 'wl-draft-yank-original) - (define-key wl-draft-mode-map "\C-c\C-a" 'wl-draft-insert-x-face-field) (define-key wl-draft-mode-map "\C-c\C-s" 'wl-draft-send) (define-key wl-draft-mode-map "\C-c\C-c" 'wl-draft-send-and-exit) (define-key wl-draft-mode-map "\C-c\C-z" 'wl-draft-save-and-exit) @@ -165,37 +162,50 @@ Special commands: (define-key wl-draft-mode-map "\C-c\C-e" 'wl-draft-config-exec) (define-key wl-draft-mode-map "\C-c\C-j" 'wl-template-select) (define-key wl-draft-mode-map "\C-c\C-p" 'wl-draft-preview-message) - (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) - (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer)) +;; (define-key wl-draft-mode-map "\C-x\C-s" 'wl-draft-save) + (define-key wl-draft-mode-map "\C-c\C-a" 'wl-addrmgr) + (define-key wl-draft-mode-map "\C-xk" 'wl-draft-mimic-kill-buffer) + (define-key wl-draft-mode-map "\C-c\C-d" 'wl-draft-elide-region) + (define-key wl-draft-mode-map "\C-a" 'wl-draft-beginning-of-line) + (define-key wl-draft-mode-map "\M-p" 'wl-draft-previous-history-element) + (define-key wl-draft-mode-map "\M-n" 'wl-draft-next-history-element)) (defun wl-draft-overload-menubar () - (local-set-key [menu-bar mail send] - '("Send Message" . wl-draft-send-and-exit)) - (local-set-key [menu-bar mail send-stay] - '("Send, Keep Editing" . wl-draft-send)) - (local-set-key [menu-bar mail cancel] - '("Kill Current Draft" . wl-draft-kill)) - (local-set-key [menu-bar mail yank] - '("Cite Message" . wl-draft-yank-original)) - (local-set-key [menu-bar mail signature] - '("Insert Signature" . insert-signature)) - (local-set-key [menu-bar headers fcc] - '("FCC" . wl-draft-fcc))) + (let ((keymap (current-local-map))) + (define-key keymap [menu-bar mail send] + '("Send Message" . wl-draft-send-and-exit)) + (define-key keymap [menu-bar mail send-stay] + '("Send, Keep Editing" . wl-draft-send)) + (define-key-after (lookup-key keymap [menu-bar mail]) + [mail-sep-send] '("--") + 'send-stay) + (define-key keymap [menu-bar mail cancel] + '("Kill Current Draft" . wl-draft-kill)) + (define-key-after (lookup-key keymap [menu-bar mail]) + [save] '("Save Draft and Exit" . wl-draft-save-and-exit) + 'cancel) + (define-key-after (lookup-key keymap [menu-bar mail]) + [mail-sep-exit] '("--") + 'save) + (define-key-after (lookup-key keymap [menu-bar mail]) + [preview] '("Preview Message" . wl-draft-preview-message) + 'mail-sep-exit) + (define-key keymap [menu-bar mail yank] + '("Cite Message" . wl-draft-yank-original)) + (define-key keymap [menu-bar mail signature] + '("Insert Signature" . insert-signature)) + (define-key keymap [menu-bar headers fcc] + '("Fcc" . wl-draft-fcc)))) (defun wl-draft-overload-functions () - (setq mode-line-buffer-identification - (format "Wanderlust: %s" (buffer-name))) - (local-set-key "\C-c\C-s" 'wl-draft-send) ; override - (wl-draft-overload-menubar) - (when wl-show-plug-status-on-modeline - (setq mode-line-format (wl-make-modeline)))) - -(defalias 'wl-make-modeline 'wl-make-modeline-subr) + (wl-mode-line-buffer-identification) +;; (local-set-key "\C-c\C-s" 'wl-draft-send);; override + (wl-draft-overload-menubar)) ;; for "ja-mule-canna-2.3.mini" on PocketBSD (defun-maybe make-face (a)) -(eval-when-compile +(eval-when-compile (require 'static)) (static-cond ((and (fboundp 'defface) @@ -232,7 +242,7 @@ Special commands: Each keyword should be listed in `custom-face-attributes'. If FRAME is nil, set the default face." - (while atts + (while atts (let* ((name (nth 0 atts)) (value (nth 1 atts)) (fun (nth 1 (assq name wl-face-attributes)))) @@ -288,11 +298,17 @@ If FRAME is nil, the current FRAME is used." ((eq req 'background) (memq background options)) (t - (message (format "\ -Warning: Unknown req `%S' with options `%S'" req options)) + (message "\ +Warning: Unknown req `%S' with options `%S'" req options) nil)))) match))))) -(provide 'wl-mule) +(defun wl-read-event-char (&optional prompt) + "Get the next event." + (let ((event (read-event prompt))) + (cons (and (numberp event) event) event))) + +(require 'product) +(product-provide (provide 'wl-mule) (require 'wl-version)) ;;; wl-mule.el ends here