Mercurial > emacs
annotate lisp/gnus/gnus-ems.el @ 111198:898ddb0c960d
* lisp/term/ns-win.el: Restore require of cl when compiling.
(menu-bar-final-items): Remove non-existent `windows' menu.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Tue, 26 Oct 2010 20:48:28 -0700 |
parents | 0defef1647a5 |
children | d66d04803828 |
rev | line source |
---|---|
17493 | 1 ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
2 |
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, |
106815 | 4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 7 ;; Keywords: news |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17493 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
17493 | 15 |
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. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17493 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;;; Code: | |
27 | |
33814 | 28 (eval-when-compile |
29 (require 'cl) | |
30 (require 'ring)) | |
17493 | 31 |
32 ;;; Function aliases later to be redefined for XEmacs usage. | |
33 | |
34 (defvar gnus-mouse-2 [mouse-2]) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
35 (defvar gnus-down-mouse-3 [down-mouse-3]) |
17493 | 36 (defvar gnus-down-mouse-2 [down-mouse-2]) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
37 (defvar gnus-widget-button-keymap nil) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
38 (defvar gnus-mode-line-modified |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
39 (if (featurep 'xemacs) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
40 '("--**-" . "-----") |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
41 '("**" "--"))) |
17493 | 42 |
43 (eval-and-compile | |
44 (autoload 'gnus-xmas-define "gnus-xmas") | |
95818
b8775d45a9ea
(gnus-x-splash): Check tool-bar-mode is bound.
Glenn Morris <rgm@gnu.org>
parents:
94662
diff
changeset
|
45 (autoload 'gnus-xmas-redefine "gnus-xmas")) |
17493 | 46 |
95818
b8775d45a9ea
(gnus-x-splash): Check tool-bar-mode is bound.
Glenn Morris <rgm@gnu.org>
parents:
94662
diff
changeset
|
47 (autoload 'gnus-get-buffer-create "gnus") |
b8775d45a9ea
(gnus-x-splash): Check tool-bar-mode is bound.
Glenn Morris <rgm@gnu.org>
parents:
94662
diff
changeset
|
48 (autoload 'nnheader-find-etc-directory "nnheader") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
49 (autoload 'smiley-region "smiley") |
32920
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
50 |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
51 (defun gnus-kill-all-overlays () |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
52 "Delete all overlays in the current buffer." |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
53 (let* ((overlayss (overlay-lists)) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
54 (buffer-read-only nil) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
55 (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
56 (while overlays |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
57 (delete-overlay (pop overlays))))) |
31780
d2b5643aab16
(gnus-smiley-display): Autoload from smiley-ems.
Dave Love <fx@gnu.org>
parents:
31767
diff
changeset
|
58 |
17493 | 59 ;;; Mule functions. |
60 | |
61 (defun gnus-mule-max-width-function (el max-width) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
62 `(let* ((val (eval (, el))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
63 (valstr (if (numberp val) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
64 (int-to-string val) val))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
65 (if (> (length valstr) ,max-width) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
66 (truncate-string-to-width valstr ,max-width) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
67 valstr))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
68 |
17493 | 69 (eval-and-compile |
32920
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
70 (if (featurep 'xemacs) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
71 (gnus-xmas-define) |
17493 | 72 (defvar gnus-mouse-face-prop 'mouse-face |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
73 "Property used for highlighting mouse regions."))) |
17493 | 74 |
86154 | 75 (defvar gnus-tmp-unread) |
76 (defvar gnus-tmp-replied) | |
77 (defvar gnus-tmp-score-char) | |
78 (defvar gnus-tmp-indentation) | |
79 (defvar gnus-tmp-opening-bracket) | |
80 (defvar gnus-tmp-lines) | |
81 (defvar gnus-tmp-name) | |
82 (defvar gnus-tmp-closing-bracket) | |
83 (defvar gnus-tmp-subject-or-nil) | |
84 (defvar gnus-check-before-posting) | |
85 (defvar gnus-mouse-face) | |
86 (defvar gnus-group-buffer) | |
17493 | 87 |
88 (defun gnus-ems-redefine () | |
89 (cond | |
32939
c8119677d63e
Use (featurep 'xemacs) instead of the `gnus-xemacs' variable, as the
Miles Bader <miles@gnu.org>
parents:
32920
diff
changeset
|
90 ((featurep 'xemacs) |
17493 | 91 (gnus-xmas-redefine)) |
92 | |
93 ((featurep 'mule) | |
94 ;; Mule and new Emacs definitions | |
95 | |
96 ;; [Note] Now there are three kinds of mule implementations, | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
97 ;; original MULE, XEmacs/mule and Emacs 20+ including |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
98 ;; MULE features. Unfortunately these APIs are different. In |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
99 ;; particular, Emacs (including original Mule) and XEmacs are |
44532
b94ae378e07c
(gnus-ems-redefine): Fix typo in comment.
Juanma Barranquero <lekktu@gmail.com>
parents:
39483
diff
changeset
|
100 ;; quite different. However, this version of Gnus doesn't support |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
101 ;; anything other than XEmacs 20+ and Emacs 20.3+. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
102 |
17493 | 103 ;; Predicates to check are following: |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
104 ;; (boundp 'MULE) is t only if Mule (original; anything older than |
17493 | 105 ;; Mule 2.3) is running. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
106 ;; (featurep 'mule) is t when other mule variants are running. |
17493 | 107 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
108 ;; It is possible to detect XEmacs/mule by (featurep 'mule) and |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
109 ;; (featurep 'xemacs). In this case, the implementation for |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
110 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. |
17493 | 111 |
112 (defvar gnus-summary-display-table nil | |
113 "Display table used in summary mode buffers.") | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
114 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) |
17493 | 115 |
116 (when (boundp 'gnus-check-before-posting) | |
117 (setq gnus-check-before-posting | |
118 (delq 'long-lines | |
119 (delq 'control-chars gnus-check-before-posting)))) | |
120 | |
121 (defun gnus-summary-line-format-spec () | |
122 (insert gnus-tmp-unread gnus-tmp-replied | |
123 gnus-tmp-score-char gnus-tmp-indentation) | |
124 (put-text-property | |
125 (point) | |
126 (progn | |
127 (insert | |
128 gnus-tmp-opening-bracket | |
129 (format "%4d: %-20s" | |
130 gnus-tmp-lines | |
131 (if (> (length gnus-tmp-name) 20) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
132 (truncate-string-to-width gnus-tmp-name 20) |
17493 | 133 gnus-tmp-name)) |
134 gnus-tmp-closing-bracket) | |
135 (point)) | |
136 gnus-mouse-face-prop gnus-mouse-face) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
137 (insert " " gnus-tmp-subject-or-nil "\n"))))) |
17493 | 138 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
139 ;; Clone of `appt-select-lowest-window' in appt.el. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
140 (defun gnus-select-lowest-window () |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
141 "Select the lowest window on the frame." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
142 (let ((lowest-window (selected-window)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
143 (bottom-edge (nth 3 (window-edges)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
144 (walk-windows (lambda (w) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
145 (let ((next-bottom-edge (nth 3 (window-edges w)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
146 (when (< bottom-edge next-bottom-edge) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
147 (setq bottom-edge next-bottom-edge |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
148 lowest-window w))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
149 (select-window lowest-window))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
150 |
17493 | 151 (defun gnus-region-active-p () |
152 "Say whether the region is active." | |
153 (and (boundp 'transient-mark-mode) | |
154 transient-mark-mode | |
155 (boundp 'mark-active) | |
156 mark-active)) | |
157 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
158 (defun gnus-mark-active-p () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
159 "Non-nil means the mark and region are currently active in this buffer." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
160 mark-active) ; aliased to region-exists-p in XEmacs. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
161 |
87252 | 162 (autoload 'gnus-alive-p "gnus-util") |
93755
851c4b94b564
(mm-disable-multibyte): Autoload it.
Glenn Morris <rgm@gnu.org>
parents:
93725
diff
changeset
|
163 (autoload 'mm-disable-multibyte "mm-util") |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
164 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
165 (defun gnus-x-splash () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
166 "Show a splash screen using a pixmap in the current buffer." |
78006 | 167 (interactive) |
168 (unless window-system | |
169 (error "`gnus-x-splash' requires running on the window system")) | |
170 (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) | |
171 (interactive-p)) | |
172 "*gnus-x-splash*" | |
173 gnus-group-buffer))) | |
78546 | 174 (let ((inhibit-read-only t) |
78006 | 175 (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) |
176 pixmap fcw fch width height fringes sbars left yoffset top ls) | |
177 (erase-buffer) | |
78013 | 178 (sit-for 0) ;; Necessary for measuring the window size correctly. |
78006 | 179 (when (and file |
180 (ignore-errors | |
93725
2ca2b5f1a567
(gnus-x-splash): Avoid binding default-enable-multibyte-characters.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
181 (let ((coding-system-for-read 'raw-text)) |
78006 | 182 (with-temp-buffer |
93725
2ca2b5f1a567
(gnus-x-splash): Avoid binding default-enable-multibyte-characters.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
183 (mm-disable-multibyte) |
78006 | 184 (insert-file-contents file) |
185 (goto-char (point-min)) | |
186 (setq pixmap (read (current-buffer))))))) | |
187 (setq fcw (float (frame-char-width)) | |
188 fch (float (frame-char-height)) | |
189 width (/ (car pixmap) fcw) | |
190 height (/ (cadr pixmap) fch) | |
191 fringes (if (fboundp 'window-fringes) | |
192 (eval '(window-fringes)) | |
193 '(10 11 nil)) | |
194 sbars (frame-parameter nil 'vertical-scroll-bars)) | |
195 (cond ((eq sbars 'right) | |
196 (setq sbars | |
197 (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14) | |
198 fcw)))) | |
199 (sbars | |
200 (setq sbars | |
201 (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) | |
202 fcw) | |
79313 | 203 0))) |
204 (t | |
205 (setq sbars '(0 . 0)))) | |
78006 | 206 (setq left (- (* (round (/ (1- (/ (+ (window-width) |
207 (car sbars) (cdr sbars) | |
208 (/ (+ (or (car fringes) 0) | |
209 (or (cadr fringes) 0)) | |
210 fcw)) | |
211 width)) | |
212 2)) | |
213 width) | |
214 (car sbars) | |
215 (/ (or (car fringes) 0) fcw)) | |
216 yoffset (cadr (window-edges)) | |
95818
b8775d45a9ea
(gnus-x-splash): Check tool-bar-mode is bound.
Glenn Morris <rgm@gnu.org>
parents:
94662
diff
changeset
|
217 top (max 0 (- (* (max (if (and (boundp 'tool-bar-mode) |
b8775d45a9ea
(gnus-x-splash): Check tool-bar-mode is bound.
Glenn Morris <rgm@gnu.org>
parents:
94662
diff
changeset
|
218 tool-bar-mode |
78006 | 219 (not (featurep 'gtk)) |
220 (eq (frame-first-window) | |
221 (selected-window))) | |
222 1 0) | |
223 (round (/ (1- (/ (+ (1- (window-height)) | |
224 (* 2 yoffset)) | |
225 height)) | |
226 2))) | |
227 height) | |
228 yoffset)) | |
229 ls (/ (or line-spacing 0) fch) | |
230 height (max 0 (- height ls))) | |
231 (cond ((>= (- top ls) 1) | |
232 (insert | |
233 (propertize | |
234 " " | |
235 'display `(space :width 0 :ascent 100)) | |
236 "\n" | |
237 (propertize | |
238 " " | |
239 'display `(space :width 0 :height ,(- top ls 1) :ascent 100)) | |
240 "\n")) | |
241 ((> (- top ls) 0) | |
242 (insert | |
243 (propertize | |
244 " " | |
245 'display `(space :width 0 :height ,(- top ls) :ascent 100)) | |
246 "\n"))) | |
247 (if (and (> width 0) (> left 0)) | |
248 (insert (propertize | |
249 " " | |
250 'display `(space :width ,left :height ,height :ascent 0))) | |
251 (setq width (+ width left))) | |
252 (when (> width 0) | |
253 (insert (propertize | |
254 " " | |
255 'display `(space :width ,width :height ,height :ascent 0) | |
256 'face `(gnus-splash :stipple ,pixmap)))) | |
257 (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min))) | |
258 (redraw-frame (selected-frame)) | |
259 (sit-for 0)))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
260 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
261 ;;; Image functions. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
262 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
263 (defun gnus-image-type-available-p (type) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
264 (and (fboundp 'image-type-available-p) |
74984 | 265 (image-type-available-p type) |
266 (if (fboundp 'display-images-p) | |
267 (display-images-p) | |
268 t))) | |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
269 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
270 (defun gnus-create-image (file &optional type data-p &rest props) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
271 (let ((face (plist-get props :face))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
272 (when face |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
273 (setq props (plist-put props :foreground (face-foreground face))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
274 (setq props (plist-put props :background (face-background face)))) |
110596
415e87a42437
mail-source.el (mail-source-value): Revert previous patch.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110566
diff
changeset
|
275 (ignore-errors |
415e87a42437
mail-source.el (mail-source-value): Revert previous patch.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110566
diff
changeset
|
276 (apply 'create-image file type data-p props)))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
277 |
110054
fe1595694e7e
Fix previous merge from Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110041
diff
changeset
|
278 (defun gnus-put-image (glyph &optional string category) |
fe1595694e7e
Fix previous merge from Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110041
diff
changeset
|
279 (let ((point (point))) |
110634
05430cec48ff
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110596
diff
changeset
|
280 (insert-image glyph (or string "*")) |
110054
fe1595694e7e
Fix previous merge from Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110041
diff
changeset
|
281 (put-text-property point (point) 'gnus-image-category category) |
fe1595694e7e
Fix previous merge from Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110041
diff
changeset
|
282 (unless string |
fe1595694e7e
Fix previous merge from Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110041
diff
changeset
|
283 (put-text-property (1- (point)) (point) |
fe1595694e7e
Fix previous merge from Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110041
diff
changeset
|
284 'gnus-image-text-deletable t)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
285 glyph)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
286 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
287 (defun gnus-remove-image (image &optional category) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
288 "Remove the image matching IMAGE and CATEGORY found first." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
289 (let ((start (point-min)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
290 val end) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
291 (while (and (not end) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
292 (or (setq val (get-text-property start 'display)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
293 (and (setq start |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
294 (next-single-property-change start 'display)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
295 (setq val (get-text-property start 'display))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
296 (setq end (or (next-single-property-change start 'display) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
297 (point-max))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
298 (if (and (equal val image) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
299 (equal (get-text-property start 'gnus-image-category) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
300 category)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
301 (progn |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
302 (put-text-property start end 'display nil) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
303 (when (get-text-property start 'gnus-image-text-deletable) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
304 (delete-region start end))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
305 (unless (= end (point-max)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
306 (setq start end |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
307 end nil)))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
308 |
110082
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
309 (eval-and-compile |
110747
0defef1647a5
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110634
diff
changeset
|
310 ;; XEmacs does not have window-inside-pixel-edges |
0defef1647a5
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110634
diff
changeset
|
311 (defalias 'gnus-window-inside-pixel-edges |
0defef1647a5
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110634
diff
changeset
|
312 (if (fboundp 'window-inside-pixel-edges) |
0defef1647a5
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110634
diff
changeset
|
313 'window-inside-pixel-edges |
0defef1647a5
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110634
diff
changeset
|
314 'window-pixel-edges)) |
0defef1647a5
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110634
diff
changeset
|
315 |
110082
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
316 (if (fboundp 'set-process-plist) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
317 (progn |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
318 (defalias 'gnus-set-process-plist 'set-process-plist) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
319 (defalias 'gnus-process-plist 'process-plist) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
320 (defalias 'gnus-process-get 'process-get) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
321 (defalias 'gnus-process-put 'process-put)) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
322 (defun gnus-set-process-plist (process plist) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
323 "Replace the plist of PROCESS with PLIST. Returns PLIST." |
110157
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
324 (put 'gnus-process-plist-internal process plist)) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
325 |
110082
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
326 (defun gnus-process-plist (process) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
327 "Return the plist of PROCESS." |
110157
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
328 ;; This form works but can't prevent the plist data from |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
329 ;; growing infinitely. |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
330 ;;(get 'gnus-process-plist-internal process) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
331 (let* ((plist (symbol-plist 'gnus-process-plist-internal)) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
332 (tem (memq process plist))) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
333 (prog1 |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
334 (cadr tem) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
335 ;; Remove it from the plist data. |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
336 (when tem |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
337 (if (eq plist tem) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
338 (progn |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
339 (setcar plist (caddr plist)) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
340 (setcdr plist (or (cdddr plist) '(nil)))) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
341 (setcdr (nthcdr (- (length plist) (length tem) 1) plist) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
342 (cddr tem))))))) |
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
343 |
110082
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
344 (defun gnus-process-get (process propname) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
345 "Return the value of PROCESS' PROPNAME property. |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
346 This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
347 (plist-get (gnus-process-plist process) propname)) |
110157
969b41083104
gnus-ems.el: Make process-plist functions work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
348 |
110082
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
349 (defun gnus-process-put (process propname value) |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
350 "Change PROCESS' PROPNAME property to VALUE. |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
351 It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." |
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
352 (gnus-set-process-plist process |
110085
fc3e98cf87b7
gnus-process-put: Fix previous commit.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110082
diff
changeset
|
353 (plist-put (gnus-process-plist process) |
110082
0bc890984083
Add compatibility functions gnus-process-get and gnus-process-put for Emacs 21 and XEmacs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110073
diff
changeset
|
354 propname value))))) |
110073
38805092633e
gnus-ems.el: Provide compatibility functions for gnus-set-process-plist by Katsumi Yamaoka <yamaoka@jpl.org>; gnus-html.el: Use gnus-process-plist and friends for compatibility; gnus-cite.el: New function to guess whether a long line is natural text or not; message.el: Implement message-prune-recipient-rules; by Lars Magne Ingebrigtsen <larsi@gnus.org>.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110068
diff
changeset
|
355 |
17493 | 356 (provide 'gnus-ems) |
357 | |
358 ;;; gnus-ems.el ends here |