* wl-demo.el (wl-demo-insert-image): Use :file instead of :data to
authoryamaoka <yamaoka>
Wed, 1 Dec 2004 02:39:30 +0000 (02:39 +0000)
committeryamaoka <yamaoka>
Wed, 1 Dec 2004 02:39:30 +0000 (02:39 +0000)
 make an xbm image on XEmacs; use wl-highlight-demo-face instead of
 wl-highlight-logo-face to set the bg color of an xbm image; fixed
 the way to measure the width of a bitmap image; don't put face on
 ascii and bitmap images; put the mark which should not use the
 variable-pitch face on ascii and bitmap images.
(wl-demo-setup-properties): Don't use the variable-pitch face on
 ascii and bitmap images; made it work on Emacs 20 and earlier.
(wl-demo-insert-text): End with a newline at the bottom; don't put
 face on text.

* wl-highlight.el (wl-highlight-logo-face): Specified bg colors.

wl/ChangeLog
wl/wl-demo.el
wl/wl-highlight.el

index e6e9711..1f14b03 100644 (file)
@@ -1,3 +1,18 @@
+2004-12-01  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+       * wl-demo.el (wl-demo-insert-image): Use :file instead of :data to
+       make an xbm image on XEmacs; use wl-highlight-demo-face instead of
+       wl-highlight-logo-face to set the bg color of an xbm image; fixed
+       the way to measure the width of a bitmap image; don't put face on
+       ascii and bitmap images; put the mark which should not use the
+       variable-pitch face on ascii and bitmap images.
+       (wl-demo-setup-properties): Don't use the variable-pitch face on
+       ascii and bitmap images; made it work on Emacs 20 and earlier.
+       (wl-demo-insert-text): End with a newline at the bottom; don't put
+       face on text.
+
+       * wl-highlight.el (wl-highlight-logo-face): Specified bg colors.
+
 2004-11-26  Yoichi NAKAYAMA  <yoichi@geiin.org>
 
        * wl-util.el (toplevel): Don't check existence of `timer-activate'.
index a7a2056..983b876 100644 (file)
@@ -1,7 +1,9 @@
 ;;; wl-demo.el --- Opening demo on Wanderlust
 
