Mercurial > hg > xemacs-beta

comparison lisp/gnus/gnus-xmas.el @ 100:4be1180a9e89 r20-1b2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b2
author cvs
date Mon, 13 Aug 2007 09:15:11 +0200
parents 0d2f883870bc
children cf808b4c4290
comparison
equal deleted inserted replaced
99:2d83cbd90d8d 100:4be1180a9e89
739 (let* ((file (concat gnus-xmas-glyph-directory "gnus-pointer." 739 (let* ((file (concat gnus-xmas-glyph-directory "gnus-pointer."
740 (if (featurep 'xpm) "xpm" "xbm"))) 740 (if (featurep 'xpm) "xpm" "xbm")))
741 (glyph (make-glyph file))) 741 (glyph (make-glyph file)))
742 (when (and (featurep 'x) 742 (when (and (featurep 'x)
743 (file-exists-p file)) 743 (file-exists-p file))
744 (set-glyph-face glyph 'modeline-buffer-id)) 744 (set-glyph-face glyph 'modeline-buffer-id)
745 (set-glyph-property glyph 'image (cons 'tty "Gnus:")) 745 (set-glyph-property glyph 'image (cons 'tty "Gnus:"))
746 glyph))) 746 glyph))))
747 747
748 (defun gnus-xmas-mode-line-buffer-identification (line) 748 (defun gnus-xmas-mode-line-buffer-identification (line)
749 (let ((line (car line)) 749 (let ((line (car line))
750 chop) 750 chop)
751 (if (not (stringp line)) 751 (cond
752 (list line) 752 ;; This is some weird type of id.
753 (when (string-match "^Gnus:" line) 753 ((not (stringp line))
754 (setq chop (match-end 0)) 754 (list line))
755 (list 755 ;; This is non-standard, so we just pass it through.
756 (if gnus-xmas-modeline-glyph 756 ((not (string-match "^Gnus:" line))
757 (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) 757 (list line))
758 (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) 758 ;; We have a standard line, so we colorize and glyphize it a bit.
759 (cons gnus-xmas-modeline-right-extent (substring line chop))))))) 759 (t
760 (setq chop (match-end 0))
761 (list
762 (if gnus-xmas-modeline-glyph
763 (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph)
764 (cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
765 (cons gnus-xmas-modeline-right-extent (substring line chop)))))))
760 766
761 (defun gnus-xmas-splash () 767 (defun gnus-xmas-splash ()
762 (when (eq (device-type) 'x) 768 (when (eq (device-type) 'x)
763 (gnus-splash))) 769 (gnus-splash)))
764 770