- (condition-case nil
- (bitmap-decode-xbm (bitmap-read-xbm-file file))
- (error (message "Bitmap Logo is not used.")))))))
- (t
- (defmacro wl-title-logo ()))))
-
-(defconst wl-title-logo
- (cond ((or (and (featurep 'xemacs)
- (featurep 'xpm)
- (device-on-window-system-p))
- (and (eval-when-compile (featurep 'image))
- (image-type-available-p 'xpm)))
- (wl-title-logo))
- ((and window-system
- (condition-case nil
- (require 'bitmap)
- (error nil)))
- (let ((cmp (wl-title-logo)))
- (if cmp
- (condition-case nil
- (let ((len (length cmp))
- (bitmap (bitmap-compose (aref cmp 0)))
- (i 1))
- (while (< i len)
- (setq bitmap (concat bitmap "\n"
- (bitmap-compose (aref cmp i)))
- i (1+ i)))
- bitmap)
- (error nil)))))))
-
-(defun wl-demo ()
- (interactive)
- (let ((demo-buf (get-buffer-create "*WL Demo*"))
- logo-ext start)
- (switch-to-buffer demo-buf)
- (erase-buffer)
- (if (and wl-demo-display-logo wl-title-logo)
- (cond
- ((featurep 'xemacs)
- (let ((wl-logo (make-glyph (vector 'xpm :data wl-title-logo))))
- (insert-char ?\n (max 1 (/ (- (window-height) 6
- (/ (glyph-height wl-logo)
- (/ (window-pixel-height)
- (window-height)))) 2)))
- (indent-to (startup-center-spaces wl-logo))
- (insert-char ?\ (max 0 (/ (- (window-width)
- (/ (glyph-width wl-logo)
- (/ (window-pixel-width)
- (window-width)))) 2)))
- (setq logo-ext (make-extent (point)(point)))
- (set-extent-end-glyph logo-ext wl-logo)))
- ((featurep 'image)
- (let ((wl-logo (list 'image :type 'xpm :data wl-title-logo))
- pixel-width pixel-height)
- (with-temp-buffer
- (insert wl-title-logo)
- (goto-char (point-min))
- (skip-syntax-forward "^\"")
- (when (looking-at "\"[ \t]*\\([0-9]+\\)[ \t]*\\([0-9]+\\)")
- (setq pixel-width (string-to-int (match-string 1))
- pixel-height (string-to-int (match-string 2)))))
- (insert-char ?\n (max 1 (/ (- (window-height) 6
- (/ pixel-height
- (frame-char-height))) 2)))
- (insert-char ?\ (max 0 (/ (- (window-width)
- (/ pixel-width
- (frame-char-width))) 2)))
- (wl-insert-image wl-logo)
- (insert "\n")))
- (t
- (insert wl-title-logo)
- (indent-rigidly (point-min) (point-max)
- (max 0 (/ (- (window-width) (current-column)) 2)))
- (insert "\n")
- (goto-char (point-min))
- (insert-char ?\n (max 0 (/ (- (window-height)
- (count-lines (point) (point-max))
- 6) 2)))
- (goto-char (point-max))))
- (insert-char ?\n (max 1 (- (/ (window-height) 3) 2))))
- (setq start (point))
- (insert "\n" (if (and wl-demo-display-logo wl-title-logo)
- ""
- (concat wl-appname "\n")))
- (let ((fill-column (window-width)))
- (center-region start (point)))
- (setq start (point))
- (put-text-property (point-min) (point) 'face 'wl-highlight-logo-face)
- (insert (format "\nversion %s - \"%s\"\n\n"
- wl-version wl-codename
- ))
- (insert "Copyright (C) 1998-2000 Yuuichi Teranishi <teranisi@gohome.org>")
- (put-text-property start (point-max) 'face 'wl-highlight-demo-face)
+ (if (file-readable-p file)
+ t
+ (message "Permission denied: %s" file)
+ nil)
+ (message "File not found: %s" file)
+ nil))
+ (progn
+ (cond ((featurep 'xemacs)
+ (setq width (window-pixel-width)
+ height (window-pixel-height)
+ image (make-glyph (vector image-type ':file file)))
+ (when (eq 'xbm image-type)
+ (set-glyph-face image 'wl-highlight-logo-face))
+ (insert-char ?\ (max 0 (/ (+ (* (- width (glyph-width image))
+ (window-width)) width)
+ (* 2 width))))
+ (set-extent-end-glyph (make-extent (point) (point)) image)
+ (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)
+ (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)))
+ (when (stringp bg)
+ (plist-put (cdr image) ':background bg))
+ (when (stringp fg)
+ (plist-put (cdr image) ':foreground fg))))
+ (insert (propertize " " 'display
+ (list 'space ':align-to
+ (max 0 (round (- (window-width)
+ width)
+ 2)))))
+ (insert-image image)
+ (insert "\n")
+ (round height))
+ ((eq 'xbm image-type)
+ (message "Composing a bitmap image...")
+ (require 'bitmap)
+ (bitmap-insert-xbm-file file)
+ (backward-char)
+ (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)
+ (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)
+ (while (progn
+ (end-of-line 0)
+ (not (bobp)))
+ (setq width (max width (current-column))))
+ (indent-rigidly (point-min) (point-max)
+ (max 0 (/ (1+ (- (window-width) width)) 2)))
+ (count-lines (point-min) (goto-char (point-max))))))
+
+(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")
+ ((eq height 3)
+ "version %s - \"%s\"\n\n%s")
+ (t
+ "\nversion %s - \"%s\"\n\n%s"))
+ (product-version-string (product-find 'wl-version))
+ (product-code-name (product-find 'wl-version))
+ wl-demo-copyright-notice))
+ start)
+ (goto-char (point-min))
+ (insert-char ?\n (max 0 (/ (- height 4) 2)))
+ (setq start (goto-char (point-max)))
+ (if wl-on-emacs21
+ (let ((bg (face-background 'wl-highlight-demo-face))
+ (fg (face-foreground 'wl-highlight-demo-face)))
+ (insert (propertize text
+ 'face (nconc '(variable-pitch :slant oblique)
+ (when (stringp bg)
+ (list ':background bg))
+ (when (stringp fg)
+ (list ':foreground fg))))))
+ (insert text)
+ (put-text-property start (point) 'face 'wl-highlight-demo-face))