-;; Copyright (C) 1998,1999,2000,2001 Yuuichi Teranishi <teranisi@gohome.org>
-;; Copyright (C) 2000,2001 Katsumi Yamaoka <yamaoka@jpl.org>
+;; Copyright (C) 1998,1999,2000,2001,2002,2003,2004
+;;      Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 2000,2001,2004
+;;      Katsumi Yamaoka <yamaoka@jpl.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;;     Katsumi Yamaoka <yamaoka@jpl.org>
@@ -180,9 +182,12 @@ Return a number of lines that an image occupies in the buffer."
          (cond ((featurep 'xemacs)
                 (setq width (window-pixel-width)
                       height (window-pixel-height)
-                      image (make-glyph (vector image-type ':data
-                                                (wl-demo-image-filter
-                                                 file image-type))))
+                      image (make-glyph
+                             (if (eq image-type 'xbm)
+                                 (vector image-type ':file file)
+                               (vector image-type ':data
+                                       (wl-demo-image-filter
+                                        file image-type)))))
                 (when (eq 'xbm image-type)
                   (set-glyph-face image 'wl-highlight-logo-face))
                 (insert-char ?\  (max 0 (/ (+ (* (- width (glyph-width image))
@@ -204,7 +209,7 @@ Return a number of lines that an image occupies in the buffer."
                       height (cdr width)
                       width (car width))
                 (when (eq 'xbm image-type)
-                  (let ((bg (face-background 'wl-highlight-logo-face))
+                  (let ((bg (face-background 'wl-highlight-demo-face))
                         (fg (face-foreground 'wl-highlight-logo-face)))
                     (when (stringp bg)
                       (plist-put (cdr image) ':background bg))
@@ -227,11 +232,20 @@ Return a number of lines that an image occupies in the buffer."
                 (goto-char (point-max))
                 (unless (bolp)
                   (insert "\n"))
-                (setq width 0)
+
+                ;; Emacs 21.x may fail on computing the end of the
+                ;; column if there're bitmap characters.
+                ;;(setq width 0)
+                ;;(while (progn
+                ;;         (end-of-line 0)
+                ;;         (not (bobp)))
+                ;;  (setq width (max width (current-column))))
+                (setq width 1024)
                 (while (progn
                          (end-of-line 0)
                          (not (bobp)))
-                  (setq width (max width (current-column))))
+                  (setq width (min 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
@@ -253,8 +267,7 @@ Return a number of lines that an image occupies in the buffer."
                     (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)
+                (put-text-property (point-min) (point-max) 'fixed-width t)
                 (count-lines (point-min) (goto-char (point-max))))
                ((eq 'xbm image-type)
                 (message "Composing a bitmap image...")
@@ -265,12 +278,10 @@ Return a number of lines that an image occupies in the buffer."
                                 (max 0 (/ (1+ (- (window-width)
                                                  (current-column)))
                                           2)))
-                (put-text-property (point-min) (point-max)
-                                   'face 'wl-highlight-logo-face)
+                (put-text-property (point-min) (point-max) 'fixed-width t)
                 (message "Composing a bitmap image...done")
                 (count-lines (point-min) (goto-char (point-max))))))
       (insert wl-logo-ascii)
-      (put-text-property (point-min) (point) 'face 'wl-highlight-logo-face)
       (unless (bolp)
        (insert "\n"))
       (setq width 0)
@@ -280,6 +291,7 @@ Return a number of lines that an image occupies in the buffer."
        (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) 'fixed-width t)
       (count-lines (point-min) (goto-char (point-max))))))
 
 (defun wl-demo-setup-properties ()
@@ -292,31 +304,60 @@ Return a number of lines that an image occupies in the buffer."
     (dotimes (i (- (window-height)
                   (count-lines (point-min) (point))))
       (insert ?\n))
-    (let ((fg (face-foreground 'wl-highlight-demo-face))
-         (bg (face-background 'wl-highlight-demo-face)))
-      (put-text-property (point-min) (point-max)
-                        'face
-                        (nconc '(variable-pitch :slant oblique)
-                               (when (stringp bg)
-                                 (list ':background bg))
-                               (when (stringp fg)
-                                 (list ':foreground fg))))))
+    (let* ((fg (face-foreground 'wl-highlight-demo-face))
+          (bg (face-background 'wl-highlight-demo-face))
+          (oblique (nconc '(variable-pitch :slant oblique)
+                          (when (stringp bg)
+                            (list ':background bg))
+                          (when (stringp fg)
+                            (list ':foreground fg))))
+          (start (text-property-any (point-min) (point-max) 'fixed-width t))
+          end)
+      (if start
+         (progn
+           (put-text-property (point-min) start 'face oblique)
+           (setq end (or (text-property-not-all start (point-max)
+                                                'fixed-width t)
+                         (point-max)))
+           (put-text-property start end 'face
+                              (nconc '(wl-highlight-logo-face)
+                                     (when (stringp bg)
+                                       (list ':background bg))))
+           (put-text-property end (point-max) 'face oblique))
+       (put-text-property (point-min) (point-max) 'face oblique))))
    ((and (featurep 'xemacs)
         (face-background-name 'wl-highlight-demo-face))
     (set-face-background 'default
                         (face-background-name 'wl-highlight-demo-face)
-                        (current-buffer)))))
+                        (current-buffer)))
+   (t
+    (goto-char (point-max))
+    (dotimes (i (- (window-height)
+                  (count-lines (point-min) (point))))
+      (insert ?\n))
+    (let ((start (text-property-any (point-min) (point-max) 'fixed-width t))
+         end)
+      (if start
+         (progn
+           (put-text-property (point-min) start 'face 'wl-highlight-demo-face)
+           (setq end (or (text-property-not-all start (point-max)
+                                                'fixed-width t)
+                         (point-max)))
+           (put-text-property start end 'face 'wl-highlight-logo-face)
+           (put-text-property end (point-max) 'face 'wl-highlight-demo-face))
+       (put-text-property (point-min) (point-max)
+                          'face 'wl-highlight-demo-face))))))
 
 (defun wl-demo-insert-text (height)
   "Insert a version and the copyright message after a logo image.  HEIGHT
 should be a number of lines that an image occupies in the buffer."
   (let* ((height (- (window-height) height 1))
         (text (format (cond ((<= height 2)
-                             "version %s - \"%s\"\n%s")
+                             "version %s - \"%s\"\n%s\n")
                             ((eq height 3)
-                             "version %s - \"%s\"\n\n%s")
+                             "version %s - \"%s\"\n\n%s\n")
                             (t
-                             "\nversion %s - \"%s\"\n\n%s"))
+                             "\nversion %s - \"%s\"\n\n%s\n"))
                       (product-version-string (product-find 'wl-version))
                       (product-code-name (product-find 'wl-version))
                       wl-demo-copyright-notice))
@@ -325,7 +366,6 @@ should be a number of lines that an image occupies in the buffer."
     (insert-char ?\n (max 0 (/ (- height 4) 2)))
     (setq start (goto-char (point-max)))
     (insert text)
-    (put-text-property start (point) 'face 'wl-highlight-demo-face)
     (let ((fill-column (window-width)))
       (center-region start (point)))))
 
index 7a58149..fc3a4a9 100644 (file)
@@ -1,6 +1,6 @@
 ;;; wl-highlight.el --- Hilight modules for Wanderlust.
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
 ;;  Yuuichi Teranishi <teranisi@gohome.org>
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
       (background dark))
      (:foreground "cyan"))
     (((class color)
-      (background dark))
-     (:foreground "SkyBlue"))
-    (((class color)
       (background light))
-     (:foreground "SteelBlue")))
+     (:foreground "SteelBlue" :background "#d9ffd9"))
+    (((class color)
+      (background dark))
+     (:foreground "SkyBlue" :background "#004400")))
   "Face used for displaying demo."
   :group 'wl-faces)