(defalias 'gnus-put-text-property 'gnus-xmas-put-text-property)
(defalias 'gnus-deactivate-mark 'ignore)
(defalias 'gnus-window-edges 'window-pixel-edges)
-
+
(if (and (<= emacs-major-version 19)
- (< emacs-minor-version 14))
+ (< emacs-minor-version 14))
(defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties))
(unless (boundp 'standard-display-table)
(defalias 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
(defalias 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
(defalias 'gnus-appt-select-lowest-window
- 'gnus-xmas-appt-select-lowest-window)
+ 'gnus-xmas-appt-select-lowest-window)
(defalias 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
(defalias 'gnus-character-to-event 'character-to-event)
(defalias 'gnus-mode-line-buffer-identification
- 'gnus-xmas-mode-line-buffer-identification)
+ 'gnus-xmas-mode-line-buffer-identification)
(defalias 'gnus-key-press-event-p 'key-press-event-p)
(defalias 'gnus-region-active-p 'region-active-p)
(defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
(defalias 'gnus-create-image 'gnus-xmas-create-image)
(defalias 'gnus-remove-image 'gnus-xmas-remove-image)
+ (when (or (< emacs-major-version 21)
+ (and (= emacs-major-version 21)
+ (< emacs-minor-version 3)))
+ (defalias 'gnus-completing-read 'gnus-xmas-completing-read))
+
;; These ones are not defcutom'ed, sometimes not even defvar'ed. They
;; probably should. If that is done, the code below should then be moved
;; where each variable is defined, in order not to mess with user settings.
[gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
[gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
[gnus-group-kill-group gnus-group-kill-group t "Kill group"]
+ [gnus-summary-mail-save
+ gnus-group-save-newsrc t "Save .newsrc files"] ; borrowed icon.
[gnus-group-exit gnus-group-exit t "Exit Gnus"])
"The group buffer toolbar.")
gnus-summary-save-article-file t "Save article in file"]
[gnus-summary-save-article
gnus-summary-save-article t "Save article"]
+ [gnus-summary-cancel-article ; usenet : cancellation :: mail : deletion.
+ gnus-summary-delete-article t "Delete message"]
[gnus-summary-catchup
gnus-summary-catchup t "Catchup"]
[gnus-summary-catchup-and-exit
'call-process-region (point-min) (point-max) command t '(t nil) nil
args))
-(defface gnus-x-face '((t (:foreground "black" :background "white")))
- "Face to show X face"
- :group 'gnus-xmas)
-
-(defun gnus-xmas-article-display-xface (data)
- "Display the XFace in DATA."
- (save-excursion
- (let ((xface-glyph
- (cond
- ((featurep 'xface)
- (make-glyph (vector 'xface :data
- (concat "X-Face: " data))))
- ((featurep 'xpm)
- (let ((cur (current-buffer)))
- (save-excursion
- (gnus-set-work-buffer)
- (insert data)
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (gnus-xmas-call-region "uncompface")
- (goto-char (point-min))
- (insert "/* Width=48, Height=48 */\n")
- (gnus-xmas-call-region "icontopbm")
- (gnus-xmas-call-region "ppmtoxpm")
- (make-glyph
- (vector 'xpm :data (buffer-string)))))))
- (t
- (make-glyph [nothing])))))
- (set-glyph-face xface-glyph 'gnus-x-face)
-
- (gnus-article-goto-header "from")
- ;;(gnus-put-image xface-glyph " ")
- (let ((extent (make-extent (1- (point)) (point))))
- (set-extent-property extent 'gnus-image t)
- (set-extent-property extent 'duplicable t)
- (set-extent-property extent 'end-glyph xface-glyph))
- (gnus-add-wash-type 'xface)
- (gnus-add-image 'xface xface-glyph))))
-
(defvar gnus-xmas-modeline-left-extent
(let ((ext (copy-extent modeline-buffer-id-left-extent)))
ext))
gnus-mailing-list-menu))
(defun gnus-xmas-image-type-available-p (type)
- (featurep type))
+ (and window-system
+ (featurep (if (eq type 'pbm) 'xbm type))))
-(defun gnus-xmas-create-image (file &optional type data-p)
+(defun gnus-xmas-create-image (file &optional type data-p &rest props)
(let ((type (if type
(symbol-name type)
- (car (last (split-string file "[.]"))))))
- (if (equal type "xbm")
- (make-glyph (list (cons 'x file)))
- (with-tmp-buffer
- (if data-p
- (insert file)
- (insert-file-contents file))
- (make-glyph
- (vector
- (or (mm-image-type-from-buffer)
- (intern type))
- :data (buffer-string)))))))
+ (car (last (split-string file "[.]")))))
+ (face (plist-get props :face))
+ glyph)
+ (when (equal type "pbm")
+ (with-temp-buffer
+ (if data-p
+ (insert file)
+ (insert-file-contents file))
+ (shell-command-on-region (point-min) (point-max)
+ "ppmtoxpm 2>/dev/null" t)
+ (setq file (buffer-string)
+ type "xpm"
+ data-p t)))
+ (setq glyph
+ (if (equal type "xbm")
+ (make-glyph (list (cons 'x file)))
+ (with-temp-buffer
+ (if data-p
+ (insert file)
+ (insert-file-contents file))
+ (make-glyph
+ (vector
+ (or (intern type)
+ (mm-image-type-from-buffer))
+ :data (buffer-string))))))
+ (when face
+ (set-glyph-face glyph face))
+ glyph))
(defun gnus-xmas-put-image (glyph &optional string)
"Insert STRING, but display GLYPH.
Warning: Don't insert text immediately after the image."
(let ((begin (point))
extent)
- (insert string)
+ (if (and (bobp) (not string))
+ (setq string " "))
+ (if string
+ (insert string)
+ (setq begin (1- begin)))
(setq extent (make-extent begin (point)))
(set-extent-property extent 'gnus-image t)
(set-extent-property extent 'duplicable t)
- (set-extent-property extent 'invisible t)
- (set-extent-property extent 'end-glyph glyph)))
+ (if string
+ (set-extent-property extent 'invisible t))
+ (set-extent-property extent 'end-glyph glyph))
+ glyph)
(defun gnus-xmas-remove-image (image)
(map-extents
nil)
nil nil nil nil nil 'gnus-image))
+(defun gnus-xmas-completing-read (prompt table &optional
+ predicate require-match history)
+ (when (and history
+ (not (boundp history)))
+ (set history nil))
+ (completing-read
+ (if (symbol-value history)
+ (concat prompt " (" (car (symbol-value history)) "): ")
+ (concat prompt ": "))
+ table
+ predicate
+ require-match
+ nil
+ history))
+
(provide 'gnus-xmas)
;;; gnus-xmas.el ends here
projects / gnus / blobdiff