aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/gnus/gnus-agent.el35
-rw-r--r--lisp/gnus/gnus-art.el144
-rw-r--r--lisp/gnus/gnus-async.el19
3 files changed, 54 insertions, 144 deletions
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 80753c11813..ae5cfc6bb9a 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -30,10 +30,8 @@
30(require 'gnus-score) 30(require 'gnus-score)
31(require 'gnus-srvr) 31(require 'gnus-srvr)
32(require 'gnus-util) 32(require 'gnus-util)
33(require 'timer)
33(eval-when-compile 34(eval-when-compile
34 (if (featurep 'xemacs)
35 (require 'itimer)
36 (require 'timer))
37 (require 'cl)) 35 (require 'cl))
38 36
39(autoload 'gnus-server-update-server "gnus-srvr") 37(autoload 'gnus-server-update-server "gnus-srvr")
@@ -82,28 +80,16 @@ If nil, only read articles will be expired."
82 :group 'gnus-agent 80 :group 'gnus-agent
83 :type 'hook) 81 :type 'hook)
84 82
85;; Extracted from gnus-xmas-redefine in order to preserve user settings
86(when (featurep 'xemacs)
87 (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
88
89(defcustom gnus-agent-summary-mode-hook nil 83(defcustom gnus-agent-summary-mode-hook nil
90 "Hook run in Agent summary minor modes." 84 "Hook run in Agent summary minor modes."
91 :group 'gnus-agent 85 :group 'gnus-agent
92 :type 'hook) 86 :type 'hook)
93 87
94;; Extracted from gnus-xmas-redefine in order to preserve user settings
95(when (featurep 'xemacs)
96 (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
97
98(defcustom gnus-agent-server-mode-hook nil 88(defcustom gnus-agent-server-mode-hook nil
99 "Hook run in Agent summary minor modes." 89 "Hook run in Agent summary minor modes."
100 :group 'gnus-agent 90 :group 'gnus-agent
101 :type 'hook) 91 :type 'hook)
102 92
103;; Extracted from gnus-xmas-redefine in order to preserve user settings
104(when (featurep 'xemacs)
105 (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
106
107(defcustom gnus-agent-confirmation-function 'y-or-n-p 93(defcustom gnus-agent-confirmation-function 'y-or-n-p
108 "Function to confirm when error happens." 94 "Function to confirm when error happens."
109 :version "21.1" 95 :version "21.1"
@@ -252,16 +238,6 @@ NOTES:
252(defvar gnus-headers) 238(defvar gnus-headers)
253(defvar gnus-score) 239(defvar gnus-score)
254 240
255;; Added to support XEmacs
256(eval-and-compile
257 (unless (fboundp 'directory-files-and-attributes)
258 (defun directory-files-and-attributes (directory
259 &optional full match nosort)
260 (let (result)
261 (dolist (file (directory-files directory full match nosort))
262 (push (cons file (file-attributes file)) result))
263 (nreverse result)))))
264
265;;; 241;;;
266;;; Setup 242;;; Setup
267;;; 243;;;
@@ -575,14 +551,7 @@ manipulated as follows:
575 (fboundp 'make-mode-line-mouse-map)) 551 (fboundp 'make-mode-line-mouse-map))
576 (propertize string 'local-map 552 (propertize string 'local-map
577 (make-mode-line-mouse-map mouse-button mouse-func) 553 (make-mode-line-mouse-map mouse-button mouse-func)
578 'mouse-face 554 'mouse-face 'mode-line-highlight)
579 (if (and (featurep 'xemacs)
580 ;; XEmacs's `facep' only checks for a face
581 ;; object, not for a face name, so it's useless
582 ;; to check with `facep'.
583 (find-face 'modeline))
584 'modeline
585 'mode-line-highlight))
586 string)) 555 string))
587 556
588(defun gnus-agent-toggle-plugged (set-to) 557(defun gnus-agent-toggle-plugged (set-to)
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index ce26b00a51c..5a27bf8be69 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -266,18 +266,11 @@ This can also be a list of the above values."
266;; Fixme: This isn't the right thing for mixed graphical and non-graphical 266;; Fixme: This isn't the right thing for mixed graphical and non-graphical
267;; frames in a session. 267;; frames in a session.
268(defcustom gnus-article-x-face-command 268(defcustom gnus-article-x-face-command
269 (if (featurep 'xemacs) 269 (if (gnus-image-type-available-p 'pbm)
270 (if (or (gnus-image-type-available-p 'xface) 270 'gnus-display-x-face-in-from
271 (gnus-image-type-available-p 'pbm)) 271 "{ echo \
272 'gnus-display-x-face-in-from
273 "{ echo \
274'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\ 272'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
275; uncompface; } | icontopbm | ee -") 273; uncompface; } | icontopbm | display -")
276 (if (gnus-image-type-available-p 'pbm)
277 'gnus-display-x-face-in-from
278 "{ echo \
279'/* Format_version=1, Width=48, Height=48, Depth=1, Valid_bits_per_item=16 */'\
280; uncompface; } | icontopbm | display -"))
281 "*String or function to be executed to display an X-Face header. 274 "*String or function to be executed to display an X-Face header.
282If it is a string, the command will be executed in a sub-shell 275If it is a string, the command will be executed in a sub-shell
283asynchronously. The compressed face will be piped to this command." 276asynchronously. The compressed face will be piped to this command."
@@ -484,9 +477,7 @@ and the latter avoids underlining any whitespace at all."
484Example: (_/*word*/_)." 477Example: (_/*word*/_)."
485 :group 'gnus-article-emphasis) 478 :group 'gnus-article-emphasis)
486 479
487(defface gnus-emphasis-strikethru (if (featurep 'xemacs) 480(defface gnus-emphasis-strikethru '((t (:strike-through t)))
488 '((t (:strikethru t)))
489 '((t (:strike-through t))))
490 "Face used for displaying strike-through text (-word-)." 481 "Face used for displaying strike-through text (-word-)."
491 :group 'gnus-article-emphasis) 482 :group 'gnus-article-emphasis)
492 483
@@ -705,13 +696,6 @@ The following additional specs are available:
705 :type 'hook 696 :type 'hook
706 :group 'gnus-article-various) 697 :group 'gnus-article-various)
707 698
708(when (featurep 'xemacs)
709 ;; Extracted from gnus-xmas-define in order to preserve user settings
710 (when (fboundp 'turn-off-scroll-in-place)
711 (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
712 ;; Extracted from gnus-xmas-redefine in order to preserve user settings
713 (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
714
715(defcustom gnus-article-menu-hook nil 699(defcustom gnus-article-menu-hook nil
716 "*Hook run after the creation of the article mode menu." 700 "*Hook run after the creation of the article mode menu."
717 :type 'hook 701 :type 'hook
@@ -877,10 +861,8 @@ be displayed by the first non-nil matching CONTENT face."
877 (item :tag "skip" nil) 861 (item :tag "skip" nil)
878 (face :value default))))) 862 (face :value default)))))
879 863
880(defcustom gnus-face-properties-alist (if (featurep 'xemacs) 864(defcustom gnus-face-properties-alist '((pbm . (:face gnus-x-face))
881 '((xface . (:face gnus-x-face))) 865 (png . nil))
882 '((pbm . (:face gnus-x-face))
883 (png . nil)))
884 "Alist of image types and properties applied to Face and X-Face images. 866 "Alist of image types and properties applied to Face and X-Face images.
885Here are examples: 867Here are examples:
886 868
@@ -896,8 +878,7 @@ Here are examples:
896 878
897See the manual for the valid properties for various image types. 879See the manual for the valid properties for various image types.
898Currently, `pbm' is used for X-Face images and `png' is used for Face 880Currently, `pbm' is used for X-Face images and `png' is used for Face
899images in Emacs. Only the `:face' property is effective on the `xface' 881images in Emacs."
900image type in XEmacs if it is built with the libcompface library."
901 :version "23.1" ;; No Gnus 882 :version "23.1" ;; No Gnus
902 :group 'gnus-article-headers 883 :group 'gnus-article-headers
903 :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist))) 884 :type '(repeat (cons :format "%v" (symbol :tag "Image type") plist)))
@@ -1420,14 +1401,12 @@ predicate. See Info node `(gnus)Customizing Articles'."
1420(defcustom gnus-treat-display-x-face 1401(defcustom gnus-treat-display-x-face
1421 (and (not noninteractive) 1402 (and (not noninteractive)
1422 (gnus-image-type-available-p 'xbm) 1403 (gnus-image-type-available-p 'xbm)
1423 (if (featurep 'xemacs) 1404 (condition-case nil
1424 (featurep 'xface) 1405 (and (string-match "^0x" (shell-command-to-string "uncompface"))
1425 (condition-case nil 1406 (executable-find "icontopbm"))
1426 (and (string-match "^0x" (shell-command-to-string "uncompface")) 1407 ;; shell-command-to-string may signal an error, e.g. if
1427 (executable-find "icontopbm")) 1408 ;; shell-file-name is not found.
1428 ;; shell-command-to-string may signal an error, e.g. if 1409 (error nil))
1429 ;; shell-file-name is not found.
1430 (error nil)))
1431 'head) 1410 'head)
1432 "Display X-Face headers. 1411 "Display X-Face headers.
1433Valid values are nil and `head'. 1412Valid values are nil and `head'.
@@ -2111,21 +2090,17 @@ try this wash."
2111 "Translate many Unicode characters into their ASCII equivalents." 2090 "Translate many Unicode characters into their ASCII equivalents."
2112 (interactive) 2091 (interactive)
2113 (require 'org-entities) 2092 (require 'org-entities)
2114 (let ((table (make-char-table (if (featurep 'xemacs) 'generic)))) 2093 (let ((table (make-char-table nil)))
2115 (dolist (elem org-entities) 2094 (dolist (elem org-entities)
2116 (when (and (listp elem) 2095 (when (and (listp elem)
2117 (= (length (nth 6 elem)) 1)) 2096 (= (length (nth 6 elem)) 1))
2118 (if (featurep 'xemacs) 2097 (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem))))
2119 (put-char-table (aref (nth 6 elem) 0) (nth 4 elem) table)
2120 (set-char-table-range table (aref (nth 6 elem) 0) (nth 4 elem)))))
2121 (save-excursion 2098 (save-excursion
2122 (when (article-goto-body) 2099 (when (article-goto-body)
2123 (let ((inhibit-read-only t) 2100 (let ((inhibit-read-only t)
2124 replace props) 2101 replace props)
2125 (while (not (eobp)) 2102 (while (not (eobp))
2126 (if (not (setq replace (if (featurep 'xemacs) 2103 (if (not (setq replace (aref table (following-char))))
2127 (get-char-table (following-char) table)
2128 (aref table (following-char)))))
2129 (forward-char 1) 2104 (forward-char 1)
2130 (if (prog1 2105 (if (prog1
2131 (setq props (text-properties-at (point))) 2106 (setq props (text-properties-at (point)))
@@ -2323,8 +2298,6 @@ long lines if and only if arg is positive."
2323 (insert "X-Boundary: ") 2298 (insert "X-Boundary: ")
2324 (gnus-add-text-properties start (point) gnus-hidden-properties) 2299 (gnus-add-text-properties start (point) gnus-hidden-properties)
2325 (insert (let (str (max (window-width))) 2300 (insert (let (str (max (window-width)))
2326 (if (featurep 'xemacs)
2327 (setq max (1- max)))
2328 (while (>= max (length str)) 2301 (while (>= max (length str))
2329 (setq str (concat str gnus-body-boundary-delimiter))) 2302 (setq str (concat str gnus-body-boundary-delimiter)))
2330 (substring str 0 max)) 2303 (substring str 0 max))
@@ -4320,8 +4293,6 @@ If variable `gnus-use-long-file-name' is non-nil, it is
4320 (put-text-property (match-end 0) (point-max) 4293 (put-text-property (match-end 0) (point-max)
4321 'face eface))))))))) 4294 'face eface)))))))))
4322 4295
4323(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs.
4324
4325(defun article-verify-cancel-lock () 4296(defun article-verify-cancel-lock ()
4326 "Verify Cancel-Lock header." 4297 "Verify Cancel-Lock header."
4327 (interactive) 4298 (interactive)
@@ -4434,13 +4405,9 @@ If variable `gnus-use-long-file-name' is non-nil, it is
4434 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) 4405 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
4435 4406
4436(defvar gnus-article-send-map) 4407(defvar gnus-article-send-map)
4437
4438(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map) 4408(gnus-define-keys (gnus-article-send-map "S" gnus-article-mode-map)
4439 "W" gnus-article-wide-reply-with-original) 4409 "W" gnus-article-wide-reply-with-original
4440(if (featurep 'xemacs) 4410 [t] 'gnus-article-read-summary-send-keys)
4441 (set-keymap-default-binding gnus-article-send-map
4442 'gnus-article-read-summary-send-keys)
4443 (define-key gnus-article-send-map [t] 'gnus-article-read-summary-send-keys))
4444 4411
4445(defun gnus-article-make-menu-bar () 4412(defun gnus-article-make-menu-bar ()
4446 (unless (boundp 'gnus-article-commands-menu) 4413 (unless (boundp 'gnus-article-commands-menu)
@@ -5903,10 +5870,6 @@ all parts."
5903 :button-keymap gnus-mime-button-map 5870 :button-keymap gnus-mime-button-map
5904 :help-echo 5871 :help-echo
5905 (lambda (widget) 5872 (lambda (widget)
5906 ;; Needed to properly clear the message due to a bug in
5907 ;; wid-edit (XEmacs only).
5908 (if (boundp 'help-echo-owns-message)
5909 (setq help-echo-owns-message t))
5910 (format 5873 (format
5911 "%S: %s the MIME part; %S: more options" 5874 "%S: %s the MIME part; %S: more options"
5912 'mouse-2 5875 'mouse-2
@@ -6604,12 +6567,10 @@ If given a numerical ARG, move forward ARG pages."
6604If end of article, return non-nil. Otherwise return nil. 6567If end of article, return non-nil. Otherwise return nil.
6605Argument LINES specifies lines to be scrolled up." 6568Argument LINES specifies lines to be scrolled up."
6606 (interactive "p") 6569 (interactive "p")
6607 (move-to-window-line (if (featurep 'xemacs) -1 (- -1 scroll-margin))) 6570 (move-to-window-line (- -1 scroll-margin))
6608 (if (and (not (and gnus-article-over-scroll 6571 (if (and (not (and gnus-article-over-scroll
6609 (> (count-lines (window-start) (point-max)) 6572 (> (count-lines (window-start) (point-max))
6610 (if (featurep 'xemacs) 6573 (+ (or lines (1- (window-height))) scroll-margin))))
6611 (or lines (1- (window-height)))
6612 (+ (or lines (1- (window-height))) scroll-margin)))))
6613 (save-excursion 6574 (save-excursion
6614 (end-of-line) 6575 (end-of-line)
6615 (and (pos-visible-in-window-p) ;Not continuation line. 6576 (and (pos-visible-in-window-p) ;Not continuation line.
@@ -6635,18 +6596,16 @@ Argument LINES specifies lines to be scrolled up."
6635 "Move point to the beginning of the window. 6596 "Move point to the beginning of the window.
6636In Emacs, the point is placed at the line number which `scroll-margin' 6597In Emacs, the point is placed at the line number which `scroll-margin'
6637specifies." 6598specifies."
6638 (if (featurep 'xemacs) 6599 ;; There is an obscure bug in Emacs that makes it impossible to
6639 (move-to-window-line 0) 6600 ;; scroll past big pictures in the article buffer. Try to fix
6640 ;; There is an obscure bug in Emacs that makes it impossible to 6601 ;; this by adding a sanity check by counting the lines visible.
6641 ;; scroll past big pictures in the article buffer. Try to fix 6602 (when (> (count-lines (window-start) (window-end)) 30)
6642 ;; this by adding a sanity check by counting the lines visible. 6603 (move-to-window-line
6643 (when (> (count-lines (window-start) (window-end)) 30) 6604 (min (max 0 scroll-margin)
6644 (move-to-window-line 6605 (max 1 (- (window-height)
6645 (min (max 0 scroll-margin) 6606 (if mode-line-format 1 0)
6646 (max 1 (- (window-height) 6607 (if header-line-format 1 0)
6647 (if mode-line-format 1 0) 6608 2))))))
6648 (if header-line-format 1 0)
6649 2)))))))
6650 6609
6651(defvar scroll-in-place) 6610(defvar scroll-in-place)
6652 6611
@@ -6673,10 +6632,7 @@ Argument LINES specifies lines to be scrolled down."
6673 (goto-char (point-max)) 6632 (goto-char (point-max))
6674 (recenter (if gnus-article-over-scroll 6633 (recenter (if gnus-article-over-scroll
6675 (if lines 6634 (if lines
6676 (max (if (featurep 'xemacs) 6635 (max (+ lines scroll-margin) 3)
6677 lines
6678 (+ lines scroll-margin))
6679 3)
6680 (- (window-height) 2)) 6636 (- (window-height) 2))
6681 -1))) 6637 -1)))
6682 (prog1 6638 (prog1
@@ -6757,9 +6713,7 @@ not have a face in `gnus-article-boring-faces'."
6757 (let (gnus-pick-mode) 6713 (let (gnus-pick-mode)
6758 (setq unread-command-events (nconc unread-command-events 6714 (setq unread-command-events (nconc unread-command-events
6759 (list (or key last-command-event))) 6715 (list (or key last-command-event)))
6760 keys (if (featurep 'xemacs) 6716 keys (read-key-sequence nil t))))
6761 (events-to-keys (read-key-sequence nil t))
6762 (read-key-sequence nil t)))))
6763 6717
6764 (message "") 6718 (message "")
6765 6719
@@ -6873,14 +6827,12 @@ KEY is a string or a vector."
6873 gnus-article-read-summary-send-keys)) 6827 gnus-article-read-summary-send-keys))
6874 (with-current-buffer gnus-article-current-summary 6828 (with-current-buffer gnus-article-current-summary
6875 (setq unread-command-events 6829 (setq unread-command-events
6876 (if (featurep 'xemacs) 6830 (nconc
6877 (append key unread-command-events) 6831 (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
6878 (nconc 6832 (list 'meta (- x 128))
6879 (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) 6833 x))
6880 (list 'meta (- x 128)) 6834 key)
6881 x)) 6835 unread-command-events))
6882 key)
6883 unread-command-events)))
6884 (let ((cursor-in-echo-area t) 6836 (let ((cursor-in-echo-area t)
6885 gnus-pick-mode) 6837 gnus-pick-mode)
6886 (describe-key (read-key-sequence nil t)))) 6838 (describe-key (read-key-sequence nil t))))
@@ -6897,14 +6849,12 @@ KEY is a string or a vector."
6897 gnus-article-read-summary-send-keys)) 6849 gnus-article-read-summary-send-keys))
6898 (with-current-buffer gnus-article-current-summary 6850 (with-current-buffer gnus-article-current-summary
6899 (setq unread-command-events 6851 (setq unread-command-events
6900 (if (featurep 'xemacs) 6852 (nconc
6901 (append key unread-command-events) 6853 (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
6902 (nconc 6854 (list 'meta (- x 128))
6903 (mapcar (lambda (x) (if (and (integerp x) (>= x 128)) 6855 x))
6904 (list 'meta (- x 128)) 6856 key)
6905 x)) 6857 unread-command-events))
6906 key)
6907 unread-command-events)))
6908 (let ((cursor-in-echo-area t) 6858 (let ((cursor-in-echo-area t)
6909 gnus-pick-mode) 6859 gnus-pick-mode)
6910 (describe-key-briefly (read-key-sequence nil t) insert))) 6860 (describe-key-briefly (read-key-sequence nil t) insert)))
@@ -8962,10 +8912,6 @@ For example:
8962 :button-keymap gnus-mime-security-button-map 8912 :button-keymap gnus-mime-security-button-map
8963 :help-echo 8913 :help-echo
8964 (lambda (_widget) 8914 (lambda (_widget)
8965 ;; Needed to properly clear the message due to a bug in
8966 ;; wid-edit (XEmacs only).
8967 (when (boundp 'help-echo-owns-message)
8968 (setq help-echo-owns-message t))
8969 (format 8915 (format
8970 "%S: show detail; %S: more options" 8916 "%S: show detail; %S: more options"
8971 'mouse-2 8917 'mouse-2
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index a1408259ec5..ba72d820431 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -148,18 +148,13 @@ that was fetched."
148 (with-current-buffer gnus-summary-buffer 148 (with-current-buffer gnus-summary-buffer
149 (let ((next (caadr (gnus-data-find-list article)))) 149 (let ((next (caadr (gnus-data-find-list article))))
150 (when next 150 (when next
151 (if (not (fboundp 'run-with-idle-timer)) 151 (when gnus-async-timer
152 ;; This is either an older Emacs or XEmacs, so we 152 (ignore-errors
153 ;; do this, which leads to slightly slower article 153 (nnheader-cancel-timer 'gnus-async-timer)))
154 ;; buffer display. 154 (setq gnus-async-timer
155 (gnus-async-prefetch-article group next summary) 155 (run-with-idle-timer
156 (when gnus-async-timer 156 0.1 nil 'gnus-async-prefetch-article
157 (ignore-errors 157 group next summary)))))))
158 (nnheader-cancel-timer 'gnus-async-timer)))
159 (setq gnus-async-timer
160 (run-with-idle-timer
161 0.1 nil 'gnus-async-prefetch-article
162 group next summary))))))))
163 158
164(defun gnus-async-prefetch-article (group article summary &optional next) 159(defun gnus-async-prefetch-article (group article summary &optional next)
165 "Possibly prefetch several articles starting with ARTICLE." 160 "Possibly prefetch several articles starting with ARTICLE."