(if (and xpm
(or (and (featurep 'xemacs)
(featurep 'xpm))
- (and (condition-case nil
- (require 'image)
- (error nil))
- (image-type-available-p 'xpm))))
+ (condition-case nil
+ (require 'image)
+ (error nil))))
(progn
(put 'wl-logo-xpm 'width (car xpm))
(put 'wl-logo-xpm 'height (nth 1 xpm))
(put 'wl-logo-xpm 'image
(if (featurep 'xemacs)
(make-glyph (vector 'xpm ':data (nth 2 xpm)))
- (create-image (nth 2 xpm) 'xpm t))))))
+ (condition-case nil
+ (let ((image-types '(xpm)))
+ (create-image (nth 2 xpm) 'xpm t))
+ (error
+ (put 'wl-logo-xpm 'width nil)
+ (put 'wl-logo-xpm 'height nil)
+ nil)))))))
(let (width height)
(let ((xbm (wl-logo-xbm)))
(put 'wl-logo-xbm 'image
(if (featurep 'xemacs)
(make-glyph (vector 'xbm ':data xbm))
- (create-image (nth 2 xbm) 'xbm t
- ':width (car xbm) ':height (nth 1 xbm)))))))
+ (condition-case nil
+ (let ((image-types '(xbm)))
+ (create-image (nth 2 xbm) 'xbm t
+ ':width (car xbm) ':height (nth 1 xbm)))
+ (error
+ (put 'wl-logo-xbm 'width nil)
+ (put 'wl-logo-xbm 'height nil)
+ nil)))))))
(if (and width
(not (featurep 'xemacs))
(condition-case nil
(or (and (featurep 'xemacs)
(device-on-window-system-p))
(and wl-on-emacs21
- (display-graphic-p))))
+ (display-graphic-p)
+ (image-type-available-p 'xbm))))
'(("xbm" . xbm)))
(if (and (get 'wl-logo-bitmap 'width)
(not (featurep 'xemacs))
selection))
(setq image-type (cdr type))
(setq image-type (cdr (car selection))))))
+ (if image-type
+ (setq image-type (intern (format "wl-logo-%s" image-type))))
(let ((demo-buf (let ((default-enable-multibyte-characters t)
(default-mc-flag t)
(default-line-spacing 0))
nil t)
(set-face-background 'fringe (face-background 'default frame)
frame))))
- (let ((logo (cond ((eq 'bitmap image-type)
- (if (and (get 'wl-logo-bitmap 'width)
- (not (featurep 'xemacs))
- (featurep 'bitmap))
- 'wl-logo-bitmap))
- ((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)
- (image-type-available-p 'xpm))))
- 'wl-logo-xpm))))
- (ww (window-width))
+ (let ((ww (window-width))
(wh (window-height))
rest)
- (if logo
- (let ((lw (get logo 'width))
- (lh (get logo 'height))
- (image (get logo 'image)))
+ (if image-type
+ (let ((lw (get image-type 'width))
+ (lh (get image-type 'height))
+ (image (get image-type 'image)))
(cond
((featurep 'xemacs)
- (if (eq 'wl-logo-xbm logo)
+ (if (eq 'wl-logo-xbm image-type)
(set-glyph-face image 'wl-highlight-logo-face))
(setq rest (- wh 1 (/ (+ (* lh wh) (window-pixel-height) -1)
(window-pixel-height))))
(set-extent-end-glyph (make-extent (point) (point)) image))
((and wl-on-emacs21
(display-graphic-p)
- (not (eq 'wl-logo-bitmap logo)))
- (if (eq 'wl-logo-xbm logo)
+ (not (eq 'wl-logo-bitmap image-type)))
+ (if (eq 'wl-logo-xbm image-type)
(let ((bg (face-background 'wl-highlight-logo-face))
(fg (face-foreground 'wl-highlight-logo-face)))
(if (stringp bg)
;; (overlay-put overlay 'wl-e21-icon t)
;; ;; 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:
;;
)
"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 (keymap)
- (and wl-use-toolbar
- (display-graphic-p)
- (wl-e21-setup-toolbar wl-message-toolbar)
- (wl-e21-make-toolbar-buttons keymap wl-message-toolbar)))
+ (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))
(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 ()
- (when (display-graphic-p)
+ (when (wl-e21-display-image-p)
(let ((load-path (cons wl-icon-dir load-path))
(icons wl-folder-internal-icon-list)
icon name image)
(put (car icon) 'image (propertize name 'display image))))))))
(defun wl-plugged-init-icons ()
- (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)
- (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))))
+ (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 (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)))
+ (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 ()
- (if (display-mouse-p)
- (let ((props (list 'local-map (purecopy (make-mode-line-mouse2-map
- (lambda nil
- (call-interactively
- 'wl-biff-check-folders))))
- 'help-echo "mouse-2 checks new mails")))
- (if (display-graphic-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))))
+ (let ((props (when (display-mouse-p)
+ (list 'local-map (purecopy (make-mode-line-mouse2-map
+ (lambda nil
+ (call-interactively
+ 'wl-biff-check-folders))))
+ 'help-echo "mouse-2 checks new mails"))))
+ (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)))
+ (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 ()
(let ((system-time-locale "C"))
projects / elisp / wanderlust.git / commitdiff