* liece-compat.el: Require `wid-edit'.
authorueno <ueno>
Wed, 20 Sep 2000 21:40:18 +0000 (21:40 +0000)
committerueno <ueno>
Wed, 20 Sep 2000 21:40:18 +0000 (21:40 +0000)
* liece-inlines.el (liece-locate-icon-file): Don't check existence
of the file.

* liece-emacs.el: Don't require `static' and `wid-edit'.
(liece-splash-image): Set default to nil.
(liece-emacs-splash-function): New variable.
(liece-emacs-splash-with-image): New function splitted from
`liece-emacs-splash'; use `image-size'; hide cursor.
(liece-emacs-splash-with-stipple): New function.

lisp/ChangeLog
lisp/liece-compat.el
lisp/liece-emacs.el
lisp/liece-inlines.el

index 63e9673..c609757 100644 (file)
@@ -1,5 +1,17 @@
 2000-09-20   Daiki Ueno  <ueno@unixuser.org>
 
+       * liece-compat.el: Require `wid-edit'.
+
+       * liece-inlines.el (liece-locate-icon-file): Don't check existence
+       of the file.
+
+       * liece-emacs.el: Don't require `static' and `wid-edit'.
+       (liece-splash-image): Set default to nil.
+       (liece-emacs-splash-function): New variable.
+       (liece-emacs-splash-with-image): New function splitted from
+       `liece-emacs-splash'; use `image-size'; hide cursor.
+       (liece-emacs-splash-with-stipple): New function.
+
        * liece-minibuf.el (liece-minibuffer-parse-modes): Don't complete
        mode flags when completing an argument.
 
