;;; wl-e21.el -- Wanderlust modules for Emacs 21.
-;; Copyright 2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000,2001 Katsumi Yamaoka <yamaoka@jpl.org>
+;; Copyright (C) 2000,2001 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
;; Keywords: mail, net news
;; images instead of `insert-image', so don't delete such overlays
;; sloppily. Here is a sample code to show icons in the buffer.
;;
-;;(let (image from to icon overlay)
+;;(let (image icon from to overlay)
;; ;; The function `find-image' will look for an image first on `load-path'
;; ;; and then in `data-directory'.
;; (let ((load-path (cons wl-icon-dir load-path)))
;; (setq overlay (make-overlay from to))
;; ;; Put an image.
;; (overlay-put overlay 'before-string icon)
-;; ;; Put a mark that this overlay is made by `wl-e21'. It is not always
-;; ;; necessarily.
+;; ;; Put a mark to indicate that this overlay is made by `wl-e21'.
+;; ;; It is not always necessarily.
;; (overlay-put overlay 'wl-e21-icon t)
-;; ;; Make it can be removable.
+;; ;; Make it to be removable.
;; (overlay-put overlay 'evaporate t))
+;;
+;; Note that a port of Emacs to some platforms (e.g. MS-Windoze) does
+;; not yet support images. It is a pity that neither icons nor tool-
+;; bars will not be displayed in such systems.
;;; Code:
;;
(add-hook 'wl-folder-mode-hook 'wl-setup-folder)
(add-hook 'wl-folder-mode-hook 'wl-folder-init-icons)
-(add-hook 'wl-make-plugged-hook 'wl-biff-init-icons)
-(add-hook 'wl-make-plugged-hook 'wl-plugged-init-icons)
+(add-hook 'wl-init-hook 'wl-biff-init-icons)
+(add-hook 'wl-init-hook 'wl-plugged-init-icons)
(add-hook 'wl-summary-mode-hook 'wl-setup-summary)
)
"The Draft buffer toolbar.")
+(eval-when-compile
+ (defmacro wl-e21-display-image-p ()
+ '(and (display-graphic-p)
+ (image-type-available-p 'xpm))))
+
(defun wl-e21-setup-toolbar (bar)
- (let ((load-path (cons wl-icon-dir load-path))
- (props '(:type xpm :ascent center
- :color-symbols (("backgroundToolBarColor" . "None"))
- :file))
- (success t)
- icon up down disabled name success)
- (while bar
- (setq icon (aref (pop bar) 0))
- (unless (boundp icon)
- (setq name (symbol-name icon)
- up (find-image `((,@props ,(concat name "-up.xpm")))))
- (if up
- (progn
- (setq down (find-image `((,@props ,(concat name "-down.xpm"))))
- disabled (find-image `((,@props
- ,(concat name "-disabled.xpm")))))
- (set icon (vector down up disabled disabled)))
- (setq bar nil
- success nil))))
- success))
+ (when (and wl-use-toolbar
+ (wl-e21-display-image-p))
+ (let ((load-path (cons wl-icon-dir load-path))
+ (props '(:type xpm :ascent center
+ :color-symbols (("backgroundToolBarColor" . "None"))
+ :file))
+ (success t)
+ icon up down disabled name success)
+ (while bar
+ (setq icon (aref (pop bar) 0))
+ (unless (boundp icon)
+ (setq name (symbol-name icon)
+ up (find-image `((,@props ,(concat name "-up.xpm")))))
+ (if up
+ (progn
+ (setq down (find-image `((,@props ,(concat name "-down.xpm"))))
+ disabled (find-image
+ `((,@props ,(concat name "-disabled.xpm")))))
+ (set icon (vector down up disabled disabled)))
+ (setq bar nil
+ success nil))))
+ success)))
(defvar wl-e21-toolbar-configurations
'((auto-resize-tool-bar . t)
:image (symbol-value (aref def 0)))))))
(defun wl-e21-setup-folder-toolbar ()
- (and wl-use-toolbar
- (display-graphic-p)
- (wl-e21-setup-toolbar wl-folder-toolbar)
- (wl-e21-make-toolbar-buttons wl-folder-mode-map wl-folder-toolbar)))
+ (when (wl-e21-setup-toolbar wl-folder-toolbar)
+ (wl-e21-make-toolbar-buttons wl-folder-mode-map wl-folder-toolbar)))
(defun wl-e21-setup-summary-toolbar ()
- (and wl-use-toolbar
- (display-graphic-p)
- (wl-e21-setup-toolbar wl-summary-toolbar)
- (wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar)))
+ (when (wl-e21-setup-toolbar wl-summary-toolbar)
+ (wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar)))
(eval-when-compile
- (defsubst wl-e21-setup-message-toolbar ()
- (and wl-use-toolbar
- (display-graphic-p)
- (wl-e21-setup-toolbar wl-message-toolbar)
- (wl-e21-make-toolbar-buttons (current-local-map) wl-message-toolbar)))
+ (defsubst wl-e21-setup-message-toolbar (keymap)
+ (when (wl-e21-setup-toolbar wl-message-toolbar)
+ (wl-e21-make-toolbar-buttons keymap wl-message-toolbar)))
(defsubst wl-e21-setup-draft-toolbar ()
- (and wl-use-toolbar
- (display-graphic-p)
- (wl-e21-setup-toolbar wl-draft-toolbar)
- (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar))))
+ (when (wl-e21-setup-toolbar wl-draft-toolbar)
+ (wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar))))
(defvar wl-folder-toggle-icon-list
'((wl-folder-opened-image . wl-opened-group-folder-icon)
(eval-when-compile
(defsubst wl-e21-highlight-folder-group-line (start end icon numbers)
- (when (display-graphic-p)
+ (when (wl-e21-display-image-p)
(let (overlay)
(let ((overlays (overlays-in start end)))
(while (and (setq overlay (pop overlays))
(setq start (match-beginning 1)
end (match-end 1))
(let (image)
- (when (display-graphic-p)
+ (when (wl-e21-display-image-p)
(let (overlay)
(let ((overlays (overlays-in start end)))
(while (and (setq overlay (pop overlays))
(overlay-put overlay 'wl-e21-icon t)
(overlay-put overlay 'evaporate t))
(let (type)
+ (unless (get (caar wl-folder-internal-icon-list) 'image)
+ (wl-folder-init-icons))
(setq image
(cond ((string= fld-name wl-trash-folder);; trash folder
(let ((num (nth 2 numbers)));; number of messages
(defun wl-highlight-plugged-current-line ()
(interactive)
- (when (display-graphic-p)
+ (when (wl-e21-display-image-p)
(save-excursion
(beginning-of-line)
(when (looking-at "[\t ]*\\(\\[\\([^]]+\\)\\]\\)")
(overlay-put overlay 'invisible t))))))))
(defun wl-plugged-set-folder-icon (folder string)
- (if (display-graphic-p)
+ (if (wl-e21-display-image-p)
(let (type)
(cond ((string= folder wl-queue-folder)
(concat (propertize " " 'display
(wl-folder-trash-image . wl-trash-folder-icon)))
(defun wl-folder-init-icons ()
- (let ((load-path (cons wl-icon-dir load-path))
- (icons wl-folder-internal-icon-list)
- icon name image)
- (while (setq icon (pop icons))
- (unless (get (car icon) 'image)
- (setq name (symbol-value (cdr icon))
- image (find-image `((:type xpm :file ,name :ascent center))))
- (when image
- (put (car icon) 'image (propertize name 'display image)))))))
+ (when (wl-e21-display-image-p)
+ (let ((load-path (cons wl-icon-dir load-path))
+ (icons wl-folder-internal-icon-list)
+ icon name image)
+ (while (setq icon (pop icons))
+ (unless (get (car icon) 'image)
+ (setq name (symbol-value (cdr icon))
+ image (find-image `((:type xpm :file ,name :ascent center))))
+ (when image
+ (put (car icon) 'image (propertize name 'display image))))))))
(defun wl-plugged-init-icons ()
- (unless wl-plugged-image
- (let ((load-path (cons wl-icon-dir load-path)))
- (setq wl-plugged-image (find-image `((:type xpm
- :file ,wl-plugged-icon
- :ascent center)))
- wl-unplugged-image (find-image `((:type xpm
- :file ,wl-unplugged-icon
- :ascent center))))))
(let ((props (when (display-mouse-p)
(list 'local-map (purecopy (make-mode-line-mouse2-map
#'wl-toggle-plugged))
'help-echo "mouse-2 toggles plugged status"))))
- (if (display-graphic-p)
- (setq wl-modeline-plug-state-on
- (apply 'propertize wl-plug-state-indicator-on
- `(,@props display ,wl-plugged-image))
- wl-modeline-plug-state-off
- (apply 'propertize wl-plug-state-indicator-off
- `(,@props display ,wl-unplugged-image)))
- (setq wl-modeline-plug-state-on
- (apply 'propertize wl-plug-state-indicator-on props)
- wl-modeline-plug-state-off
- (apply 'propertize wl-plug-state-indicator-off props)))))
+ (if (wl-e21-display-image-p)
+ (progn
+ (unless wl-plugged-image
+ (let ((load-path (cons wl-icon-dir load-path)))
+ (setq wl-plugged-image (find-image
+ `((:type xpm
+ :file ,wl-plugged-icon
+ :ascent center)))
+ wl-unplugged-image (find-image
+ `((:type xpm
+ :file ,wl-unplugged-icon
+ :ascent center))))))
+ (setq wl-modeline-plug-state-on
+ (apply 'propertize wl-plug-state-indicator-on
+ `(display ,wl-plugged-image ,@props))
+ wl-modeline-plug-state-off
+ (apply 'propertize wl-plug-state-indicator-off
+ `(display ,wl-unplugged-image ,@props))))
+ (if props
+ (setq wl-modeline-plug-state-on
+ (apply 'propertize wl-plug-state-indicator-on props)
+ wl-modeline-plug-state-off
+ (apply 'propertize wl-plug-state-indicator-off props))
+ (setq wl-modeline-plug-state-on wl-plug-state-indicator-on
+ wl-modeline-plug-state-off wl-plug-state-indicator-off)))))
(defun wl-biff-init-icons ()
- (unless wl-biff-mail-image
- (let ((load-path (cons wl-icon-dir load-path)))
- (setq wl-biff-mail-image (find-image
- `((:type xpm :file ,wl-biff-mail-icon
- :ascent center)))
- wl-biff-nomail-image (find-image
- `((:type xpm :file ,wl-biff-nomail-icon
- :ascent center))))))
(let ((props (when (display-mouse-p)
(list 'local-map (purecopy (make-mode-line-mouse2-map
- (lambda nil
- (call-interactively
- 'wl-biff-check-folders))))
+ #'wl-biff-check-folders))
'help-echo "mouse-2 checks new mails"))))
- (if (display-graphic-p)
- (setq wl-modeline-biff-state-on
- (apply 'propertize wl-biff-state-indicator-on
- `(,@props display ,wl-biff-mail-image))
- wl-modeline-biff-state-off
- (apply 'propertize wl-biff-state-indicator-off
- `(,@props display ,wl-biff-nomail-image)))
- (setq wl-modeline-biff-state-on
- (apply 'propertize wl-biff-state-indicator-on props)
- wl-modeline-biff-state-off
- (apply 'propertize wl-biff-state-indicator-off props)))))
+ (if (wl-e21-display-image-p)
+ (progn
+ (unless wl-biff-mail-image
+ (let ((load-path (cons wl-icon-dir load-path)))
+ (setq wl-biff-mail-image (find-image
+ `((:type xpm
+ :file ,wl-biff-mail-icon
+ :ascent center)))
+ wl-biff-nomail-image (find-image
+ `((:type xpm
+ :file ,wl-biff-nomail-icon
+ :ascent center))))))
+ (setq wl-modeline-biff-state-on
+ (apply 'propertize wl-biff-state-indicator-on
+ `(display ,wl-biff-mail-image ,@props))
+ wl-modeline-biff-state-off
+ (apply 'propertize wl-biff-state-indicator-off
+ `(display ,wl-biff-nomail-image ,@props))))
+ (if props
+ (setq wl-modeline-biff-state-on
+ (apply 'propertize wl-biff-state-indicator-on props)
+ wl-modeline-biff-state-off
+ (apply 'propertize wl-biff-state-indicator-off props))
+ (setq wl-modeline-biff-state-on wl-biff-state-indicator-on
+ wl-modeline-biff-state-off wl-biff-state-indicator-off)))))
(defun wl-make-date-string ()
- (format-time-string "%a, %d %b %Y %T %z"))
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %d %b %Y %T %z")))
(defalias 'wl-setup-folder 'wl-e21-setup-folder-toolbar)
(defalias 'wl-setup-summary 'wl-e21-setup-summary-toolbar)
(defun wl-message-overload-functions ()
- (wl-e21-setup-message-toolbar)
(let ((keymap (current-local-map)))
- (define-key keymap "l" 'wl-message-toggle-disp-summary)
- (define-key keymap [mouse-2] 'wl-message-refer-article-or-url)
- (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))
+ (when keymap
+ (wl-e21-setup-message-toolbar keymap)
+ (define-key keymap "l" 'wl-message-toggle-disp-summary)
+ (define-key keymap [mouse-2] 'wl-message-refer-article-or-url)
+ (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))))
(defun wl-message-wheel-up (event)
(interactive "e")
(define-key keymap [menu-bar mail signature]
'("Insert Signature" . insert-signature))
(define-key keymap [menu-bar headers fcc]
- '("FCC" . wl-draft-fcc))))
+ '("Fcc" . wl-draft-fcc))))
(defun wl-draft-mode-setup ()
(require 'derived)
(defalias 'wl-defface 'defface)
+(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-e21) (require 'wl-version))
projects / elisp / wanderlust.git / blobdiff