X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-demo.el;h=9e852637a4cd2c2b2abdc85ae382d561b3b13958;hb=52061841b6997afec3a3108019c9362c35e4864b;hp=d1c0a47d8a85c342c5c41ff209de0eca744b6fdc;hpb=b9521e198d3bedd260d45af2b00ad9177a097e2e;p=elisp%2Fwanderlust.git diff --git a/wl/wl-demo.el b/wl/wl-demo.el index d1c0a47..9e85263 100644 --- a/wl/wl-demo.el +++ b/wl/wl-demo.el @@ -29,7 +29,7 @@ ;;; Code: (defconst wl-demo-copyright-notice - "Copyright (C) 1998-2001 Yuuichi Teranishi " + "Copyright (C) 1998-2003 Yuuichi Teranishi " "A declaration of the copyright on Wanderlust.") (eval-when-compile @@ -41,7 +41,7 @@ (defconst wl-demo-icon-name (concat "wl-" (wl-version-status) - (if (string-match "^... Dec \\([ 1][0-9]\\|2[0-4]\\)" + (if (string-match "^... Dec \\([ 01][0-9]\\|2[0-5]\\)" (current-time-string)) "-xmas-logo" "-logo")) @@ -98,31 +98,35 @@ Yet Another Message Interface On Emacsen" (if (or (and (featurep 'xemacs) (device-on-window-system-p)) window-system) - (append - (when (or (and (featurep 'xemacs) - (featurep 'xpm)) - (and wl-on-emacs21 - (display-images-p) - (image-type-available-p 'xpm))) - '(("xpm" . xpm))) - (when (and (not (or (featurep 'xemacs) - ;; *.img files won't fit for Emacs 21. - wl-on-emacs21)) - (or (eq t wl-demo-bitmap-mule-available-p) - (and (eq 'unknown wl-demo-bitmap-mule-available-p) - (module-installed-p 'bitmap) - (setq wl-demo-bitmap-mule-available-p t)))) - '(("bitmap" . bitmap))) - (when (or (featurep 'xemacs) - (and wl-on-emacs21 - (display-images-p) - (image-type-available-p 'xbm)) - (eq t wl-demo-bitmap-mule-available-p) - (and (eq 'unknown wl-demo-bitmap-mule-available-p) - (module-installed-p 'bitmap) - (setq wl-demo-bitmap-mule-available-p t))) - '(("xbm" . xbm))) - '(("ascii"))) + (let ((xpm + (when (or (and (featurep 'xemacs) + (featurep 'xpm)) + (and wl-on-emacs21 + (display-images-p) + (image-type-available-p 'xpm))) + '("xpm" . xpm))) + (xbm + (when (or (featurep 'xemacs) + (and wl-on-emacs21 + (display-images-p) + (image-type-available-p 'xbm)) + (eq t wl-demo-bitmap-mule-available-p) + (and (eq 'unknown wl-demo-bitmap-mule-available-p) + (module-installed-p 'bitmap) + (setq wl-demo-bitmap-mule-available-p t))) + '("xbm" . xbm))) + (bitmap + (when (and (not (featurep 'xemacs)) + (or (eq t wl-demo-bitmap-mule-available-p) + (and (eq 'unknown wl-demo-bitmap-mule-available-p) + (module-installed-p 'bitmap) + (setq wl-demo-bitmap-mule-available-p t)))) + '("bitmap" . bitmap)))) + (if (and wl-on-emacs21 + (image-type-available-p 'xbm)) + ;; Prefer xbm rather than bitmap on Emacs 21. + (delq nil (list xpm xbm bitmap '("ascii"))) + (delq nil (list xpm bitmap xbm '("ascii"))))) '(("ascii")))) (defun wl-demo-insert-image (image-type) @@ -140,13 +144,14 @@ Return a number of lines that an image occupies in the buffer." (when (boundp 'default-gutter-visible-p) (set-specifier (symbol-value 'default-gutter-visible-p) nil (current-buffer))) - (set-specifier (symbol-value 'scrollbar-height) 0 (current-buffer)) - (set-specifier (symbol-value 'scrollbar-width) 0 (current-buffer))) + (when (featurep 'scrollbar) + (set-specifier (symbol-value 'scrollbar-height) 0 (current-buffer)) + (set-specifier (symbol-value 'scrollbar-width) 0 (current-buffer)))) (if (and file - (if (and wl-icon-dir - (file-directory-p wl-icon-dir)) - (setq file (expand-file-name file wl-icon-dir)) - (message "You have to specify the value of `wl-icon-dir'") + (if (and wl-icon-directory + (file-directory-p wl-icon-directory)) + (setq file (expand-file-name file wl-icon-directory)) + (message "You have to specify the value of `wl-icon-directory'") nil) (if (file-exists-p file) (if (file-readable-p file) @@ -169,27 +174,18 @@ Return a number of lines that an image occupies in the buffer." (insert "\n") (/ (+ (* 2 (glyph-height image) (window-height)) height) (* 2 height))) - ((eq 'bitmap image-type) - (require 'bitmap) - (let ((coding-system-for-read 'iso-2022-7bit) - (input-coding-system '*iso-2022-jp*)) - (insert-file-contents file)) - (end-of-line) - (indent-rigidly (point-min) (point-max) - (max 0 (/ (1+ (- (window-width) - (current-column))) - 2))) - (put-text-property (point-min) (point-max) - 'face 'wl-highlight-logo-face) - (count-lines (point-min) (goto-char (point-max)))) - ((>= emacs-major-version 21) + ((and wl-on-emacs21 + (or (eq 'xpm image-type) + (and (eq 'xbm image-type) + (image-type-available-p 'xbm)))) + ;; Use the new redisplay engine on Emacs 21. (setq image (create-image file image-type) width (image-size image) height (cdr width) width (car width)) (when (eq 'xbm image-type) - (let ((bg (face-background 'wl-highlight-demo-face)) - (fg (face-foreground 'wl-highlight-demo-face))) + (let ((bg (face-background 'wl-highlight-logo-face)) + (fg (face-foreground 'wl-highlight-logo-face))) (when (stringp bg) (plist-put (cdr image) ':background bg)) (when (stringp fg) @@ -202,6 +198,44 @@ Return a number of lines that an image occupies in the buffer." (insert-image image) (insert "\n") (round height)) + ((eq 'bitmap image-type) + ;; Use ready-composed bitmap image. + (require 'bitmap) + (let ((coding-system-for-read 'iso-2022-7bit) + (input-coding-system '*iso-2022-jp*)) + (insert-file-contents file)) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (setq width 0) + (while (progn + (end-of-line 0) + (not (bobp))) + (setq width (max width (current-column)))) + ;; Emacs 21.1 would fail to decode composite chars + ;; if it has been built without fixing coding.c. + (when (and wl-on-emacs21 + (>= width 80)) + (erase-buffer) + (let ((coding-system-for-read 'raw-text)) + (insert-file-contents file)) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (setq width 0) + (while (progn + (end-of-line 0) + (not (bobp))) + ;; Decode bitmap data line by line. + (decode-coding-region (line-beginning-position) + (point) + 'iso-2022-7bit) + (setq width (max width (current-column))))) + (indent-rigidly (point-min) (point-max) + (max 0 (/ (1+ (- (window-width) width)) 2))) + (put-text-property (point-min) (point-max) + 'face 'wl-highlight-logo-face) + (count-lines (point-min) (goto-char (point-max)))) ((eq 'xbm image-type) (message "Composing a bitmap image...") (require 'bitmap) @@ -282,6 +316,7 @@ argument." (get-buffer-create "*WL Demo*")))) (switch-to-buffer buffer) (setq buffer-read-only nil) + (buffer-disable-undo) (erase-buffer) (setq truncate-lines t tab-width 8)