index 96afb99..3a01cf0 100644 (file)
 (eval-when-compile (require 'cl))
 
 (require 'pcustom)
-
-(eval-when-compile (require 'wid-edit))
-
-(eval-and-compile (autoload 'widget-convert-button "wid-edit"))
+(require 'wid-edit)
 
 (defalias 'liece-widget-convert-button 'widget-convert-button)
 (defalias 'liece-widget-button-click 'widget-button-click)
index dbd82a1..92b2c9d 100644 (file)
@@ -29,7 +29,6 @@
 ;;; Code:
 
 (eval-when-compile
-  (require 'static)
   (require 'liece-compat)
   (require 'liece-vars))
 
@@ -46,7 +45,6 @@
 (defvar liece-widget-keymap nil)
 
 (unless liece-widget-keymap
-  (require 'wid-edit)
   (setq liece-widget-keymap (copy-keymap widget-keymap))
   (substitute-key-definition
    'widget-button-click 'liece-widget-button-click
 
 ;;; @ startup splash
 ;;; 
-(defconst liece-splash-image
+(defvar liece-splash-image
   (eval-when-compile
-    (cond
-     ((and (fboundp 'image-type-available-p)
-          (image-type-available-p 'xpm))
-      (let ((file (expand-file-name "liece.xpm" default-directory)))
-       (if (file-exists-p file)
-           (list 'image
-                 :type 'xpm
-                 :data (with-temp-buffer
-                         (insert-file-contents-as-binary file)
-                         (buffer-string))))))
-     ((fboundp 'set-face-stipple)
-      (let ((file (expand-file-name "liece.xbm" default-directory)))
-       (if (file-exists-p file)
-           (bitmap-stipple-xbm-file-to-stipple file)))))))
+    (let ((file (expand-file-name "liece.xpm" default-directory)))
+      (if (file-exists-p file)
+         (with-temp-buffer
+           (insert-file-contents-as-binary file)
+           (buffer-string))))))
+
+(defun liece-emacs-splash-with-image ()
+  (or (eq (car-safe liece-splash-image) 'image)
+      (setq liece-splash-image
+           (create-image liece-splash-image 'xpm 'data)))
+  (setq cursor-type nil)
+  (when liece-splash-image
+    (let ((image-size (image-size liece-splash-image)))
+      (insert (make-string (max 0 (/ (- (window-height)
+                                       (floor (cdr image-size)))
+                                    2))
+                          ?\n))
+      (make-string (max 0 (/ (- (window-width)
+                               (floor (car image-size)))
+                            2))
+                  ?\ )
+      (insert-image liece-splash-image))))
+
+(defun liece-emacs-splash-with-stipple ()
+  (bitmap-stipple-insert-pixmap
+   (eval-when-compile
+     (let ((file (expand-file-name "liece.xbm" default-directory)))
+       (if (file-exists-p file)
+          (bitmap-stipple-xbm-file-to-stipple file))))
+   'center))
+
+(defvar liece-splash-buffer nil)
+
+(defvar liece-emacs-splash-function nil)
 
 (defun liece-emacs-splash (&optional arg)
   (interactive "P")
-  (let* ((font (cdr (assq 'font (frame-parameters))))
-        (liece-insert-environment-version nil)
-        config buffer pixel-width pixel-height)
-    (unwind-protect
-       (progn
-         (setq config (current-window-configuration))
-         (save-excursion
-           (setq buffer (generate-new-buffer
-                         (concat (if arg "*" " *")
-                                 (liece-version) "*")))
-           (switch-to-buffer buffer)
-           (erase-buffer)
-           (static-cond
-            ((and (fboundp 'image-type-available-p)
-                  (image-type-available-p 'xpm))
-             (with-temp-buffer
-               (insert (plist-get (cdr liece-splash-image) :data))
-               (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 (make-string (max 0 (/ (- (frame-height)
-                                               (/ pixel-height
-                                                  (frame-char-height)))
-                                            2))
-                                  ?\n)
-                     (make-string (max 0 (/ (- (frame-width)
-                                               (/ pixel-width
-                                                  (frame-char-width)))
-                                            2))
-                                  ?\ ))
-             (static-if (condition-case nil
-                            (progn (insert-image '(image)) nil)
-                          (wrong-number-of-arguments t))
-                 (insert-image liece-splash-image "x")
-               (insert-image liece-splash-image))
-             (insert "\n"))
-            (t
-             (bitmap-stipple-insert-pixmap liece-splash-image 'center)))
-           (insert "\n")
-           (insert-char ?\  (max 0 (/ (- (window-width)
-                                         (length (liece-version)))
-                                      2)))
-           (put-text-property (point) (prog2 (insert (liece-version))(point)
-                                        (insert "\n"))
-                              'face 'underline))
-         (or arg (sit-for 2)))
-      (unless arg
-       (kill-buffer buffer)
-       (set-window-configuration config)))))
+  (unless (and liece-splash-buffer (buffer-live-p liece-splash-buffer))
+    (let ((liece-insert-environment-version nil))
+      (save-excursion
+       (setq liece-splash-buffer (generate-new-buffer
+                                  (concat (if arg "*" " *")
+                                          (liece-version) "*")))
+       (push liece-splash-buffer liece-buffer-list)
+       (set-buffer liece-splash-buffer)
+       (erase-buffer)
+       (funcall liece-emacs-splash-function)
+       (insert-char ?\  (max 0 (/ (- (window-width)
+                                     (length (liece-version)))
+                                  2)))
+       (put-text-property (point) (prog2 (insert (liece-version))(point)
+                                    (insert "\n"))
+                          'face 'underline))))
+  (if arg
+      (switch-to-buffer liece-splash-buffer)
+    (save-window-excursion
+      (switch-to-buffer liece-splash-buffer)
+      (sit-for 2))))
 
 ;;; @ modeline decoration
 ;;; 
-(defconst liece-mode-line-image nil)
+(defvar liece-mode-line-image nil)
 
 (defun liece-emacs-create-mode-line-image ()
-  (static-when (fboundp 'image-type-available-p)
-    (let ((file (liece-locate-icon-file
-                (static-cond
-                 ((image-type-available-p 'xpm)
-                  "liece-pointer.xpm")
-                 ((image-type-available-p 'xbm)
-                  "liece-pointer.xbm")))))
-      (and file (file-exists-p file)
-          (create-image file nil nil :ascent 99)))))
+  (let ((file (liece-locate-icon-file "liece-pointer.xpm")))
+    (if (file-exists-p file)
+       (create-image file nil nil :ascent 99))))
 
 (defun liece-emacs-mode-line-buffer-identification (line)
   (let ((id (copy-sequence (car line))) image)
-    (if (and (stringp id) (string-match "^Liece:" id)
-            (setq liece-mode-line-image
-                  (liece-emacs-create-mode-line-image)))
-       (progn
-         (add-text-properties 0 (length id)
-                              (list 'display
-                                    liece-mode-line-image
-                                    'rear-nonsticky (list 'display))
-                              id)
-         (setcar line id)))
-    line))
-
-(fset 'liece-mode-line-buffer-identification
-      'liece-emacs-mode-line-buffer-identification)
+      (or liece-mode-line-image
+         (setq liece-mode-line-image (liece-emacs-create-mode-line-image)))
+      (when (and liece-mode-line-image
+                (stringp id) (string-match "^Liece:" id))
+       (add-text-properties 0 (length id)
+                            (list 'display
+                                  liece-mode-line-image
+                                  'rear-nonsticky (list 'display))
+                            id)
+       (setcar line id))
+      line))
 
 ;;; @ nick buffer decoration
 ;;; 
 (defun liece-emacs-create-nick-image (file)
-  (static-when (and (fboundp 'image-type-available-p)
-                   (image-type-available-p 'xpm))
-    (let ((file (liece-locate-icon-file file)))
-      (and file (file-exists-p file)
-          (create-image file nil nil :ascent 99)))))
+  (let ((file (liece-locate-icon-file file)))
+    (if (file-exists-p file)
+       (create-image file nil nil :ascent 99))))
 
 (defun liece-emacs-nick-image-region (start end)
   (save-excursion
       (dolist (chnl liece-channel-unread-list)
         (liece-emacs-unread-mark chnl))))
 
-(add-hook 'liece-nick-insert-hook 'liece-emacs-nick-image-region)
-(add-hook 'liece-nick-replace-hook 'liece-emacs-nick-image-region)
-       
-(when (and (not liece-inhibit-startup-message)
-          liece-splash-image window-system)
+(if (and (fboundp 'image-type-available-p)
+        (and (display-color-p)
+             (image-type-available-p 'xpm)))
+    (progn
+      (fset 'liece-mode-line-buffer-identification
+           'liece-emacs-mode-line-buffer-identification)
+      (setq liece-emacs-splash-function #'liece-emacs-splash-with-image)
+      (add-hook 'liece-nick-insert-hook 'liece-emacs-nick-image-region)
+      (add-hook 'liece-nick-replace-hook 'liece-emacs-nick-image-region))
+  (fset 'liece-mode-line-buffer-identification 'identity)
+  (setq liece-emacs-splash-function #'liece-emacs-splash-with-stipple))
+
+(when (and (not liece-inhibit-startup-message) window-system)
   (liece-emacs-splash))
 
 (fset 'liece-redisplay-unread-mark 'liece-emacs-redisplay-unread-mark)
index c73a7f4..e8a283e 100644 (file)
        (concat dir subdir)))))
 
 (defun liece-locate-icon-file (filename)
-  (if (null liece-icon-directory)
+  (or liece-icon-directory
       (setq liece-icon-directory (liece-locate-path "icons")))
-  (setq filename (expand-file-name filename liece-icon-directory))
-  (if (and filename (file-exists-p filename))
-      filename))
+  (expand-file-name filename liece-icon-directory))
 
 (defmacro liece-next-line (arg)
   `(let ((i 0))