- (setq truncate-lines t)
- (cond ((featurep 'xemacs)
- (if (device-on-window-system-p)
- (progn
- (if (boundp 'default-gutter-visible-p)
- (set-specifier (symbol-value 'default-gutter-visible-p)
- nil demo-buf))
- (set-specifier (symbol-value 'scrollbar-height) 0 demo-buf)
- (set-specifier (symbol-value 'scrollbar-width) 0 demo-buf))))
- ((and wl-on-emacs21 (display-graphic-p))
- (make-local-hook 'kill-buffer-hook)
- (let* ((frame (selected-frame))
- (toolbar (frame-parameter frame 'tool-bar-lines)))
- (modify-frame-parameters frame '((tool-bar-lines)))
- (add-hook
- 'kill-buffer-hook
- (` (lambda ()
- (let ((frame (, frame)))
- (when (frame-live-p frame)
- (, (if (and toolbar (> toolbar 0))
- (` (modify-frame-parameters
- frame '((tool-bar-lines . (, toolbar)))))))
- (set-face-background
- 'fringe (, (face-background 'fringe frame)) frame)))))
- nil t)
- (set-face-background 'fringe (face-background 'default frame)
- frame))))
- (let ((logo (cond ((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)
- (featurep 'image)
- (image-type-available-p 'xpm))))
- 'wl-logo-xpm))))
- (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))
- ((and wl-on-emacs21
- (display-graphic-p))
- (if (eq 'wl-logo-xbm logo)
- (let ((bg (face-background 'wl-highlight-logo-face))
- (fg (face-foreground 'wl-highlight-logo-face)))
- (if (stringp bg)
- (plist-put (cdr image) ':background bg))
- (if (stringp fg)
- (plist-put (cdr image) ':foreground fg))))
- (setq rest (/ (- (* wh (frame-char-height)) lh 1)
- (frame-char-height)))
- (insert (propertize " " 'display
- (list 'space ':align-to
- (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 (product-name (product-find 'wl-version))))
- (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))
- (text (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"))
- (product-version-string (product-find 'wl-version))
- (product-code-name (product-find 'wl-version))
- wl-demo-copyright-notice)))
- (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)
- (if (stringp bg)
- (list ':background bg))
- (if (stringp fg)
- (list ':foreground fg))))))
- (insert text)
- (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)))