;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(defun gnus-xmas-set-text-properties (start end props &optional buffer)
"You should NEVER use this function. It is ideologically blasphemous.
It is provided only to ease porting of broken FSF Emacs programs."
- (if (and (stringp buffer) (not (setq buffer (get-buffer buffer))))
+ (if (stringp buffer)
nil
(map-extents (lambda (extent ignored)
(remove-text-properties
'(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil))
(goto-char end)))
+(defun gnus-xmas-topic-remove-excess-properties ()
+ (let ((end (point))
+ (beg (progn (forward-line -1) (point))))
+ (remove-text-properties beg end '(gnus-group nil))
+ (goto-char end)))
+
+(defun gnus-xmas-extent-start-open (point)
+ (map-extents (lambda (extent arg)
+ (set-extent-property extent 'start-open t))
+ nil point (min (1+ (point)) (point-max))))
+
(defun gnus-xmas-copy-article-buffer (&optional article-buffer)
(setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
(buffer-disable-undo gnus-article-copy)
(defun gnus-xmas-move-overlay (extent start end &optional buffer)
(set-extent-endpoints extent start end))
-(defun gnus-xmas-make-overlay (from to &optional buf)
- (let ((extent (make-extent from to buf)))
- (set-extent-property extent 'detachable nil)
- extent))
-
;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
(defun gnus-xmas-article-add-button (from to fun &optional data)
"Create a button between FROM and TO with callback FUN and data DATA."
(select-window lowest-window)
(setq window-search nil)))))))
+(defmacro gnus-xmas-menu-add (type &rest menus)
+ `(gnus-xmas-menu-add-1 ',type ',menus))
+(put 'gnus-xmas-menu-add 'lisp-indent-function 1)
+(put 'gnus-xmas-menu-add 'lisp-indent-hook 1)
+
+(defun gnus-xmas-menu-add-1 (type menus)
+ (when (and menu-bar-mode
+ (gnus-visual-p (intern (format "%s-menu" type)) 'menu))
+ (while menus
+ (easy-menu-add (symbol-value (pop menus))))))
+
(defun gnus-xmas-group-menu-add ()
- (easy-menu-add gnus-group-reading-menu)
- (easy-menu-add gnus-group-group-menu)
- (easy-menu-add gnus-group-misc-menu))
+ (gnus-xmas-menu-add group
+ gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu))
(defun gnus-xmas-summary-menu-add ()
- (easy-menu-add gnus-summary-article-menu)
- (easy-menu-add gnus-summary-thread-menu)
- (easy-menu-add gnus-summary-misc-menu)
- (easy-menu-add gnus-summary-post-menu)
- (easy-menu-add gnus-summary-kill-menu))
+ (gnus-xmas-menu-add summary
+ gnus-summary-article-menu gnus-summary-thread-menu
+ gnus-summary-misc-menu gnus-summary-post-menu gnus-summary-kill-menu))
(defun gnus-xmas-article-menu-add ()
- (easy-menu-add gnus-article-article-menu)
- (easy-menu-add gnus-article-treatment-menu))
+ (gnus-xmas-menu-add article
+ gnus-article-article-menu gnus-article-treatment-menu))
+
+(defun gnus-xmas-pick-menu-add ()
+ (gnus-xmas-menu-add pick
+ gnus-pick-menu))
+
+(defun gnus-xmas-binary-menu-add ()
+ (gnus-xmas-menu-add binary
+ gnus-binary-menu))
+
+(defun gnus-xmas-tree-menu-add ()
+ (gnus-xmas-menu-add tree
+ gnus-tree-menu))
+
+(defun gnus-xmas-grouplens-menu-add ()
+ (gnus-xmas-menu-add grouplens
+ gnus-grouplens-menu))
(defun gnus-xmas-read-event-char ()
"Get the next event."
(or (face-differs-from-default-p 'underline)
(funcall (intern "set-face-underline-p") 'underline t))
- (fset 'gnus-make-overlay 'gnus-xmas-make-overlay)
+ (fset 'gnus-make-overlay 'make-extent)
(fset 'gnus-overlay-put 'set-extent-property)
(fset 'gnus-move-overlay 'gnus-xmas-move-overlay)
(fset 'gnus-overlay-end 'extent-end-position)
+ (fset 'gnus-extent-detached-p 'extent-detached-p)
- (fset 'set-text-properties 'gnus-xmas-set-text-properties)
+ (require 'text-props)
+ (if (< emacs-minor-version 14)
+ (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties))
(fset 'nnheader-find-file-noselect 'gnus-xmas-find-file-noselect)
pounce directly on the real variables themselves.")
- (or (fboundp 'x-color-values)
- (fset 'x-color-values
- (lambda (color)
- (color-instance-rgb-components
- (make-color-instance color)))))
+ (fset 'gnus-x-color-values
+ (if (fboundp 'x-color-values)
+ 'x-color-values
+ (lambda (color)
+ (color-instance-rgb-components
+ (make-color-instance color)))))
(defvar gnus-background-mode
(let ((bg-resource
(params (frame-parameters)))
(cond (bg-resource (intern (downcase bg-resource)))
((and (assq 'background-color params)
- (< (apply '+ (x-color-values
+ (< (apply '+ (gnus-x-color-values
(cdr (assq 'background-color params))))
- (/ (apply '+ (x-color-values "white")) 3)))
+ (/ (apply '+ (gnus-x-color-values "white")) 3)))
'dark)
(t 'light)))
"A symbol indicating the Emacs background brightness.
(fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
(fset 'gnus-group-remove-excess-properties
'gnus-xmas-group-remove-excess-properties)
+ (fset 'gnus-topic-remove-excess-properties
+ 'gnus-xmas-topic-remove-excess-properties)
+ (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
(fset 'gnus-copy-article-buffer 'gnus-xmas-copy-article-buffer)
(fset 'gnus-article-push-button 'gnus-xmas-article-push-button)
(fset 'gnus-article-add-button 'gnus-xmas-article-add-button)
(fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge)
- (fset 'set-text-properties 'gnus-xmas-set-text-properties)
(fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
(fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
(fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
-
- (or (fboundp 'appt-select-lowest-window)
- (fset 'appt-select-lowest-window
- 'gnus-xmas-appt-select-lowest-window))
+ (fset 'gnus-appt-select-lowest-window
+ 'gnus-xmas-appt-select-lowest-window)
+ (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
(add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)
+ (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)
+ (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add)
+ (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add)
+ (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add)
+
(add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar))
(while path
(setq dir (concat
(file-name-directory (directory-file-name (car path)))
- "etc/"))
+ "etc/gnus/"))
(if (and (file-exists-p dir)
(file-directory-p dir)
(file-exists-p (concat dir "gnus-group-exit-icon-up.xpm")))
;; Written by Erik Naggum <erik@naggum.no>.
;; Saved by Steve Baur <steve@miranova.com>.
+(or (fboundp 'insert-file-contents-literally)
(defun insert-file-contents-literally (filename &optional visit beg end replace)
"Like `insert-file-contents', q.v., but only reads in the file.
A buffer may be modified in several ways after reading into the buffer due
(insert-file-contents filename visit beg end replace))
(if find-buffer-file-type-function
(fset 'find-buffer-file-type find-buffer-file-type-function)
- (fmakunbound 'find-buffer-file-type)))))
+ (fmakunbound 'find-buffer-file-type))))))
(defun gnus-xmas-find-file-noselect (filename &optional nowarn rawfile)
"Read file FILENAME into a buffer and return the buffer.
(after-find-file error (not nowarn)))))
buf)))
+(defun gnus-xmas-mail-strip-quoted-names (address)
+ "Protect mail-strip-quoted-names from NIL input.
+XEmacs compatibility workaround."
+ (if (null address)
+ nil
+ (mail-strip-quoted-names address)))
;;; gnus-xmas.el ends here