X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-mule.el;h=985768dab646d9dda77963c1d1cfa07cfa82c590;hb=e21941a415f1b0c567b2635524853573ef3c3411;hp=e4e85cf1e30bde220d96fa1387fac56db7fd5192;hpb=1e366a559be4aec4ad4d3cf3e954b8e62a20d2f3;p=elisp%2Fwanderlust.git diff --git a/wl/wl-mule.el b/wl/wl-mule.el index e4e85cf..985768d 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -1,11 +1,9 @@ -;;; 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 -;; Time-stamp: <2000-03-22 15:57:29 teranisi> ;; This file is part of Wanderlust (Yet Another Message Interface on Emacsen). @@ -26,10 +24,10 @@ ;; ;;; Commentary: -;; +;; For Mule2.3@19.34, Emacs 20.x ;;; Code: -;; +;; (eval-when-compile (require 'wl-folder) @@ -54,76 +52,69 @@ 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 ((looking-at wl-highlight-folder-opened-regexp) + 'wl-highlight-folder-opened-face) + ((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 [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) @@ -138,7 +129,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) @@ -153,7 +145,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) @@ -166,37 +157,48 @@ 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)) (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) @@ -233,7 +235,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)))) @@ -289,11 +291,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 () + "Get the next event." + (let ((event (read-event))) + (cons (and (numberp event) event) event))) + +(require 'product) +(product-provide (provide 'wl-mule) (require 'wl-version)) ;;; wl-mule.el ends here