1 ;;; gnus-xmas.el --- Gnus functions for XEmacs
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
4 ;; Free Software Foundation, Inc.
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
31 (defvar menu-bar-mode (featurep 'menubar))
32 (require 'messagexmas)
35 (defgroup gnus-xmas nil
36 "XEmacsoid support for Gnus"
39 (defcustom gnus-xmas-glyph-directory nil
40 "Directory where Gnus logos and icons are located.
41 If this variable is nil, Gnus will try to locate the directory
43 :type '(choice (const :tag "autodetect" nil)
47 (unless gnus-xmas-glyph-directory
48 (unless (setq gnus-xmas-glyph-directory
49 (message-xmas-find-glyph-directory "gnus"))
50 (error "Can't find glyph directory. \
51 Possibly the `etc' directory has not been installed.")))
53 ;;; Internal variables.
55 ;; Don't warn about these undefined variables.
58 (defvar gnus-active-hashtb)
59 (defvar gnus-article-buffer)
60 (defvar gnus-auto-center-summary)
61 (defvar gnus-current-headers)
62 (defvar gnus-level-killed)
63 (defvar gnus-level-zombie)
64 (defvar gnus-newsgroup-bookmarks)
65 (defvar gnus-newsgroup-dependencies)
66 (defvar gnus-newsgroup-selected-overlay)
67 (defvar gnus-newsrc-hashtb)
68 (defvar gnus-read-mark)
69 (defvar gnus-refer-article-method)
70 (defvar gnus-reffed-article-number)
71 (defvar gnus-unread-mark)
73 (defvar gnus-view-pseudos)
74 (defvar gnus-view-pseudos-separately)
76 (defvar gnus-zombie-list)
77 ;;defined in gnus-msg.el
78 (defvar gnus-article-copy)
79 (defvar gnus-check-before-posting)
80 ;;defined in gnus-vis.el
81 (defvar gnus-article-button-face)
82 (defvar gnus-article-mouse-face)
83 (defvar gnus-summary-selected-face)
84 (defvar gnus-group-reading-menu)
85 (defvar gnus-group-group-menu)
86 (defvar gnus-group-misc-menu)
87 (defvar gnus-summary-article-menu)
88 (defvar gnus-summary-thread-menu)
89 (defvar gnus-summary-misc-menu)
90 (defvar gnus-summary-post-menu)
91 (defvar gnus-summary-kill-menu)
92 (defvar gnus-article-article-menu)
93 (defvar gnus-article-treatment-menu)
95 (defvar standard-display-table)
96 (defvar gnus-tree-minimize-window)
98 (defun gnus-xmas-set-text-properties (start end props &optional buffer)
99 "You should NEVER use this function. It is ideologically blasphemous.
100 It is provided only to ease porting of broken FSF Emacs programs."
103 (map-extents (lambda (extent ignored)
104 (remove-text-properties
106 (list (extent-property extent 'text-prop) nil)
109 buffer start end nil nil 'text-prop)
110 (gnus-add-text-properties start end props buffer)))
112 (defun gnus-xmas-highlight-selected-summary ()
113 ;; Highlight selected article in summary buffer
114 (when gnus-summary-selected-face
115 (when gnus-newsgroup-selected-overlay
116 (delete-extent gnus-newsgroup-selected-overlay))
117 (setq gnus-newsgroup-selected-overlay
118 (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
119 (set-extent-face gnus-newsgroup-selected-overlay
120 gnus-summary-selected-face)))
122 (defcustom gnus-xmas-force-redisplay nil
123 "*If non-nil, force a redisplay before recentering the summary buffer.
124 This is ugly, but it works around a bug in `window-displayed-height'."
128 (defun gnus-xmas-switch-horizontal-scrollbar-off ()
129 (when (featurep 'scrollbar)
130 (set-specifier scrollbar-height (cons (current-buffer) 0))))
132 (defun gnus-xmas-summary-recenter ()
133 "\"Center\" point in the summary window.
134 If `gnus-auto-center-summary' is nil, or the article buffer isn't
135 displayed, no centering will be performed."
136 ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
137 ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
138 ;; Force redisplay to get properly computed window height.
139 (when gnus-xmas-force-redisplay
141 (when gnus-auto-center-summary
142 (let* ((height (if (fboundp 'window-displayed-height)
143 (window-displayed-height)
144 (- (window-height) 2)))
145 (top (cond ((< height 4) 0)
147 (t (if (numberp gnus-auto-center-summary)
148 gnus-auto-center-summary
150 (bottom (save-excursion (goto-char (point-max))
151 (forward-line (- height))
153 (window (get-buffer-window (current-buffer))))
154 (when (get-buffer-window gnus-article-buffer)
155 ;; Only do recentering when the article buffer is displayed,
156 ;; Set the window start to either `bottom', which is the biggest
157 ;; possible valid number, or the second line from the top,
158 ;; whichever is the least.
159 ;; NOFORCE parameter suggested by Daniel Pittman <daniel@danann.net>.
161 window (min bottom (save-excursion (forward-line (- top)) (point)))
163 ;; Do horizontal recentering while we're at it.
164 (when (and (get-buffer-window (current-buffer) t)
165 (not (eq gnus-auto-center-summary 'vertical)))
166 (let ((selected (selected-window)))
167 (select-window (get-buffer-window (current-buffer) t))
168 (gnus-summary-position-point)
169 (gnus-horizontal-recenter)
170 (select-window selected))))))
172 (defun gnus-xmas-summary-set-display-table ()
173 ;; Setup the display table -- like `gnus-summary-setup-display-table',
174 ;; but done in an XEmacsish way.
175 (let ((table (make-display-table))
177 ;; Nix out all the control chars...
178 (while (>= (setq i (1- i)) 0)