;;; Code:
(eval-when-compile
- (require 'static)
(require 'liece-compat)
(require 'liece-vars))
(autoload 'bitmap-stipple-xbm-file-to-stipple "bitmap-stipple")
(autoload 'bitmap-stipple-insert-pixmap "bitmap-stipple"))
-(defcustom liece-emacs-unread-character "!"
- "Unread character."
- :type 'character
- :group 'liece-look)
-
;;; @ widget emulation
;;;
(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
;;;
(defun liece-emacs-unread-mark (chnl)
(if liece-display-unread-mark
- (with-current-buffer liece-channel-list-buffer
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
- (goto-char (match-end 0))
- (insert (concat " " liece-emacs-unread-character)))))))
+ (with-current-buffer liece-channel-list-buffer
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
+ (goto-char (match-end 0))
+ (insert (concat " " liece-channel-unread-character)))))))
(defun liece-emacs-read-mark (chnl)
(if liece-display-unread-mark
- (with-current-buffer liece-channel-list-buffer
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^ ?[0-9]+: " chnl " "
- liece-emacs-unread-character "$") nil t)
- (goto-char (- (match-end 0) 2))
- (delete-char 2))))))
+ (with-current-buffer liece-channel-list-buffer
+ (let ((buffer-read-only nil))
+ (goto-char (point-min))
+ (when (re-search-forward
+ (concat "^ ?[0-9]+: " chnl " "
+ liece-channel-unread-character "$") nil t)
+ (goto-char (- (match-end 0) 2))
+ (delete-char 2))))))
(defun liece-emacs-redisplay-unread-mark ()
(if liece-display-unread-mark
- (let ((chnl))
(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)
-
-(and liece-splash-image window-system
- (liece-emacs-splash))
+ (liece-emacs-unread-mark chnl))))
+
+(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)
-(add-hook 'liece-channel-unread-hook 'liece-emacs-unread-mark)
-(add-hook 'liece-channel-read-hook 'liece-emacs-read-mark)
+(add-hook 'liece-channel-unread-functions 'liece-emacs-unread-mark)
+(add-hook 'liece-channel-read-functions 'liece-emacs-read-mark)
(provide 'liece-emacs)
projects / elisp / liece.git / blobdiff