-;;; gnus-xmal.el --- Gnus functions for XEmacs
+;;; gnus-xmas.el --- Gnus functions for XEmacs
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;;; Code:
-(require 'mode-motion)
(require 'text-props)
+(defvar menu-bar-mode t)
(defvar gnus-xmas-glyph-directory nil
"*Directory where Gnus logos and icons are located.
(defvar gnus-mouse-2)
(defvar standard-display-table)
-(defun gnus-xmas-install-mouse-tracker ()
- (add-hook 'mode-motion-hook 'mode-motion-highlight-line))
-
(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."
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- window (min bottom (save-excursion (forward-line (- top))
- (point)))))))
-
-(defun gnus-xmas-group-insert-group-line-info (group)
- (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
- (beg (point))
- active info)
- (if entry
- (progn
- (setq info (nth 2 entry))
- (gnus-group-insert-group-line
- nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
- (setq active (gnus-gethash group gnus-active-hashtb))
-
- (gnus-group-insert-group-line
- nil group (if (member group gnus-zombie-list) gnus-level-zombie
- gnus-level-killed)
- nil (if active (- (1+ (cdr active)) (car active)) 0) nil))
- (save-excursion
- (goto-char beg)
- (remove-text-properties
- (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol))
- '(gnus-group nil)))))
-
+ window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))))
+
+(defun gnus-xmas-group-remove-excess-properties ()
+ (let ((end (point))
+ (beg (progn (forward-line -1) (point))))
+ (remove-text-properties (1+ beg) end '(gnus-group nil))
+ (remove-text-properties
+ beg end
+ '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil))
+ (goto-char end)))
+
(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-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-install-mouse-tracker))
+ (easy-menu-add 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-install-mouse-tracker))
+ (easy-menu-add gnus-summary-kill-menu))
(defun gnus-xmas-article-menu-add ()
(easy-menu-add gnus-article-article-menu)
(or (boundp 'standard-display-table) (setq standard-display-table nil))
(or (boundp 'read-event) (fset 'read-event 'next-command-event))
+ (defvar gnus-mouse-face-prop 'highlight)
+
+ (defun gnus-byte-code (func)
+ "Return a form that can be `eval'ed based on FUNC."
+ (let ((fval (symbol-function func)))
+ (if (byte-code-function-p fval)
+ (list 'funcall fval)
+ (cons 'progn (cdr (cdr fval))))))
+
;; Fix by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
(defvar gnus-display-type (device-class)
"A symbol indicating the display Emacs is running under.
This is a meta-variable that will affect what default values other
variables get. You would normally not change this variable, but
-pounce directly on the real variables themselves."))
+pounce directly on the real variables themselves.")
+ )
(defun gnus-xmas-redefine ()
- (fset 'gnus-mouse-face-function 'identity)
+
+
(fset 'gnus-summary-make-display-table (lambda () nil))
(fset 'gnus-visual-turn-off-edit-menu 'identity)
(fset 'gnus-highlight-selected-summary
'gnus-xmas-highlight-selected-summary)
(fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
- (fset 'gnus-group-insert-group-line-info
- 'gnus-xmas-group-insert-group-line-info)
+ (fset 'gnus-group-remove-excess-properties
+ 'gnus-xmas-group-remove-excess-properties)
(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)
(or (fboundp 'appt-select-lowest-window)
(fset 'appt-select-lowest-window
- 'gnus-xnas-appt-select-lowest-window))
+ 'gnus-xmas-appt-select-lowest-window))
- (add-hook 'gnus-group-menu-hook 'gnus-xmas-group-menu-add)
- (add-hook 'gnus-summary-menu-hook 'gnus-xmas-summary-menu-add)
- (add-hook 'gnus-article-menu-hook 'gnus-xmas-article-menu-add)
+ (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-group-mode-hook 'gnus-xmas-setup-group-toolbar)
- (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
-
- )
+ (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar))
;;; XEmacs logo and toolbar.
(file-name-directory (directory-file-name (car path)))
"etc/"))
(if (and (file-exists-p dir)
- (file-directory-p dir))
+ (file-directory-p dir)
+ (file-exists-p (concat dir "gnus-group-exit-icon-up.xpm")))
(setq gnus-xmas-glyph-directory dir
path nil)
(setq path (cdr path))))
[gnus-group-kill-group-icon gnus-group-kill-group t "Kill group"]
[gnus-group-get-new-news-icon gnus-group-get-new-news t "Get new news"]
[gnus-group-get-new-news-this-group-icon
- gnus-group-get-new-news-this-group t "Get new new in this group"]
+ gnus-group-get-new-news-this-group t "Get new news in this group"]
[gnus-group-catchup-current-icon
gnus-group-catchup-current t "Catchup group"]
[gnus-group-describe-group-icon
"The summary buffer toolbar.")
(defun gnus-xmas-setup-toolbar (bar &optional force)
- (let ((dir (file-name-as-directory (gnus-xmas-find-glyph-directory)))
+ (let ((dir (gnus-xmas-find-glyph-directory))
icon up down disabled name)
- (if (or (not dir)
- (and (not force)
- (boundp (aref (car bar) 0))))
+ (if (not dir)
()
- (while bar
- (setq icon (aref (car bar) 0)
- name (symbol-name icon)
- bar (cdr bar))
- (setq up (concat dir name "-up.xpm"))
- (setq down (concat dir name "-down.xpm"))
- (setq disabled (concat dir name "-disabled.xpm"))
- (if (not (file-exists-p up))
- (set icon nil)
- (set icon (toolbar-make-button-list
- up (and (file-exists-p down) down)
- (and (file-exists-p disabled) disabled))))))))
+ (if (and (not force)
+ (boundp (aref (car bar) 0)))
+ dir
+ (while bar
+ (setq icon (aref (car bar) 0)
+ name (symbol-name icon)
+ bar (cdr bar))
+ (setq up (concat dir name "-up.xpm"))
+ (setq down (concat dir name "-down.xpm"))
+ (setq disabled (concat dir name "-disabled.xpm"))
+ (if (not (file-exists-p up))
+ (set icon nil)
+ (set icon (toolbar-make-button-list
+ up (and (file-exists-p down) down)
+ (and (file-exists-p disabled) disabled)))))
+ dir))))
(defun gnus-xmas-setup-group-toolbar ()
- (if (not gnus-use-toolbar)
- ()
- (gnus-xmas-setup-toolbar gnus-group-toolbar)
- (set-specifier (symbol-value gnus-use-toolbar)
- (cons (current-buffer) gnus-group-toolbar))))
+ (and gnus-use-toolbar
+ (gnus-xmas-setup-toolbar gnus-group-toolbar)
+ (set-specifier (symbol-value gnus-use-toolbar)
+ (cons (current-buffer) gnus-group-toolbar))))
(defun gnus-xmas-setup-summary-toolbar ()
- (if (not gnus-use-toolbar)
- ()
- (gnus-xmas-setup-toolbar gnus-summary-toolbar)
- (set-specifier (symbol-value gnus-use-toolbar)
- (cons (current-buffer) gnus-summary-toolbar))))
-
+ (and gnus-use-toolbar
+ (gnus-xmas-setup-toolbar gnus-summary-toolbar)
+ (set-specifier (symbol-value gnus-use-toolbar)
+ (cons (current-buffer) gnus-summary-toolbar))))
;;; gnus-xmas.el ends here
projects / gnus / blobdiff