;;; wl-demo.el -- Opening demo on Wanderlust.
-;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
-;; Copyright (C) 2000 Katsumi Yamaoka <yamaoka@jpl.org>
+;; Copyright (C) 1998,1999,2000,2001 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000,2001 Katsumi Yamaoka <yamaoka@jpl.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Katsumi Yamaoka <yamaoka@jpl.org>
(defalias-maybe 'set-extent-end-glyph 'ignore)
(defalias-maybe 'set-glyph-face 'ignore)
(defalias-maybe 'set-specifier 'ignore)
- (defalias-maybe 'tool-bar-mode 'ignore)
(defalias-maybe 'window-pixel-height 'ignore)
(defalias-maybe 'window-pixel-width 'ignore))
"Demo on the startup screen.
Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'."
(interactive "P")
+ (if (and image-type (interactive-p))
+ (let* ((selection (append
+ (if (and (get 'wl-logo-xbm 'width)
+ (cond ((featurep 'xemacs)
+ (device-on-window-system-p))
+ (wl-on-emacs21
+ (display-graphic-p))
+ (t window-system)))
+ '(("xbm" . xbm)))
+ (if (and (get 'wl-logo-xpm 'width)
+ (or (and (featurep 'xemacs)
+ (featurep 'xpm)
+ (device-on-window-system-p))
+ (and wl-on-emacs21
+ (display-graphic-p)
+ (featurep 'image)
+ (image-type-available-p 'xpm))))
+ '(("xpm" . xpm)))
+ '(("ascii"))))
+ (type (completing-read "Image type: " selection nil t)))
+ (setq image-type (if (assoc type selection)
+ (cdr (assoc type selection)))))
+ (setq image-type (or image-type wl-demo-display-logo)))
(let ((demo-buf (let ((default-enable-multibyte-characters t)
(default-mc-flag t)
(default-line-spacing 0))
(get-buffer-create "*WL Demo*"))))
(switch-to-buffer demo-buf)
+ (erase-buffer)
+ (setq truncate-lines t)
(cond ((featurep 'xemacs)
(if (device-on-window-system-p)
(progn
nil demo-buf))
(set-specifier (symbol-value 'scrollbar-height) 0 demo-buf)
(set-specifier (symbol-value 'scrollbar-width) 0 demo-buf))))
- ((and (> emacs-major-version 20) (display-graphic-p))
+ ((and wl-on-emacs21 (display-graphic-p))
(make-local-hook 'kill-buffer-hook)
(let* ((frame (selected-frame))
(toolbar (frame-parameter frame 'tool-bar-lines)))
nil t)
(set-face-background 'fringe (face-background 'default frame)
frame))))
- (erase-buffer)
- (setq truncate-lines t)
- (let* ((wl-demo-display-logo
- (if (and image-type (interactive-p))
- (let* ((selection '(("xbm" . xbm) ("xpm" . xpm) ("ascii")))
- (type (completing-read "Image type: " selection nil t)))
- (if (assoc type selection)
- (cdr (assoc type selection))
- t))
- (or image-type wl-demo-display-logo)))
- (logo (if (cond ((featurep 'xemacs)
- (device-on-window-system-p))
- ((featurep 'image)
- (display-graphic-p))
- (t window-system))
- (cond ((and (eq 'xbm wl-demo-display-logo)
- (get 'wl-logo-xbm 'width))
- 'wl-logo-xbm)
- (wl-demo-display-logo
- (cond ((get 'wl-logo-xpm 'width)
- 'wl-logo-xpm)
- ((get 'wl-logo-xbm 'width)
- 'wl-logo-xbm))))))
- (ww (window-width))
- (wh (window-height))
- rest)
+ (let ((logo (cond ((eq 'xbm image-type)
+ (if (and (get 'wl-logo-xbm 'width)
+ (cond ((featurep 'xemacs)
+ (device-on-window-system-p))
+ (wl-on-emacs21
+ (display-graphic-p))
+ (t window-system)))
+ 'wl-logo-xbm))
+ ((eq 'xpm image-type)
+ (if (and (get 'wl-logo-xpm 'width)
+ (or (and (featurep 'xemacs)
+ (featurep 'xpm)
+ (device-on-window-system-p))
+ (and wl-on-emacs21
+ (display-graphic-p)
+ (featurep 'image)
+ (image-type-available-p 'xpm))))
+ 'wl-logo-xpm))))
+ (ww (window-width))
+ (wh (window-height))
+ rest)
(if logo
(let ((lw (get logo 'width))
(lh (get logo 'height))
(* lw ww))
2 (window-pixel-width))))
(set-extent-end-glyph (make-extent (point) (point)) image))
- ((featurep 'image)
+ ((and wl-on-emacs21
+ (display-graphic-p))
(if (eq 'wl-logo-xbm logo)
(let ((bg (face-background 'wl-highlight-logo-face))
(fg (face-foreground 'wl-highlight-logo-face)))
;;; wl-e21.el -- Wanderlust modules for Emacs 21.
-;; Copyright (C) 2000 Katsumi Yamaoka <yamaoka@jpl.org>
-;; Copyright (C) 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
(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 (display-graphic-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))))))
(if (display-mouse-p)
(let ((props (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
- `(display ,wl-plugged-image ,@props))
- wl-modeline-plug-state-off
- (apply 'propertize wl-plug-state-indicator-off
- `(display ,wl-unplugged-image ,@props)))
+ (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))))
(setq wl-modeline-plug-state-on
(apply 'propertize wl-plug-state-indicator-on props)
wl-modeline-plug-state-off
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))))))
(if (display-mouse-p)
(let ((props (list 'local-map (purecopy (make-mode-line-mouse2-map
(lambda nil
'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
- `(display ,wl-biff-mail-image ,@props))
- wl-modeline-biff-state-off
- (apply 'propertize wl-biff-state-indicator-off
- `(display ,wl-biff-nomail-image ,@props)))
+ (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))))
(setq wl-modeline-biff-state-on
(apply 'propertize wl-biff-state-indicator-on props)
wl-modeline-biff-state-off