cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/mew-demo.el

   1 ;;; mew-demo.el --- Startup demo for Mew
   2
   3 ;; Author:  Kazu Yamamoto <Kazu@Mew.org>
   4 ;; Created: Oct  2, 1996
   5 ;; Revised: Aug 30, 1999
   6
   7 ;;; Code:
   8
   9 (defconst mew-demo-version "mew-demo.el version 0.12")
  10
  11 (require 'mew-vars)
  12
  13 (defconst mew-hello-message
  14 "
  15
  16 Welcome to Mew world.
  17
  18 Mew -- Messaging in the Emacs World
  19
  20 %s
  21
  22 Copyright (C) 1994-1999 Kazu Yamamoto
  23
  24 Please send comments to Kazu@Mew.org.
  25
  26 "
  27 )
  28
  29 (defconst mew-demo-string
  30 '(
  31  "/\\\\ - \\\\/"
  32
  33  "-\\\\ - \\\\/" "\\\\\\ - \\\\/" "|\\\\ - \\\\/" "/\\\\ - \\\\/"
  34  "-\\\\ - \\\\/" "\\\\\\ - \\\\/" "|\\\\ - \\\\/" "/\\\\ - \\\\/"
  35
  36  "/|\\ - \\\\/"  "//\\ - \\\\/" "/-\\ - \\\\/" "/\\\\ - \\\\/"
  37  "/|\\ - \\\\/"  "//\\ - \\\\/"  "/-\\ - \\\\/" "/\\\\ - \\\\/"
  38
  39  "/\\| - \\\\/" "/\\/ - \\\\/" "/\\- - \\\\/" "/\\\\ - \\\\/"
  40  "/\\| - \\\\/" "/\\/ - \\\\/" "/\\- - \\\\/" "/\\\\ - \\\\/"
  41
  42  "/\\\\ - |\\/" "/\\\\ - /\\/" "/\\\\ - -\\/" "/\\\\ - \\\\/"
  43  "/\\\\ - |\\/" "/\\\\ - /\\/" "/\\\\ - -\\/" "/\\\\ - \\\\/"
  44
  45  "/\\\\ - \\|/" "/\\\\ - \\//" "/\\\\ - \\-/" "/\\\\ - \\\\/"
  46  "/\\\\ - \\|/" "/\\\\ - \\//" "/\\\\ - \\-/" "/\\\\ - \\\\/"
  47
  48  "/\\\\ - \\\\-" "/\\\\ - \\\\\\" "/\\\\ - \\\\|" "/\\\\ - \\\\/"
  49  "/\\\\ - \\\\-" "/\\\\ - \\\\\\" "/\\\\ - \\\\|" "/\\\\ - \\\\/"
  50  )
  51 )
  52
  53 (defun mew-hello ()
  54   (mew-window-configure (get-buffer-create mew-buffer-hello) '(1 0))
  55   (let (left-margin fill-column ext)
  56     (mew-erase-buffer)
  57     (setq left-margin 0)
  58     (setq fill-column (window-width))
  59     (insert (format mew-hello-message mew-version))
  60     (center-region (point-min) (point-max))
  61     (cond
  62      ((and mew-xemacs-p window-system)
  63       (goto-char (point-min))
  64       (setq ext (mew-overlay-make (point-min) (point-max)))
  65 ;;      (set-extent-face ext 'bold-italic) ;; not work for 14 dot...
  66       (set-extent-face ext 'bold)
  67       (goto-char (point-max))
  68       (cond
  69        ((and mew-demo-picture
  70              (valid-image-instantiator-format-p 'png))
  71         (mew-flet
  72          (setq mew-logo
  73                (make-glyph (vector 'png ':file
  74                                    (expand-file-name mew-icon-mew
  75                                                      mew-icon-directory)))))
  76         (indent-to (startup-center-spaces mew-logo))
  77         (set-extent-begin-glyph (mew-overlay-make (point) (point)) mew-logo)
  78         (goto-char (point-min))))
  79       (sit-for 0)) ;; to redraw
  80      ((and (featurep 'bitmap) mew-demo-picture)
  81       (or
  82        (condition-case nil
  83            (insert-file-contents
  84             (expand-file-name mew-icon-mew-mule-bitmap-image
  85                               mew-icon-directory))
  86          (file-error nil))
  87        (condition-case nil
  88            (progn
  89              (save-excursion
  90                (mew-set-buffer-tmp)
  91                (insert-file-contents
  92                 (expand-file-name mew-icon-mew-mono mew-icon-directory)))
  93              (bitmap-insert-xbm-buffer mew-buffer-tmp))
  94          (file-error nil)))
  95       (center-region (point-min) (point-max))
  96       (sit-for 0)) ;; to redraw
  97      (t
  98       (insert "/\\\\ - \\\\/")
  99       (center-line)
 100       (end-of-line)
 101       (insert (make-string (1- (- (window-width) (current-column))) ?\ ))
 102       (end-of-line)
 103       (sit-for 0) ;; to redraw
 104       (if (and mew-demo window-system) (mew-demo)))
 105      )))
 106
 107 (defun mew-demo (&optional string)
 108   (let* ((list (or string mew-demo-string))
 109          (wl (window-width))
 110          (ul (length (regexp-quote "/\\ - \\/")))
 111          (pl (/ (- wl ul) 2))
 112          (pre (make-string pl 32))
 113          (suf (make-string (1- (- (- wl pl) ul)) 32)))
 114     (save-window-excursion
 115       (select-window (get-buffer-window (get-buffer mew-buffer-hello)))
 116       (while list
 117         (mew-demo-print (car list) pre suf)
 118         (mew-demo-loop)
 119         (setq list (cdr list)))
 120       )))
 121
 122 (defun mew-demo-print (string prefix suffix)
 123   (goto-char (point-max))
 124   (let ((end (point)))
 125     (beginning-of-line)
 126     (delete-region (point) end))
 127   (insert (concat prefix string suffix)))
 128
 129 (defun mew-demo-loop ()
 130   (sit-for 0.02))
 131
 132 (provide 'mew-demo)
 133
 134 ;;; Copyright Notice:
 135
 136 ;; Copyright (C) 1996, 1997, 1998, 1999 Mew developing team.
 137 ;; All rights reserved.
 138
 139 ;; Redistribution and use in source and binary forms, with or without
 140 ;; modification, are permitted provided that the following conditions
 141 ;; are met:
 142 ;;
 143 ;; 1. Redistributions of source code must retain the above copyright
 144 ;;    notice, this list of conditions and the following disclaimer.
 145 ;; 2. Redistributions in binary form must reproduce the above copyright
 146 ;;    notice, this list of conditions and the following disclaimer in the
 147 ;;    documentation and/or other materials provided with the distribution.
 148 ;; 3. Neither the name of the team nor the names of its contributors
 149 ;;    may be used to endorse or promote products derived from this software
 150 ;;    without specific prior written permission.
 151 ;;
 152 ;; THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND
 153 ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 154 ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 155 ;; PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE
 156 ;; LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 157 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 158 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 159 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 160 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 161 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 162 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 163
 164 ;;; mew-demo.el ends here