"Demo on the startup screen.
Optional IMAGE-TYPE overrides the variable `wl-demo-display-logo'."
(interactive "P")
- (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)))
- (demo-buf (let ((default-enable-multibyte-characters t)
- (default-mc-flag t)
- (default-line-spacing 0))
- (get-buffer-create "*WL Demo*")))
- (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 ((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)
(cond ((and (featurep 'xemacs) (device-on-window-system-p))
(if (boundp 'default-gutter-visible-p)
(set-face-background 'fringe bg frame))))))
(erase-buffer)
(setq truncate-lines t)
- (if logo
- (let ((lw (get logo 'width))
- (lh (get logo 'height))
- (image (get logo 'image)))
- (cond
- ((featurep 'xemacs)
- (if (eq 'wl-logo-xbm logo)
- (set-glyph-face image 'wl-highlight-logo-face))
- (setq rest (- wh 1 (/ (+ (* lh wh) (window-pixel-height) -1)
- (window-pixel-height))))
- (insert-char ?\ (max 0 (/ (- (* (window-pixel-width) (1+ ww))
- (* lw ww))
- 2 (window-pixel-width))))
- (set-extent-end-glyph (make-extent (point) (point)) image))
- ((featurep 'image)
- (if (eq 'wl-logo-xbm logo)
- (let* ((unspecified nil)
- (bg (eval (face-background 'wl-highlight-logo-face)))
- (fg (eval (face-foreground 'wl-highlight-logo-face))))
- (if bg (plist-put (cdr image) ':background bg))
- (if fg (plist-put (cdr image) ':foreground fg))))
- (setq rest (/ (- (* wh (frame-char-height)) lh 1)
- (frame-char-height)))
- (insert-char ?\ (max 0 (/ (- (* (frame-char-width) (1+ ww)) lw)
- 2 (frame-char-width))))
- (insert-image image))
- (t
- (insert image)
- (put-text-property (point-min) (point) 'face
- 'wl-highlight-logo-face)
- (setq rest (/ (- (* 16 wh) lh 8) 16))
- (indent-rigidly (point-min) (point-max)
- (/ (- (* 8 (1+ ww)) lw) 16))))
- (goto-char (point-min)))
- (insert (or wl-logo-ascii wl-appname))
- (put-text-property (point-min) (point) 'face 'wl-highlight-logo-face)
- (setq rest (- wh (count-lines (point-min) (point)) 1))
- (let ((lw (current-column))
- (lh (count-lines (point-min) (point))))
- (while (progn (beginning-of-line) (not (bobp)))
- (backward-char)
- (setq lw (max lw (current-column))))
- (indent-rigidly (point) (point-max) (max 0 (/ (- ww lw) 2)))))
- (insert-char ?\n (max 0 (/ (- rest 4) 2)))
- (goto-char (point-max))
- (insert "\n")
- (let ((start (point)))
- (insert (format (cond ((<= rest 2)
- "version %s - \"%s\"\n%s")
- ((eq rest 3)
- "version %s - \"%s\"\n\n%s")
- (t
- "\nversion %s - \"%s\"\n\n%s"))
- wl-version wl-codename wl-demo-copyright-notice))
- (put-text-property start (point) 'face 'wl-highlight-demo-face)
- (let ((fill-column ww))
- (center-region start (point))))
- (goto-char (point-min))
- (sit-for (if (featurep 'lisp-float-type) (/ (float 5) (float 10)) 1))
- demo-buf))
+ (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)
+ (if logo
+ (let ((lw (get logo 'width))
+ (lh (get logo 'height))
+ (image (get logo 'image)))
+ (cond
+ ((featurep 'xemacs)
+ (if (eq 'wl-logo-xbm logo)
+ (set-glyph-face image 'wl-highlight-logo-face))
+ (setq rest (- wh 1 (/ (+ (* lh wh) (window-pixel-height) -1)
+ (window-pixel-height))))
+ (insert-char ?\ (max 0 (/ (- (* (window-pixel-width) (1+ ww))
+ (* lw ww))
+ 2 (window-pixel-width))))
+ (set-extent-end-glyph (make-extent (point) (point)) image))
+ ((featurep 'image)
+ (if (eq 'wl-logo-xbm logo)
+ (let* ((unspecified nil)
+ (bg (eval (face-background 'wl-highlight-logo-face)))
+ (fg (eval (face-foreground 'wl-highlight-logo-face))))
+ (if bg (plist-put (cdr image) ':background bg))
+ (if fg (plist-put (cdr image) ':foreground fg))))
+ (setq rest (/ (- (* wh (frame-char-height)) lh 1)
+ (frame-char-height)))
+ (insert-char ?\ (max 0 (/ (- (* (frame-char-width) (1+ ww)) lw)
+ 2 (frame-char-width))))
+ (insert-image image))
+ (t
+ (insert image)
+ (put-text-property (point-min) (point) 'face
+ 'wl-highlight-logo-face)
+ (setq rest (/ (- (* 16 wh) lh 8) 16))
+ (indent-rigidly (point-min) (point-max)
+ (/ (- (* 8 (1+ ww)) lw) 16))))
+ (goto-char (point-min)))
+ (insert (or wl-logo-ascii wl-appname))
+ (put-text-property (point-min) (point) 'face 'wl-highlight-logo-face)
+ (setq rest (- wh (count-lines (point-min) (point)) 1))
+ (let ((lw (current-column))
+ (lh (count-lines (point-min) (point))))
+ (while (progn (beginning-of-line) (not (bobp)))
+ (backward-char)
+ (setq lw (max lw (current-column))))
+ (indent-rigidly (point) (point-max) (max 0 (/ (- ww lw) 2)))))
+ (insert-char ?\n (max 0 (/ (- rest 4) 2)))
+ (goto-char (point-max))
+ (insert "\n")
+ (let ((start (point)))
+ (insert (format (cond ((<= rest 2)
+ "version %s - \"%s\"\n%s")
+ ((eq rest 3)
+ "version %s - \"%s\"\n\n%s")
+ (t
+ "\nversion %s - \"%s\"\n\n%s"))
+ wl-version wl-codename wl-demo-copyright-notice))
+ (put-text-property start (point) 'face 'wl-highlight-demo-face)
+ (let ((fill-column ww))
+ (center-region start (point))))
+ (goto-char (point-min))
+ (sit-for (if (featurep 'lisp-float-type) (/ (float 5) (float 10)) 1))
+ demo-buf)))
;;; wl-demo.el ends here