From: ueno Date: Wed, 20 Sep 2000 21:40:18 +0000 (+0000) Subject: * liece-compat.el: Require `wid-edit'. X-Git-Tag: liece-1_4_7~48 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=196a4bc973c9ccd131ee77afca4818f7c738e5a7;p=elisp%2Fliece.git * 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. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 63e9673..c609757 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,17 @@ 2000-09-20 Daiki Ueno + * 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. diff --git a/lisp/liece-compat.el b/lisp/liece-compat.el index 96afb99..3a01cf0 100644 --- a/lisp/liece-compat.el +++ b/lisp/liece-compat.el @@ -32,10 +32,7 @@ (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) diff --git a/lisp/liece-emacs.el b/lisp/liece-emacs.el index dbd82a1..92b2c9d 100644 --- a/lisp/liece-emacs.el +++ b/lisp/liece-emacs.el @@ -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 @@ -90,117 +88,96 @@ ;;; @ 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 @@ -260,11 +237,19 @@ (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) diff --git a/lisp/liece-inlines.el b/lisp/liece-inlines.el index c73a7f4..e8a283e 100644 --- a/lisp/liece-inlines.el +++ b/lisp/liece-inlines.el @@ -170,11 +170,9 @@ (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))