;;; gnus-xmas.el --- Gnus functions for XEmacs
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2005, 2006, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(delete-extent extent)
nil)))
+(defun gnus-xmas-overlays-in (beg end)
+ "Return a list of the extents that overlap the region BEG ... END."
+ (mapcar-extents #'identity nil nil beg end))
+
(defun gnus-xmas-window-top-edge (&optional window)
(nth 1 (window-pixel-edges window)))
(defun gnus-xmas-read-event-char (&optional prompt)
"Get the next event."
(when prompt
- (message "%s" prompt))
+ (display-message 'no-log (format "%s" prompt)))
(let ((event (next-command-event)))
(sit-for 0)
;; We junk all non-key events. Is this naughty?
(let ((keymap (copy-keymap gnus-article-mode-map))
(map (copy-keymap gnus-article-send-map))
(sumkeys (where-is-internal 'gnus-article-read-summary-keys))
- agent draft)
+ parent agent draft)
(define-key keymap "S" map)
(set-keymap-default-binding map nil)
(with-current-buffer gnus-article-current-summary
+ (set-keymap-parent
+ keymap
+ (if (setq parent (keymap-parent gnus-article-mode-map))
+ (prog1
+ (setq parent (copy-keymap parent))
+ (set-keymap-parent parent (current-local-map)))
+ (current-local-map)))
(let ((def (key-binding "S"))
gnus-pick-mode)
(set-keymap-parent map (if (symbolp def)
(make-extent beg end buffer)))
(defalias 'gnus-delete-overlay 'delete-extent)
+ (defalias 'gnus-overlay-get 'extent-property)
(defalias 'gnus-overlay-put 'set-extent-property)
(defalias 'gnus-move-overlay 'gnus-xmas-move-overlay)
(defalias 'gnus-overlay-buffer 'extent-object)
(defalias 'gnus-overlay-start 'extent-start-position)
(defalias 'gnus-overlay-end 'extent-end-position)
+ (defalias 'gnus-overlays-in 'gnus-xmas-overlays-in)
(defalias 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays)
(defalias 'gnus-extent-detached-p 'extent-detached-p)
(defalias 'gnus-add-text-properties 'gnus-xmas-add-text-properties)
(list
(cons 'x
(expand-file-name pixmap gnus-xmas-glyph-directory))
- (cons 'mswindows
- (expand-file-name pixmap gnus-xmas-glyph-directory))
(cons 'tty substring)))))
(setq gnus-group-icon-cache
(cons (cons pixmap glyph) gnus-group-icon-cache))
(featurep (if (eq type 'pbm) 'xbm type))))
(defun gnus-xmas-create-image (file &optional type data-p &rest props)
- (let ((type (if type
- (symbol-name type)
- (car (last (split-string file "[.]")))))
+ (let ((type (cond
+ (type
+ (symbol-name type))
+ ((string-match "[.]" file)
+ (car (last (split-string file "[.]"))))))
(face (plist-get props :face))
glyph)
(when (equal type "pbm")
(insert-file-contents-literally file))
(make-glyph
(vector
- (or (intern type)
- (mm-image-type-from-buffer))
+ (if type
+ (intern type)
+ (mm-image-type-from-buffer))
:data (buffer-string))))))
(when face
(set-glyph-face glyph face))
(provide 'gnus-xmas)
-;;; arch-tag: 4e84de3f-ea0a-4ee3-bfeb-e03d46fcacef
;;; gnus-xmas.el ends here