-;;; 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 <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
;;
;;; Commentary:
-;;
+;; For Mule2.3@19.34, Emacs 20.x
;;; Code:
-;;
+;;
(eval-when-compile
(require 'wl-folder)
"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)
(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)
(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)
(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))
((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
projects / elisp / wanderlust.git / blobdiff