Mercurial > emacs
annotate lisp/gnus/gnus-ems.el @ 86707:b04450e522e3
Move to etc/nxml
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 28 Nov 2007 05:07:03 +0000 |
parents | 1cdfc94602cb |
children | a48038ce7d61 53108e6cea98 |
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, |
75347 | 4 ;; 2004, 2005, 2006, 2007 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 | |
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 | |
78224
24202b793a08
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
78013
diff
changeset
|
13 ;; the Free Software Foundation; either version 3, or (at your option) |
17493 | 14 ;; any later version. |
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 | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
17493 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;;; Code: | |
29 | |
33814 | 30 (eval-when-compile |
31 (require 'cl) | |
32 (require 'ring)) | |
17493 | 33 |
34 ;;; Function aliases later to be redefined for XEmacs usage. | |
35 | |
36 (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
|
37 (defvar gnus-down-mouse-3 [down-mouse-3]) |
17493 | 38 (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
|
39 (defvar gnus-widget-button-keymap nil) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
40 (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
|
41 (if (featurep 'xemacs) |
19969
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
42 '("--**-" . "-----") |
5f1ab3dd344d
*** empty log message ***
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
17493
diff
changeset
|
43 '("**" "--"))) |
17493 | 44 |
45 (eval-and-compile | |
46 (autoload 'gnus-xmas-define "gnus-xmas") | |
47 (autoload 'gnus-xmas-redefine "gnus-xmas") | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
48 (autoload 'gnus-get-buffer-create "gnus") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
49 (autoload 'nnheader-find-etc-directory "nnheader")) |
17493 | 50 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
51 (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
|
52 |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
53 (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
|
54 "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
|
55 (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
|
56 (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
|
57 (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
|
58 (while overlays |
5b203c66fa7b
2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
Dave Love <fx@gnu.org>
parents:
32139
diff
changeset
|
59 (delete-overlay (pop overlays))))) |
31780
d2b5643aab16
(gnus-smiley-display): Autoload from smiley-ems.
Dave Love <fx@gnu.org>
parents:
31767
diff
changeset
|
60 |
17493 | 61 ;;; Mule functions. |
62 | |
63 (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
|
64 `(let* ((val (eval (, el))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
65 (valstr (if (numberp val) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
66 (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
|
67 (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
|
68 (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
|
69 valstr))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
70 |
17493 | 71 (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
|
72 (if (featurep 'xemacs) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
73 (gnus-xmas-define) |
17493 | 74 (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
|
75 "Property used for highlighting mouse regions."))) |
17493 | 76 |
86154 | 77 (defvar gnus-tmp-unread) |
78 (defvar gnus-tmp-replied) | |
79 (defvar gnus-tmp-score-char) | |
80 (defvar gnus-tmp-indentation) | |
81 (defvar gnus-tmp-opening-bracket) | |
82 (defvar gnus-tmp-lines) | |
83 (defvar gnus-tmp-name) | |
84 (defvar gnus-tmp-closing-bracket) | |
85 (defvar gnus-tmp-subject-or-nil) | |
86 (defvar gnus-check-before-posting) | |
87 (defvar gnus-mouse-face) | |
88 (defvar gnus-group-buffer) | |
17493 | 89 |
90 (defun gnus-ems-redefine () | |
91 (cond | |
32939
c8119677d63e
Use (featurep 'xemacs) instead of the `gnus-xemacs' variable, as the
Miles Bader <miles@gnu.org>
parents:
32920
diff
changeset
|
92 ((featurep 'xemacs) |
17493 | 93 (gnus-xmas-redefine)) |
94 | |
95 ((featurep 'mule) | |
96 ;; Mule and new Emacs definitions | |
97 | |
98 ;; [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
|
99 ;; 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
|
100 ;; 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
|
101 ;; 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
|
102 ;; 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
|
103 ;; 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
|
104 |
17493 | 105 ;; 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
|
106 ;; (boundp 'MULE) is t only if Mule (original; anything older than |
17493 | 107 ;; 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
|
108 ;; (featurep 'mule) is t when other mule variants are running. |
17493 | 109 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
110 ;; 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
|
111 ;; (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
|
112 ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule. |
17493 | 113 |
114 (defvar gnus-summary-display-table nil | |
115 "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
|
116 (defalias 'gnus-max-width-function 'gnus-mule-max-width-function) |
17493 | 117 |
118 (when (boundp 'gnus-check-before-posting) | |
119 (setq gnus-check-before-posting | |
120 (delq 'long-lines | |
121 (delq 'control-chars gnus-check-before-posting)))) | |
122 | |
123 (defun gnus-summary-line-format-spec () | |
124 (insert gnus-tmp-unread gnus-tmp-replied | |
125 gnus-tmp-score-char gnus-tmp-indentation) | |
126 (put-text-property | |
127 (point) | |
128 (progn | |
129 (insert | |
130 gnus-tmp-opening-bracket | |
131 (format "%4d: %-20s" | |
132 gnus-tmp-lines | |
133 (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
|
134 (truncate-string-to-width gnus-tmp-name 20) |
17493 | 135 gnus-tmp-name)) |
136 gnus-tmp-closing-bracket) | |
137 (point)) | |
138 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
|
139 (insert " " gnus-tmp-subject-or-nil "\n"))))) |
17493 | 140 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
141 ;; 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
|
142 (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
|
143 "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
|
144 (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
|
145 (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
|
146 (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
|
147 (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
|
148 (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
|
149 (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
|
150 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
|
151 (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
|
152 |
17493 | 153 (defun gnus-region-active-p () |
154 "Say whether the region is active." | |
155 (and (boundp 'transient-mark-mode) | |
156 transient-mark-mode | |
157 (boundp 'mark-active) | |
158 mark-active)) | |
159 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
160 (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
|
161 "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
|
162 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
|
163 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
164 (defun gnus-x-splash () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
165 "Show a splash screen using a pixmap in the current buffer." |
78006 | 166 (interactive) |
167 (unless window-system | |
168 (error "`gnus-x-splash' requires running on the window system")) | |
169 (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p) | |
170 (interactive-p)) | |
171 "*gnus-x-splash*" | |
172 gnus-group-buffer))) | |
78546 | 173 (let ((inhibit-read-only t) |
78006 | 174 (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) |
175 pixmap fcw fch width height fringes sbars left yoffset top ls) | |
176 (erase-buffer) | |
78013 | 177 (sit-for 0) ;; Necessary for measuring the window size correctly. |
78006 | 178 (when (and file |
179 (ignore-errors | |
180 (let ((coding-system-for-read 'raw-text) | |
181 default-enable-multibyte-characters) | |
182 (with-temp-buffer | |
183 (insert-file-contents file) | |
184 (goto-char (point-min)) | |
185 (setq pixmap (read (current-buffer))))))) | |
186 (setq fcw (float (frame-char-width)) | |
187 fch (float (frame-char-height)) | |
188 width (/ (car pixmap) fcw) | |
189 height (/ (cadr pixmap) fch) | |
190 fringes (if (fboundp 'window-fringes) | |
191 (eval '(window-fringes)) | |
192 '(10 11 nil)) | |
193 sbars (frame-parameter nil 'vertical-scroll-bars)) | |
194 (cond ((eq sbars 'right) | |
195 (setq sbars | |
196 (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14) | |
197 fcw)))) | |
198 (sbars | |
199 (setq sbars | |
200 (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14) | |
201 fcw) | |
85888 | 202 0))) |
203 (t | |
204 (setq sbars '(0 . 0)))) | |
78006 | 205 (setq left (- (* (round (/ (1- (/ (+ (window-width) |
206 (car sbars) (cdr sbars) | |
207 (/ (+ (or (car fringes) 0) | |
208 (or (cadr fringes) 0)) | |
209 fcw)) | |
210 width)) | |
211 2)) | |
212 width) | |
213 (car sbars) | |
214 (/ (or (car fringes) 0) fcw)) | |
215 yoffset (cadr (window-edges)) | |
216 top (max 0 (- (* (max (if (and tool-bar-mode | |
217 (not (featurep 'gtk)) | |
218 (eq (frame-first-window) | |
219 (selected-window))) | |
220 1 0) | |
221 (round (/ (1- (/ (+ (1- (window-height)) | |
222 (* 2 yoffset)) | |
223 height)) | |
224 2))) | |
225 height) | |
226 yoffset)) | |
227 ls (/ (or line-spacing 0) fch) | |
228 height (max 0 (- height ls))) | |
229 (cond ((>= (- top ls) 1) | |
230 (insert | |
231 (propertize | |
232 " " | |
233 'display `(space :width 0 :ascent 100)) | |
234 "\n" | |
235 (propertize | |
236 " " | |
237 'display `(space :width 0 :height ,(- top ls 1) :ascent 100)) | |
238 "\n")) | |
239 ((> (- top ls) 0) | |
240 (insert | |
241 (propertize | |
242 " " | |
243 'display `(space :width 0 :height ,(- top ls) :ascent 100)) | |
244 "\n"))) | |
245 (if (and (> width 0) (> left 0)) | |
246 (insert (propertize | |
247 " " | |
248 'display `(space :width ,left :height ,height :ascent 0))) | |
249 (setq width (+ width left))) | |
250 (when (> width 0) | |
251 (insert (propertize | |
252 " " | |
253 'display `(space :width ,width :height ,height :ascent 0) | |
254 'face `(gnus-splash :stipple ,pixmap)))) | |
255 (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min))) | |
256 (redraw-frame (selected-frame)) | |
257 (sit-for 0)))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
258 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
259 ;;; Image functions. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
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 (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
|
262 (and (fboundp 'image-type-available-p) |
74984 | 263 (image-type-available-p type) |
264 (if (fboundp 'display-images-p) | |
265 (display-images-p) | |
266 t))) | |
32139
6d8322cfbf71
Don't turn off compiler warnings in local vars.
Dave Love <fx@gnu.org>
parents:
31802
diff
changeset
|
267 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
268 (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
|
269 (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
|
270 (when face |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
271 (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
|
272 (setq props (plist-put props :background (face-background face)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
273 (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
|
274 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
275 (defun gnus-put-image (glyph &optional string category) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
276 (let ((point (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
277 (insert-image glyph (or string " ")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
278 (put-text-property point (point) 'gnus-image-category category) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
279 (unless string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
280 (put-text-property (1- (point)) (point) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
281 'gnus-image-text-deletable t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
282 glyph)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
283 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
284 (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
|
285 "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
|
286 (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
|
287 val end) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
288 (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
|
289 (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
|
290 (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
|
291 (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
|
292 (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 (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
|
294 (point-max))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
295 (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
|
296 (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
|
297 category)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
298 (progn |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78546
diff
changeset
|
299 (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
|
300 (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
|
301 (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
|
302 (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
|
303 (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
|
304 end nil)))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
20118
diff
changeset
|
305 |
17493 | 306 (provide 'gnus-ems) |
307 | |
52401 | 308 ;;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb |
17493 | 309 ;;; gnus-ems.el ends here |