1 |
;;; gnus-art.el --- article mode commands for Gnus |
;;; gnus-art.el --- article mode commands for Gnus |
2 |
|
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 |
3 |
;; Copyright (C) 1996, 97, 98, 1999, 2000, 01, 02, 2004 |
;; Free Software Foundation, Inc. |
|
;; Free Software Foundation, Inc. |
|
4 |
|
|
5 |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
6 |
;; Keywords: news |
;; Keywords: news |
26 |
|
|
27 |
;;; Code: |
;;; Code: |
28 |
|
|
29 |
(eval-when-compile (require 'cl)) |
(eval-when-compile |
30 |
|
(require 'cl) |
31 |
|
(defvar tool-bar-map)) |
32 |
|
|
33 |
(require 'gnus) |
(require 'gnus) |
34 |
(require 'gnus-sum) |
(require 'gnus-sum) |
35 |
(require 'gnus-spec) |
(require 'gnus-spec) |
36 |
(require 'gnus-int) |
(require 'gnus-int) |
37 |
|
(require 'gnus-win) |
38 |
(require 'mm-bodies) |
(require 'mm-bodies) |
39 |
(require 'mail-parse) |
(require 'mail-parse) |
40 |
(require 'mm-decode) |
(require 'mm-decode) |
41 |
(require 'mm-view) |
(require 'mm-view) |
42 |
(require 'wid-edit) |
(require 'wid-edit) |
43 |
(require 'mm-uu) |
(require 'mm-uu) |
44 |
|
(require 'message) |
45 |
|
|
46 |
|
(autoload 'gnus-msg-mail "gnus-msg" nil t) |
47 |
|
(autoload 'gnus-button-mailto "gnus-msg") |
48 |
|
(autoload 'gnus-button-reply "gnus-msg" nil t) |
49 |
|
|
50 |
(defgroup gnus-article nil |
(defgroup gnus-article nil |
51 |
"Article display." |
"Article display." |
52 |
:link '(custom-manual "(gnus)The Article Buffer") |
:link '(custom-manual "(gnus)Article Buffer") |
53 |
:group 'gnus) |
:group 'gnus) |
54 |
|
|
55 |
(defgroup gnus-article-treat nil |
(defgroup gnus-article-treat nil |
109 |
:group 'gnus-article) |
:group 'gnus-article) |
110 |
|
|
111 |
(defcustom gnus-ignored-headers |
(defcustom gnus-ignored-headers |
112 |
'("^Path:" "^Expires:" "^Date-Received:" "^References:" "^Xref:" "^Lines:" |
(mapcar |
113 |
"^Relay-Version:" "^Message-ID:" "^Approved:" "^Sender:" "^Received:" |
(lambda (header) |
114 |
"^X-UIDL:" "^MIME-Version:" "^Return-Path:" "^In-Reply-To:" |
(concat "^" header ":")) |
115 |
"^Content-Type:" "^Content-Transfer-Encoding:" "^X-WebTV-Signature:" |
'("Path" "Expires" "Date-Received" "References" "Xref" "Lines" |
116 |
"^X-MimeOLE:" "^X-MSMail-Priority:" "^X-Priority:" "^X-Loop:" |
"Relay-Version" "Message-ID" "Approved" "Sender" "Received" |
117 |
"^X-Authentication-Warning:" "^X-MIME-Autoconverted:" "^X-Face:" |
"X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To" |
118 |
"^X-Attribution:" "^X-Originating-IP:" "^Delivered-To:" |
"Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature" |
119 |
"^NNTP-[-A-Za-z]+:" "^Distribution:" "^X-no-archive:" "^X-Trace:" |
"X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop" |
120 |
"^X-Complaints-To:" "^X-NNTP-Posting-Host:" "^X-Orig.*:" |
"X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face" |
121 |
"^Abuse-Reports-To:" "^Cache-Post-Path:" "^X-Article-Creation-Date:" |
"X-Attribution" "X-Originating-IP" "Delivered-To" |
122 |
"^X-Poster:" "^X-Mail2News-Path:" "^X-Server-Date:" "^X-Cache:" |
"NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace" |
123 |
"^Originator:" "^X-Problems-To:" "^X-Auth-User:" "^X-Post-Time:" |
"X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*" |
124 |
"^X-Admin:" "^X-UID:" "^Resent-[-A-Za-z]+:" "^X-Mailing-List:" |
"Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date" |
125 |
"^Precedence:" "^Original-[-A-Za-z]+:" "^X-filename:" "^X-Orcpt:" |
"X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache" |
126 |
"^Old-Received:" "^X-Pgp" "^X-Auth:" "^X-From-Line:" |
"Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time" |
127 |
"^X-Gnus-Article-Number:" "^X-Majordomo:" "^X-Url:" "^X-Sender:" |
"X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List" |
128 |
"^MBOX-Line" "^Priority:" "^X-Pgp" "^X400-[-A-Za-z]+:" |
"Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt" |
129 |
"^Status:" "^X-Gnus-Mail-Source:" "^Cancel-Lock:" |
"Old-Received" "X-Pgp" "X-Auth" "X-From-Line" |
130 |
"^X-FTN" "^X-EXP32-SerialNo:" "^Encoding:" "^Importance:" |
"X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender" |
131 |
"^Autoforwarded:" "^Original-Encoded-Information-Types:" "^X-Ya-Pop3:" |
"MBOX-Line" "Priority" "X400-[-A-Za-z]+" |
132 |
"^X-Face-Version:" "^X-Vms-To:" "^X-ML-NAME:" "^X-ML-COUNT:" |
"Status" "X-Gnus-Mail-Source" "Cancel-Lock" |
133 |
"^Mailing-List:" "^X-finfo:" "^X-md5sum:" "^X-md5sum-Origin:" |
"X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance" |
134 |
"^X-Sun-Charset:" "^X-Accept-Language:" "^X-Envelope-Sender:" |
"Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3" |
135 |
"^List-[A-Za-z]+:" "^X-Listprocessor-Version:" |
"X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT" |
136 |
"^X-Received:" "^X-Distribute:" "^X-Sequence:" "^X-Juno-Line-Breaks:" |
"Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin" |
137 |
"^X-Notes-Item:" "^X-MS-TNEF-Correlator:" "^x-uunet-gateway:" |
"X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender" |
138 |
"^X-Received:" "^Content-length:" "X-precedence:") |
"List-[A-Za-z]+" "X-Listprocessor-Version" |
139 |
|
"X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks" |
140 |
|
"X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway" |
141 |
|
"X-Received" "Content-length" "X-precedence" |
142 |
|
"X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info" |
143 |
|
"X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup" |
144 |
|
"X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To" |
145 |
|
"X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post" |
146 |
|
"List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive" |
147 |
|
"X-Content-length" "X-Posting-Agent" "Original-Received" |
148 |
|
"X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom" |
149 |
|
"X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway" |
150 |
|
"X-Local-Origin" "X-Local-Destination" "X-UserInfo1" |
151 |
|
"X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications" |
152 |
|
"X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer")) |
153 |
"*All headers that start with this regexp will be hidden. |
"*All headers that start with this regexp will be hidden. |
154 |
This variable can also be a list of regexps of headers to be ignored. |
This variable can also be a list of regexps of headers to be ignored. |
155 |
If `gnus-visible-headers' is non-nil, this variable will be ignored." |
If `gnus-visible-headers' is non-nil, this variable will be ignored." |
159 |
:group 'gnus-article-hiding) |
:group 'gnus-article-hiding) |
160 |
|
|
161 |
(defcustom gnus-visible-headers |
(defcustom gnus-visible-headers |
162 |
"^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" |
"^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:" |
163 |
"*All headers that do not match this regexp will be hidden. |
"*All headers that do not match this regexp will be hidden. |
164 |
This variable can also be a list of regexp of headers to remain visible. |
This variable can also be a list of regexp of headers to remain visible. |
165 |
If this variable is non-nil, `gnus-ignored-headers' will be ignored." |
If this variable is non-nil, `gnus-ignored-headers' will be ignored." |
183 |
|
|
184 |
(defcustom gnus-boring-article-headers '(empty followup-to reply-to) |
(defcustom gnus-boring-article-headers '(empty followup-to reply-to) |
185 |
"Headers that are only to be displayed if they have interesting data. |
"Headers that are only to be displayed if they have interesting data. |
186 |
Possible values in this list are `empty', `newsgroups', `followup-to', |
Possible values in this list are: |
187 |
`reply-to', `date', `long-to', and `many-to'." |
|
188 |
|
'empty Headers with no content. |
189 |
|
'newsgroups Newsgroup identical to Gnus group. |
190 |
|
'to-address To identical to To-address. |
191 |
|
'to-list To identical to To-list. |
192 |
|
'cc-list CC identical to To-list. |
193 |
|
'followup-to Followup-to identical to Newsgroups. |
194 |
|
'reply-to Reply-to identical to From. |
195 |
|
'date Date less than four days old. |
196 |
|
'long-to To and/or Cc longer than 1024 characters. |
197 |
|
'many-to Multiple To and/or Cc." |
198 |
:type '(set (const :tag "Headers with no content." empty) |
:type '(set (const :tag "Headers with no content." empty) |
199 |
(const :tag "Newsgroups with only one group." newsgroups) |
(const :tag "Newsgroups identical to Gnus group." newsgroups) |
200 |
(const :tag "Followup-to identical to newsgroups." followup-to) |
(const :tag "To identical to To-address." to-address) |
201 |
(const :tag "Reply-to identical to from." reply-to) |
(const :tag "To identical to To-list." to-list) |
202 |
|
(const :tag "CC identical to To-list." cc-list) |
203 |
|
(const :tag "Followup-to identical to Newsgroups." followup-to) |
204 |
|
(const :tag "Reply-to identical to From." reply-to) |
205 |
(const :tag "Date less than four days old." date) |
(const :tag "Date less than four days old." date) |
206 |
(const :tag "Very long To and/or Cc header." long-to) |
(const :tag "To and/or Cc longer than 1024 characters." long-to) |
207 |
(const :tag "Multiple To and/or Cc headers." many-to)) |
(const :tag "Multiple To and/or Cc headers." many-to)) |
208 |
:group 'gnus-article-hiding) |
:group 'gnus-article-hiding) |
209 |
|
|
210 |
|
(defcustom gnus-article-skip-boring nil |
211 |
|
"Skip over text that is not worth reading. |
212 |
|
By default, if you set this t, then Gnus will display citations and |
213 |
|
signatures, but will never scroll down to show you a page consisting |
214 |
|
only of boring text. Boring text is controlled by |
215 |
|
`gnus-article-boring-faces'." |
216 |
|
:type 'boolean |
217 |
|
:group 'gnus-article-hiding) |
218 |
|
|
219 |
(defcustom gnus-signature-separator '("^-- $" "^-- *$") |
(defcustom gnus-signature-separator '("^-- $" "^-- *$") |
220 |
"Regexp matching signature separator. |
"Regexp matching signature separator. |
221 |
This can also be a list of regexps. In that case, it will be checked |
This can also be a list of regexps. In that case, it will be checked |
243 |
:type 'sexp |
:type 'sexp |
244 |
:group 'gnus-article-hiding) |
:group 'gnus-article-hiding) |
245 |
|
|
246 |
;; Fixme: This isn't the right thing for mixed graphical and and |
;; Fixme: This isn't the right thing for mixed graphical and non-graphical |
247 |
;; non-graphical frames in a session. |
;; frames in a session. |
|
;; gnus-xmas.el overrides this for XEmacs. |
|
248 |
(defcustom gnus-article-x-face-command |
(defcustom gnus-article-x-face-command |
249 |
(if (and (fboundp 'image-type-available-p) |
(if (featurep 'xemacs) |
250 |
(image-type-available-p 'xbm)) |
(if (or (gnus-image-type-available-p 'xface) |
251 |
'gnus-article-display-xface |
(gnus-image-type-available-p 'pbm)) |
252 |
(if (or (and (boundp 'gnus-article-compface-xbm) |
'gnus-display-x-face-in-from |
253 |
gnus-article-compface-xbm) |
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -") |
254 |
(eq 0 (string-match "#define" |
(if (gnus-image-type-available-p 'pbm) |
255 |
(shell-command-to-string "uncompface -X")))) |
'gnus-display-x-face-in-from |
|
"{ echo '/* Width=48, Height=48 */'; uncompface; } | display -" |
|
256 |
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ |
"{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \ |
257 |
display -")) |
display -")) |
258 |
"*String or function to be executed to display an X-Face header. |
"*String or function to be executed to display an X-Face header. |
259 |
If it is a string, the command will be executed in a sub-shell |
If it is a string, the command will be executed in a sub-shell |
260 |
asynchronously. The compressed face will be piped to this command." |
asynchronously. The compressed face will be piped to this command." |
261 |
:type '(choice string |
:type `(choice string |
262 |
(function-item gnus-article-display-xface) |
(function-item gnus-display-x-face-in-from) |
263 |
function) |
function) |
264 |
:version "21.1" |
:version "21.1" |
265 |
|
:group 'gnus-picon |
266 |
:group 'gnus-article-washing) |
:group 'gnus-article-washing) |
267 |
|
|
268 |
(defcustom gnus-article-x-face-too-ugly nil |
(defcustom gnus-article-x-face-too-ugly nil |
273 |
(defcustom gnus-article-banner-alist nil |
(defcustom gnus-article-banner-alist nil |
274 |
"Banner alist for stripping. |
"Banner alist for stripping. |
275 |
For example, |
For example, |
276 |
((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" |
((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" |
277 |
:version "21.1" |
:version "21.1" |
278 |
:type '(repeat (cons symbol regexp)) |
:type '(repeat (cons symbol regexp)) |
279 |
:group 'gnus-article-washing) |
:group 'gnus-article-washing) |
280 |
|
|
281 |
|
(gnus-define-group-parameter |
282 |
|
banner |
283 |
|
:variable-document |
284 |
|
"Alist of regexps (to match group names) and banner." |
285 |
|
:variable-group gnus-article-washing |
286 |
|
:parameter-type |
287 |
|
'(choice :tag "Banner" |
288 |
|
:value nil |
289 |
|
(const :tag "Remove signature" signature) |
290 |
|
(symbol :tag "Item in `gnus-article-banner-alist'" none) |
291 |
|
regexp |
292 |
|
(const :tag "None" nil)) |
293 |
|
:parameter-document |
294 |
|
"If non-nil, specify how to remove `banners' from articles. |
295 |
|
|
296 |
|
Symbol `signature' means to remove signatures delimited by |
297 |
|
`gnus-signature-separator'. Any other symbol is used to look up a |
298 |
|
regular expression to match the banner in `gnus-article-banner-alist'. |
299 |
|
A string is used as a regular expression to match the banner |
300 |
|
directly.") |
301 |
|
|
302 |
|
(defcustom gnus-article-address-banner-alist nil |
303 |
|
"Alist of mail addresses and banners. |
304 |
|
Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp |
305 |
|
to match a mail address in the From: header, BANNER is one of a symbol |
306 |
|
`signature', an item in `gnus-article-banner-alist', a regexp and nil. |
307 |
|
If ADDRESS matches author's mail address, it will remove things like |
308 |
|
advertisements. For example: |
309 |
|
|
310 |
|
\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\")) |
311 |
|
" |
312 |
|
:type '(repeat |
313 |
|
(cons |
314 |
|
(regexp :tag "Address") |
315 |
|
(choice :tag "Banner" :value nil |
316 |
|
(const :tag "Remove signature" signature) |
317 |
|
(symbol :tag "Item in `gnus-article-banner-alist'" none) |
318 |
|
regexp |
319 |
|
(const :tag "None" nil)))) |
320 |
|
:group 'gnus-article-washing) |
321 |
|
|
322 |
(defcustom gnus-emphasis-alist |
(defcustom gnus-emphasis-alist |
323 |
(let ((format |
(let ((format |
324 |
"\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)") |
"\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)") |
325 |
(types |
(types |
326 |
'(("_" "_" underline) |
'(("\\*" "\\*" bold) |
327 |
|
("_" "_" underline) |
328 |
("/" "/" italic) |
("/" "/" italic) |
|
("\\*" "\\*" bold) |
|
329 |
("_/" "/_" underline-italic) |
("_/" "/_" underline-italic) |
330 |
("_\\*" "\\*_" underline-bold) |
("_\\*" "\\*_" underline-bold) |
331 |
("\\*/" "/\\*" bold-italic) |
("\\*/" "/\\*" bold-italic) |
332 |
("_\\*/" "/\\*_" underline-bold-italic)))) |
("_\\*/" "/\\*_" underline-bold-italic)))) |
333 |
`(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" |
`(,@(mapcar |
|
2 3 gnus-emphasis-underline) |
|
|
,@(mapcar |
|
334 |
(lambda (spec) |
(lambda (spec) |
335 |
(list |
(list |
336 |
(format format (car spec) (cadr spec)) |
(format format (car spec) (cadr spec)) |
337 |
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) |
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) |
338 |
types))) |
types) |
339 |
|
("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)" |
340 |
|
2 3 gnus-emphasis-strikethru) |
341 |
|
("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" |
342 |
|
2 3 gnus-emphasis-underline))) |
343 |
"*Alist that says how to fontify certain phrases. |
"*Alist that says how to fontify certain phrases. |
344 |
Each item looks like this: |
Each item looks like this: |
345 |
|
|
366 |
:group 'gnus-article-emphasis |
:group 'gnus-article-emphasis |
367 |
:type 'regexp) |
:type 'regexp) |
368 |
|
|
369 |
(defface gnus-emphasis-bold '((t (:weight bold))) |
(defface gnus-emphasis-bold '((t (:bold t))) |
370 |
"Face used for displaying strong emphasized text (*word*)." |
"Face used for displaying strong emphasized text (*word*)." |
371 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
372 |
|
|
373 |
(defface gnus-emphasis-italic '((t (:slant italic))) |
(defface gnus-emphasis-italic '((t (:italic t))) |
374 |
"Face used for displaying italic emphasized text (/word/)." |
"Face used for displaying italic emphasized text (/word/)." |
375 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
376 |
|
|
378 |
"Face used for displaying underlined emphasized text (_word_)." |
"Face used for displaying underlined emphasized text (_word_)." |
379 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
380 |
|
|
381 |
(defface gnus-emphasis-underline-bold '((t (:weight bold :underline t))) |
(defface gnus-emphasis-underline-bold '((t (:bold t :underline t))) |
382 |
"Face used for displaying underlined bold emphasized text (_*word*_)." |
"Face used for displaying underlined bold emphasized text (_*word*_)." |
383 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
384 |
|
|
385 |
(defface gnus-emphasis-underline-italic '((t (:slant italic :underline t))) |
(defface gnus-emphasis-underline-italic '((t (:italic t :underline t))) |
386 |
"Face used for displaying underlined italic emphasized text (_/word/_)." |
"Face used for displaying underlined italic emphasized text (_/word/_)." |
387 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
388 |
|
|
389 |
(defface gnus-emphasis-bold-italic '((t (:weight bold :slant italic))) |
(defface gnus-emphasis-bold-italic '((t (:bold t :italic t))) |
390 |
"Face used for displaying bold italic emphasized text (/*word*/)." |
"Face used for displaying bold italic emphasized text (/*word*/)." |
391 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
392 |
|
|
393 |
(defface gnus-emphasis-underline-bold-italic |
(defface gnus-emphasis-underline-bold-italic |
394 |
'((t (:weight bold :slant italic :underline t))) |
'((t (:bold t :italic t :underline t))) |
395 |
"Face used for displaying underlined bold italic emphasized text. |
"Face used for displaying underlined bold italic emphasized text. |
396 |
Example: (_/*word*/_)." |
Example: (_/*word*/_)." |
397 |
:group 'gnus-article-emphasis) |
:group 'gnus-article-emphasis) |
398 |
|
|
399 |
|
(defface gnus-emphasis-strikethru (if (featurep 'xemacs) |
400 |
|
'((t (:strikethru t))) |
401 |
|
'((t (:strike-through t)))) |
402 |
|
"Face used for displaying strike-through text (-word-)." |
403 |
|
:group 'gnus-article-emphasis) |
404 |
|
|
405 |
(defface gnus-emphasis-highlight-words |
(defface gnus-emphasis-highlight-words |
406 |
'((t (:background "black" :foreground "yellow"))) |
'((t (:background "black" :foreground "yellow"))) |
407 |
"Face used for displaying highlighted words." |
"Face used for displaying highlighted words." |
458 |
* gnus-summary-save-in-mail (Unix mail format) |
* gnus-summary-save-in-mail (Unix mail format) |
459 |
* gnus-summary-save-in-folder (MH folder) |
* gnus-summary-save-in-folder (MH folder) |
460 |
* gnus-summary-save-in-file (article format) |
* gnus-summary-save-in-file (article format) |
461 |
|
* gnus-summary-save-body-in-file (article body) |
462 |
* gnus-summary-save-in-vm (use VM's folder format) |
* gnus-summary-save-in-vm (use VM's folder format) |
463 |
* gnus-summary-write-to-file (article format -- overwrite)." |
* gnus-summary-write-to-file (article format -- overwrite)." |
464 |
:group 'gnus-article-saving |
:group 'gnus-article-saving |
466 |
(function-item gnus-summary-save-in-mail) |
(function-item gnus-summary-save-in-mail) |
467 |
(function-item gnus-summary-save-in-folder) |
(function-item gnus-summary-save-in-folder) |
468 |
(function-item gnus-summary-save-in-file) |
(function-item gnus-summary-save-in-file) |
469 |
|
(function-item gnus-summary-save-body-in-file) |
470 |
(function-item gnus-summary-save-in-vm) |
(function-item gnus-summary-save-in-vm) |
471 |
(function-item gnus-summary-write-to-file))) |
(function-item gnus-summary-write-to-file))) |
472 |
|
|
545 |
:type 'hook |
:type 'hook |
546 |
:group 'gnus-article-various) |
:group 'gnus-article-various) |
547 |
|
|
548 |
|
(when (featurep 'xemacs) |
549 |
|
;; Extracted from gnus-xmas-define in order to preserve user settings |
550 |
|
(when (fboundp 'turn-off-scroll-in-place) |
551 |
|
(add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) |
552 |
|
;; Extracted from gnus-xmas-redefine in order to preserve user settings |
553 |
|
(add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) |
554 |
|
|
555 |
(defcustom gnus-article-menu-hook nil |
(defcustom gnus-article-menu-hook nil |
556 |
"*Hook run after the creation of the article mode menu." |
"*Hook run after the creation of the article mode menu." |
557 |
:type 'hook |
:type 'hook |
562 |
:type 'hook |
:type 'hook |
563 |
:group 'gnus-article-various) |
:group 'gnus-article-various) |
564 |
|
|
565 |
(defcustom gnus-article-hide-pgp-hook nil |
(make-obsolete-variable 'gnus-article-hide-pgp-hook |
566 |
"*A hook called after successfully hiding a PGP signature." |
"This variable is obsolete in Gnus 5.10.") |
|
:type 'hook |
|
|
:group 'gnus-article-various) |
|
567 |
|
|
568 |
(defcustom gnus-article-button-face 'bold |
(defcustom gnus-article-button-face 'bold |
569 |
"Face used for highlighting buttons in the article buffer. |
"Face used for highlighting buttons in the article buffer. |
590 |
|
|
591 |
(defface gnus-signature-face |
(defface gnus-signature-face |
592 |
'((t |
'((t |
593 |
(:slant italic))) |
(:italic t))) |
594 |
"Face used for highlighting a signature in the article buffer." |
"Face used for highlighting a signature in the article buffer." |
595 |
:group 'gnus-article-highlight |
:group 'gnus-article-highlight |
596 |
:group 'gnus-article-signature) |
:group 'gnus-article-signature) |
603 |
(background light)) |
(background light)) |
604 |
(:foreground "red3")) |
(:foreground "red3")) |
605 |
(t |
(t |
606 |
(:slant italic))) |
(:italic t))) |
607 |
"Face used for displaying from headers." |
"Face used for displaying from headers." |
608 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
609 |
:group 'gnus-article-highlight) |
:group 'gnus-article-highlight) |
616 |
(background light)) |
(background light)) |
617 |
(:foreground "red4")) |
(:foreground "red4")) |
618 |
(t |
(t |
619 |
(:weight bold :slant italic))) |
(:bold t :italic t))) |
620 |
"Face used for displaying subject headers." |
"Face used for displaying subject headers." |
621 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
622 |
:group 'gnus-article-highlight) |
:group 'gnus-article-highlight) |
624 |
(defface gnus-header-newsgroups-face |
(defface gnus-header-newsgroups-face |
625 |
'((((class color) |
'((((class color) |
626 |
(background dark)) |
(background dark)) |
627 |
(:foreground "yellow" :slant italic)) |
(:foreground "yellow" :italic t)) |
628 |
(((class color) |
(((class color) |
629 |
(background light)) |
(background light)) |
630 |
(:foreground "MidnightBlue" :slant italic)) |
(:foreground "MidnightBlue" :italic t)) |
631 |
(t |
(t |
632 |
(:slant italic))) |
(:italic t))) |
633 |
"Face used for displaying newsgroups headers." |
"Face used for displaying newsgroups headers. |
634 |
|
In the default setup this face is only used for crossposted |
635 |
|
articles." |
636 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
637 |
:group 'gnus-article-highlight) |
:group 'gnus-article-highlight) |
638 |
|
|
644 |
(background light)) |
(background light)) |
645 |
(:foreground "maroon")) |
(:foreground "maroon")) |
646 |
(t |
(t |
647 |
(:weight bold))) |
(:bold t))) |
648 |
"Face used for displaying header names." |
"Face used for displaying header names." |
649 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
650 |
:group 'gnus-article-highlight) |
:group 'gnus-article-highlight) |
652 |
(defface gnus-header-content-face |
(defface gnus-header-content-face |
653 |
'((((class color) |
'((((class color) |
654 |
(background dark)) |
(background dark)) |
655 |
(:foreground "forest green" :slant italic)) |
(:foreground "forest green" :italic t)) |
656 |
(((class color) |
(((class color) |
657 |
(background light)) |
(background light)) |
658 |
(:foreground "indianred4" :slant italic)) |
(:foreground "indianred4" :italic t)) |
659 |
(t |
(t |
660 |
(:slant italic))) "Face used for displaying header content." |
(:italic t))) "Face used for displaying header content." |
661 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
662 |
:group 'gnus-article-highlight) |
:group 'gnus-article-highlight) |
663 |
|
|
666 |
("Subject" nil gnus-header-subject-face) |
("Subject" nil gnus-header-subject-face) |
667 |
("Newsgroups:.*," nil gnus-header-newsgroups-face) |
("Newsgroups:.*," nil gnus-header-newsgroups-face) |
668 |
("" gnus-header-name-face gnus-header-content-face)) |
("" gnus-header-name-face gnus-header-content-face)) |
669 |
"*Controls highlighting of article header. |
"*Controls highlighting of article headers. |
670 |
|
|
671 |
An alist of the form (HEADER NAME CONTENT). |
An alist of the form (HEADER NAME CONTENT). |
672 |
|
|
673 |
HEADER is a regular expression which should match the name of an |
HEADER is a regular expression which should match the name of a |
674 |
header header and NAME and CONTENT are either face names or nil. |
header and NAME and CONTENT are either face names or nil. |
675 |
|
|
676 |
The name of each header field will be displayed using the face |
The name of each header field will be displayed using the face |
677 |
specified by the first element in the list where HEADER match the |
specified by the first element in the list where HEADER matches |
678 |
header name and NAME is non-nil. Similarly, the content will be |
the header name and NAME is non-nil. Similarly, the content will |
679 |
displayed by the first non-nil matching CONTENT face." |
be displayed by the first non-nil matching CONTENT face." |
680 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
681 |
:group 'gnus-article-highlight |
:group 'gnus-article-highlight |
682 |
:type '(repeat (list (regexp :tag "Header") |
:type '(repeat (list (regexp :tag "Header") |
688 |
(face :value default))))) |
(face :value default))))) |
689 |
|
|
690 |
(defcustom gnus-article-decode-hook |
(defcustom gnus-article-decode-hook |
691 |
'(article-decode-charset article-decode-encoded-words) |
'(article-decode-charset article-decode-encoded-words |
692 |
|
article-decode-group-name article-decode-idna-rhs) |
693 |
"*Hook run to decode charsets in articles." |
"*Hook run to decode charsets in articles." |
694 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
695 |
:type 'hook) |
:type 'hook) |
703 |
"Function used to decode headers.") |
"Function used to decode headers.") |
704 |
|
|
705 |
(defvar gnus-article-dumbquotes-map |
(defvar gnus-article-dumbquotes-map |
706 |
'(("\202" ",") |
'(("\200" "EUR") |
707 |
|
("\202" ",") |
708 |
("\203" "f") |
("\203" "f") |
709 |
("\204" ",,") |
("\204" ",,") |
710 |
("\205" "...") |
("\205" "...") |
717 |
("\225" "*") |
("\225" "*") |
718 |
("\226" "-") |
("\226" "-") |
719 |
("\227" "--") |
("\227" "--") |
720 |
|
("\230" "~") |
721 |
("\231" "(TM)") |
("\231" "(TM)") |
722 |
("\233" ">") |
("\233" ">") |
723 |
("\234" "oe") |
("\234" "oe") |
731 |
:type '(repeat regexp)) |
:type '(repeat regexp)) |
732 |
|
|
733 |
(defcustom gnus-unbuttonized-mime-types '(".*/.*") |
(defcustom gnus-unbuttonized-mime-types '(".*/.*") |
734 |
"List of MIME types that should not be given buttons when rendered inline." |
"List of MIME types that should not be given buttons when rendered inline. |
735 |
|
See also `gnus-buttonized-mime-types' which may override this variable. |
736 |
|
This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." |
737 |
:version "21.1" |
:version "21.1" |
738 |
:group 'gnus-article-mime |
:group 'gnus-article-mime |
739 |
:type '(repeat regexp)) |
:type '(repeat regexp)) |
740 |
|
|
741 |
|
(defcustom gnus-buttonized-mime-types nil |
742 |
|
"List of MIME types that should be given buttons when rendered inline. |
743 |
|
If set, this variable overrides `gnus-unbuttonized-mime-types'. |
744 |
|
To see e.g. security buttons you could set this to |
745 |
|
`(\"multipart/signed\")'. |
746 |
|
This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil." |
747 |
|
:version "21.1" |
748 |
|
:group 'gnus-article-mime |
749 |
|
:type '(repeat regexp)) |
750 |
|
|
751 |
|
(defcustom gnus-inhibit-mime-unbuttonizing nil |
752 |
|
"If non-nil, all MIME parts get buttons. |
753 |
|
When nil (the default value), then some MIME parts do not get buttons, |
754 |
|
as described by the variables `gnus-buttonized-mime-types' and |
755 |
|
`gnus-unbuttonized-mime-types'." |
756 |
|
:version "21.3" |
757 |
|
:type 'boolean) |
758 |
|
|
759 |
|
(defcustom gnus-body-boundary-delimiter "_" |
760 |
|
"String used to delimit header and body. |
761 |
|
This variable is used by `gnus-article-treat-body-boundary' which can |
762 |
|
be controlled by `gnus-treat-body-boundary'." |
763 |
|
:group 'gnus-article-various |
764 |
|
:type '(choice (item :tag "None" :value nil) |
765 |
|
string)) |
766 |
|
|
767 |
|
(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces") |
768 |
|
"Defines the location of the faces database. |
769 |
|
For information on obtaining this database of pretty pictures, please |
770 |
|
see http://www.cs.indiana.edu/picons/ftp/index.html" |
771 |
|
:type '(repeat directory) |
772 |
|
:link '(url-link :tag "download" |
773 |
|
"http://www.cs.indiana.edu/picons/ftp/index.html") |
774 |
|
:link '(custom-manual "(gnus)Picons") |
775 |
|
:group 'gnus-picon) |
776 |
|
|
777 |
|
(defun gnus-picons-installed-p () |
778 |
|
"Say whether picons are installed on your machine." |
779 |
|
(let ((installed nil)) |
780 |
|
(dolist (database gnus-picon-databases) |
781 |
|
(when (file-exists-p database) |
782 |
|
(setq installed t))) |
783 |
|
installed)) |
784 |
|
|
785 |
(defcustom gnus-article-mime-part-function nil |
(defcustom gnus-article-mime-part-function nil |
786 |
"Function called with a MIME handle as the argument. |
"Function called with a MIME handle as the argument. |
787 |
This is meant for people who want to do something automatic based |
This is meant for people who want to do something automatic based |
823 |
|
|
824 |
(defcustom gnus-mime-action-alist |
(defcustom gnus-mime-action-alist |
825 |
'(("save to file" . gnus-mime-save-part) |
'(("save to file" . gnus-mime-save-part) |
826 |
|
("save and strip" . gnus-mime-save-part-and-strip) |
827 |
|
("delete part" . gnus-mime-delete-part) |
828 |
("display as text" . gnus-mime-inline-part) |
("display as text" . gnus-mime-inline-part) |
829 |
("view the part" . gnus-mime-view-part) |
("view the part" . gnus-mime-view-part) |
830 |
("pipe to command" . gnus-mime-pipe-part) |
("pipe to command" . gnus-mime-pipe-part) |
831 |
("toggle display" . gnus-article-press-button) |
("toggle display" . gnus-article-press-button) |
832 |
|
("toggle display" . gnus-article-view-part-as-charset) |
833 |
("view as type" . gnus-mime-view-part-as-type) |
("view as type" . gnus-mime-view-part-as-type) |
834 |
("internalize type" . gnus-mime-internalize-part) |
("view internally" . gnus-mime-view-part-internally) |
835 |
("externalize type" . gnus-mime-externalize-part)) |
("view externally" . gnus-mime-view-part-externally)) |
836 |
"An alist of actions that run on the MIME attachment." |
"An alist of actions that run on the MIME attachment." |
|
:version "21.1" |
|
837 |
:group 'gnus-article-mime |
:group 'gnus-article-mime |
838 |
:type '(repeat (cons (string :tag "name") |
:type '(repeat (cons (string :tag "name") |
839 |
(function)))) |
(function)))) |
864 |
(defvar gnus-inhibit-treatment nil |
(defvar gnus-inhibit-treatment nil |
865 |
"Whether to inhibit treatment.") |
"Whether to inhibit treatment.") |
866 |
|
|
867 |
(defcustom gnus-treat-highlight-signature '(or last (typep "text/x-vcard")) |
(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard")) |
868 |
"Highlight the signature. |
"Highlight the signature. |
869 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
870 |
See the manual for details." |
See Info node `(gnus)Customizing Articles'." |
871 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
872 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
873 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
874 |
(put 'gnus-treat-highlight-signature 'highlight t) |
(put 'gnus-treat-highlight-signature 'highlight t) |
875 |
|
|
876 |
(defcustom gnus-treat-buttonize 100000 |
(defcustom gnus-treat-buttonize 100000 |
877 |
"Add buttons. |
"Add buttons. |
878 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
879 |
See the manual for details." |
See Info node `(gnus)Customizing Articles'." |
880 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
881 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
882 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
883 |
(put 'gnus-treat-buttonize 'highlight t) |
(put 'gnus-treat-buttonize 'highlight t) |
884 |
|
|
885 |
(defcustom gnus-treat-buttonize-head 'head |
(defcustom gnus-treat-buttonize-head 'head |
886 |
"Add buttons to the head. |
"Add buttons to the head. |
887 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
888 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
889 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
890 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
891 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
892 |
(put 'gnus-treat-buttonize-head 'highlight t) |
(put 'gnus-treat-buttonize-head 'highlight t) |
893 |
|
|
898 |
50000) |
50000) |
899 |
"Emphasize text. |
"Emphasize text. |
900 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
901 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
902 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
903 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
904 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
905 |
(put 'gnus-treat-emphasize 'highlight t) |
(put 'gnus-treat-emphasize 'highlight t) |
906 |
|
|
907 |
(defcustom gnus-treat-strip-cr nil |
(defcustom gnus-treat-strip-cr nil |
908 |
"Remove carriage returns. |
"Remove carriage returns. |
909 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
910 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
911 |
|
:group 'gnus-article-treat |
912 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
913 |
|
:type gnus-article-treat-custom) |
914 |
|
|
915 |
|
(defcustom gnus-treat-unsplit-urls nil |
916 |
|
"Remove newlines from within URLs. |
917 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
918 |
|
See Info node `(gnus)Customizing Articles' for details." |
919 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
920 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
921 |
|
:type gnus-article-treat-custom) |
922 |
|
|
923 |
|
(defcustom gnus-treat-leading-whitespace nil |
924 |
|
"Remove leading whitespace in headers. |
925 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
926 |
|
See Info node `(gnus)Customizing Articles' for details." |
927 |
|
:group 'gnus-article-treat |
928 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
929 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
930 |
|
|
931 |
(defcustom gnus-treat-hide-headers 'head |
(defcustom gnus-treat-hide-headers 'head |
932 |
"Hide headers. |
"Hide headers. |
933 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
934 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
935 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
936 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
937 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
938 |
|
|
939 |
(defcustom gnus-treat-hide-boring-headers nil |
(defcustom gnus-treat-hide-boring-headers nil |
940 |
"Hide boring headers. |
"Hide boring headers. |
941 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
942 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
943 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
944 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
945 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
946 |
|
|
947 |
(defcustom gnus-treat-hide-signature nil |
(defcustom gnus-treat-hide-signature nil |
948 |
"Hide the signature. |
"Hide the signature. |
949 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
950 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
951 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
952 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
953 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
954 |
|
|
955 |
(defcustom gnus-treat-fill-article nil |
(defcustom gnus-treat-fill-article nil |
956 |
"Fill the article. |
"Fill the article. |
957 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
958 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
959 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
960 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
961 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
962 |
|
|
963 |
(defcustom gnus-treat-hide-citation nil |
(defcustom gnus-treat-hide-citation nil |
964 |
"Hide cited text. |
"Hide cited text. |
965 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
966 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
967 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
968 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
969 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
970 |
|
|
971 |
(defcustom gnus-treat-hide-citation-maybe nil |
(defcustom gnus-treat-hide-citation-maybe nil |
972 |
"Hide cited text. |
"Hide cited text. |
973 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
974 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
975 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
976 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
977 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
978 |
|
|
979 |
(defcustom gnus-treat-strip-list-identifiers 'head |
(defcustom gnus-treat-strip-list-identifiers 'head |
980 |
"Strip list identifiers from `gnus-list-identifiers`. |
"Strip list identifiers from `gnus-list-identifiers`. |
981 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
982 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
983 |
:version "21.1" |
:version "21.1" |
984 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
985 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
986 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
987 |
|
|
988 |
(defcustom gnus-treat-strip-pgp t |
(make-obsolete-variable 'gnus-treat-strip-pgp |
989 |
"Strip PGP signatures. |
"This option is obsolete in Gnus 5.10.") |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
|
|
See the manual for details." |
|
|
:group 'gnus-article-treat |
|
|
:type gnus-article-treat-custom) |
|
990 |
|
|
991 |
(defcustom gnus-treat-strip-pem nil |
(defcustom gnus-treat-strip-pem nil |
992 |
"Strip PEM signatures. |
"Strip PEM signatures. |
993 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
994 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
995 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
996 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
997 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
998 |
|
|
999 |
(defcustom gnus-treat-strip-banner t |
(defcustom gnus-treat-strip-banner t |
1000 |
"Strip banners from articles. |
"Strip banners from articles. |
1001 |
The banner to be stripped is specified in the `banner' group parameter. |
The banner to be stripped is specified in the `banner' group parameter. |
1002 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1003 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1004 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1005 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1006 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1007 |
|
|
1008 |
(defcustom gnus-treat-highlight-headers 'head |
(defcustom gnus-treat-highlight-headers 'head |
1009 |
"Highlight the headers. |
"Highlight the headers. |
1010 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1011 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1012 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1013 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1014 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1015 |
(put 'gnus-treat-highlight-headers 'highlight t) |
(put 'gnus-treat-highlight-headers 'highlight t) |
1016 |
|
|
1017 |
(defcustom gnus-treat-highlight-citation t |
(defcustom gnus-treat-highlight-citation t |
1018 |
"Highlight cited text. |
"Highlight cited text. |
1019 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1020 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1021 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1022 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1023 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1024 |
(put 'gnus-treat-highlight-citation 'highlight t) |
(put 'gnus-treat-highlight-citation 'highlight t) |
1025 |
|
|
1026 |
(defcustom gnus-treat-date-ut nil |
(defcustom gnus-treat-date-ut nil |
1027 |
"Display the Date in UT (GMT). |
"Display the Date in UT (GMT). |
1028 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1029 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1030 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1031 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1032 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1033 |
|
|
1034 |
(defcustom gnus-treat-date-local nil |
(defcustom gnus-treat-date-local nil |
1035 |
"Display the Date in the local timezone. |
"Display the Date in the local timezone. |
1036 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1037 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1038 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1039 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1040 |
|
:type gnus-article-treat-head-custom) |
1041 |
|
|
1042 |
|
(defcustom gnus-treat-date-english nil |
1043 |
|
"Display the Date in a format that can be read aloud in English. |
1044 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1045 |
|
See Info node `(gnus)Customizing Articles' for details." |
1046 |
|
:group 'gnus-article-treat |
1047 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1048 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1049 |
|
|
1050 |
(defcustom gnus-treat-date-lapsed nil |
(defcustom gnus-treat-date-lapsed nil |
1051 |
"Display the Date header in a way that says how much time has elapsed. |
"Display the Date header in a way that says how much time has elapsed. |
1052 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1053 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1054 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1055 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1056 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1057 |
|
|
1058 |
(defcustom gnus-treat-date-original nil |
(defcustom gnus-treat-date-original nil |
1059 |
"Display the date in the original timezone. |
"Display the date in the original timezone. |
1060 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1061 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1062 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1063 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1064 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1065 |
|
|
1066 |
(defcustom gnus-treat-date-iso8601 nil |
(defcustom gnus-treat-date-iso8601 nil |
1067 |
"Display the date in the ISO8601 format. |
"Display the date in the ISO8601 format. |
1068 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1069 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1070 |
:version "21.1" |
:version "21.1" |
1071 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1072 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1073 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1074 |
|
|
1075 |
(defcustom gnus-treat-date-user-defined nil |
(defcustom gnus-treat-date-user-defined nil |
1076 |
"Display the date in a user-defined format. |
"Display the date in a user-defined format. |
1077 |
The format is defined by the `gnus-article-time-format' variable. |
The format is defined by the `gnus-article-time-format' variable. |
1078 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1079 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1080 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1081 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1082 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1083 |
|
|
1084 |
(defcustom gnus-treat-strip-headers-in-body t |
(defcustom gnus-treat-strip-headers-in-body t |
1085 |
"Strip the X-No-Archive header line from the beginning of the body. |
"Strip the X-No-Archive header line from the beginning of the body. |
1086 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1087 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1088 |
:version "21.1" |
:version "21.1" |
1089 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1090 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1091 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1092 |
|
|
1093 |
(defcustom gnus-treat-strip-trailing-blank-lines nil |
(defcustom gnus-treat-strip-trailing-blank-lines nil |
1094 |
"Strip trailing blank lines. |
"Strip trailing blank lines. |
1095 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1096 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1097 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1098 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1099 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1100 |
|
|
1101 |
(defcustom gnus-treat-strip-leading-blank-lines nil |
(defcustom gnus-treat-strip-leading-blank-lines nil |
1102 |
"Strip leading blank lines. |
"Strip leading blank lines. |
1103 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1104 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1105 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1106 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1107 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1108 |
|
|
1109 |
(defcustom gnus-treat-strip-multiple-blank-lines nil |
(defcustom gnus-treat-strip-multiple-blank-lines nil |
1110 |
"Strip multiple blank lines. |
"Strip multiple blank lines. |
1111 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1112 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1113 |
|
:group 'gnus-article-treat |
1114 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1115 |
|
:type gnus-article-treat-custom) |
1116 |
|
|
1117 |
|
(defcustom gnus-treat-unfold-headers 'head |
1118 |
|
"Unfold folded header lines. |
1119 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1120 |
|
See Info node `(gnus)Customizing Articles' for details." |
1121 |
|
:group 'gnus-article-treat |
1122 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1123 |
|
:type gnus-article-treat-custom) |
1124 |
|
|
1125 |
|
(defcustom gnus-treat-fold-headers nil |
1126 |
|
"Fold headers. |
1127 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1128 |
|
See Info node `(gnus)Customizing Articles' for details." |
1129 |
|
:group 'gnus-article-treat |
1130 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1131 |
|
:type gnus-article-treat-custom) |
1132 |
|
|
1133 |
|
(defcustom gnus-treat-fold-newsgroups 'head |
1134 |
|
"Fold the Newsgroups and Followup-To headers. |
1135 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1136 |
|
See Info node `(gnus)Customizing Articles' for details." |
1137 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1138 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1139 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1140 |
|
|
1141 |
(defcustom gnus-treat-overstrike t |
(defcustom gnus-treat-overstrike t |
1142 |
"Treat overstrike highlighting. |
"Treat overstrike highlighting. |
1143 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1144 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1145 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1146 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1147 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1148 |
(put 'gnus-treat-overstrike 'highlight t) |
(put 'gnus-treat-overstrike 'highlight t) |
1149 |
|
|
1150 |
(defcustom gnus-treat-display-xface |
(make-obsolete-variable 'gnus-treat-display-xface |
1151 |
(and (or (and (fboundp 'image-type-available-p) |
'gnus-treat-display-x-face) |
1152 |
|
|
1153 |
|
(defcustom gnus-treat-display-x-face |
1154 |
|
(and (not noninteractive) |
1155 |
|
(or (and (fboundp 'image-type-available-p) |
1156 |
(image-type-available-p 'xbm) |
(image-type-available-p 'xbm) |
1157 |
(string-match "^0x" (shell-command-to-string "uncompface"))) |
(string-match "^0x" (shell-command-to-string "uncompface")) |
1158 |
(and (featurep 'xemacs) (featurep 'xface))) |
(executable-find "icontopbm")) |
1159 |
|
(and (featurep 'xemacs) |
1160 |
|
(featurep 'xface))) |
1161 |
'head) |
'head) |
1162 |
"Display X-Face headers. |
"Display X-Face headers. |
1163 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1164 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' and Info node |
1165 |
|
`(gnus)X-Face' for details." |
1166 |
|
:group 'gnus-article-treat |
1167 |
|
:version "21.1" |
1168 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1169 |
|
:link '(custom-manual "(gnus)X-Face") |
1170 |
|
:type gnus-article-treat-head-custom |
1171 |
|
:set (lambda (symbol value) |
1172 |
|
(set-default |
1173 |
|
symbol |
1174 |
|
(cond ((or (boundp symbol) (get symbol 'saved-value)) |
1175 |
|
value) |
1176 |
|
((boundp 'gnus-treat-display-xface) |
1177 |
|
(message "\ |
1178 |
|
** gnus-treat-display-xface is an obsolete variable;\ |
1179 |
|
use gnus-treat-display-x-face instead") |
1180 |
|
(default-value 'gnus-treat-display-xface)) |
1181 |
|
((get 'gnus-treat-display-xface 'saved-value) |
1182 |
|
(message "\ |
1183 |
|
** gnus-treat-display-xface is an obsolete variable;\ |
1184 |
|
use gnus-treat-display-x-face instead") |
1185 |
|
(eval (car (get 'gnus-treat-display-xface 'saved-value)))) |
1186 |
|
(t |
1187 |
|
value))))) |
1188 |
|
(put 'gnus-treat-display-x-face 'highlight t) |
1189 |
|
|
1190 |
|
(defcustom gnus-treat-display-face |
1191 |
|
(and (not noninteractive) |
1192 |
|
(or (and (fboundp 'image-type-available-p) |
1193 |
|
(image-type-available-p 'png)) |
1194 |
|
(and (featurep 'xemacs) |
1195 |
|
(featurep 'png))) |
1196 |
|
'head) |
1197 |
|
"Display Face headers. |
1198 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1199 |
|
See Info node `(gnus)Customizing Articles' and Info node |
1200 |
|
`(gnus)X-Face' for details." |
1201 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1202 |
:version "21.1" |
:version "21.1" |
1203 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1204 |
|
:link '(custom-manual "(gnus)X-Face") |
1205 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
1206 |
(put 'gnus-treat-display-xface 'highlight t) |
(put 'gnus-treat-display-face 'highlight t) |
1207 |
|
|
1208 |
(defcustom gnus-treat-display-smileys |
(defcustom gnus-treat-display-smileys |
1209 |
(if (or (and (featurep 'xemacs) |
(if (or (and (featurep 'xemacs) |
1213 |
t nil) |
t nil) |
1214 |
"Display smileys. |
"Display smileys. |
1215 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1216 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' and Info node |
1217 |
|
`(gnus)Smileys' for details." |
1218 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1219 |
:version "21.1" |
:version "21.1" |
1220 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1221 |
|
:link '(custom-manual "(gnus)Smileys") |
1222 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1223 |
(put 'gnus-treat-display-smileys 'highlight t) |
(put 'gnus-treat-display-smileys 'highlight t) |
1224 |
|
|
1225 |
(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil) |
(defcustom gnus-treat-from-picon |
1226 |
"Display picons. |
(if (and (gnus-image-type-available-p 'xpm) |
1227 |
|
(gnus-picons-installed-p)) |
1228 |
|
'head nil) |
1229 |
|
"Display picons in the From header. |
1230 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1231 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' and Info node |
1232 |
|
`(gnus)Picons' for details." |
1233 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1234 |
|
:group 'gnus-picon |
1235 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1236 |
|
:link '(custom-manual "(gnus)Picons") |
1237 |
|
:type gnus-article-treat-head-custom) |
1238 |
|
(put 'gnus-treat-from-picon 'highlight t) |
1239 |
|
|
1240 |
|
(defcustom gnus-treat-mail-picon |
1241 |
|
(if (and (gnus-image-type-available-p 'xpm) |
1242 |
|
(gnus-picons-installed-p)) |
1243 |
|
'head nil) |
1244 |
|
"Display picons in To and Cc headers. |
1245 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1246 |
|
See Info node `(gnus)Customizing Articles' and Info node |
1247 |
|
`(gnus)Picons' for details." |
1248 |
|
:group 'gnus-article-treat |
1249 |
|
:group 'gnus-picon |
1250 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1251 |
|
:link '(custom-manual "(gnus)Picons") |
1252 |
|
:type gnus-article-treat-head-custom) |
1253 |
|
(put 'gnus-treat-mail-picon 'highlight t) |
1254 |
|
|
1255 |
|
(defcustom gnus-treat-newsgroups-picon |
1256 |
|
(if (and (gnus-image-type-available-p 'xpm) |
1257 |
|
(gnus-picons-installed-p)) |
1258 |
|
'head nil) |
1259 |
|
"Display picons in the Newsgroups and Followup-To headers. |
1260 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1261 |
|
See Info node `(gnus)Customizing Articles' and Info node |
1262 |
|
`(gnus)Picons' for details." |
1263 |
|
:group 'gnus-article-treat |
1264 |
|
:group 'gnus-picon |
1265 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1266 |
|
:link '(custom-manual "(gnus)Picons") |
1267 |
|
:type gnus-article-treat-head-custom) |
1268 |
|
(put 'gnus-treat-newsgroups-picon 'highlight t) |
1269 |
|
|
1270 |
|
(defcustom gnus-treat-body-boundary |
1271 |
|
(if (or gnus-treat-newsgroups-picon |
1272 |
|
gnus-treat-mail-picon |
1273 |
|
gnus-treat-from-picon) |
1274 |
|
'head nil) |
1275 |
|
"Draw a boundary at the end of the headers. |
1276 |
|
Valid values are nil and `head'. |
1277 |
|
See Info node `(gnus)Customizing Articles' for details." |
1278 |
|
:version "21.1" |
1279 |
|
:group 'gnus-article-treat |
1280 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1281 |
:type gnus-article-treat-head-custom) |
:type gnus-article-treat-head-custom) |
|
(put 'gnus-treat-display-picons 'highlight t) |
|
1282 |
|
|
1283 |
(defcustom gnus-treat-capitalize-sentences nil |
(defcustom gnus-treat-capitalize-sentences nil |
1284 |
"Capitalize sentence-starting words. |
"Capitalize sentence-starting words. |
1285 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1286 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1287 |
:version "21.1" |
:version "21.1" |
1288 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1289 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1290 |
|
:type gnus-article-treat-custom) |
1291 |
|
|
1292 |
|
(defcustom gnus-treat-wash-html nil |
1293 |
|
"Format as HTML. |
1294 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1295 |
|
See Info node `(gnus)Customizing Articles' for details." |
1296 |
|
:group 'gnus-article-treat |
1297 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1298 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1299 |
|
|
1300 |
(defcustom gnus-treat-fill-long-lines nil |
(defcustom gnus-treat-fill-long-lines nil |
1301 |
"Fill long lines. |
"Fill long lines. |
1302 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1303 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1304 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1305 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1306 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1307 |
|
|
1308 |
(defcustom gnus-treat-play-sounds nil |
(defcustom gnus-treat-play-sounds nil |
1309 |
"Play sounds. |
"Play sounds. |
1310 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1311 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1312 |
:version "21.1" |
:version "21.1" |
1313 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1314 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1315 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1316 |
|
|
1317 |
(defcustom gnus-treat-translate nil |
(defcustom gnus-treat-translate nil |
1318 |
"Translate articles from one language to another. |
"Translate articles from one language to another. |
1319 |
Valid values are nil, t, `head', `last', an integer or a predicate. |
Valid values are nil, t, `head', `last', an integer or a predicate. |
1320 |
See the manual for details." |
See Info node `(gnus)Customizing Articles' for details." |
1321 |
:version "21.1" |
:version "21.1" |
1322 |
:group 'gnus-article-treat |
:group 'gnus-article-treat |
1323 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1324 |
:type gnus-article-treat-custom) |
:type gnus-article-treat-custom) |
1325 |
|
|
1326 |
|
(defcustom gnus-treat-x-pgp-sig nil |
1327 |
|
"Verify X-PGP-Sig. |
1328 |
|
To automatically treat X-PGP-Sig, set it to head. |
1329 |
|
Valid values are nil, t, `head', `last', an integer or a predicate. |
1330 |
|
See Info node `(gnus)Customizing Articles' for details." |
1331 |
|
:group 'gnus-article-treat |
1332 |
|
:group 'mime-security |
1333 |
|
:link '(custom-manual "(gnus)Customizing Articles") |
1334 |
|
:type gnus-article-treat-custom) |
1335 |
|
|
1336 |
|
(defvar gnus-article-encrypt-protocol-alist |
1337 |
|
'(("PGP" . mml2015-self-encrypt))) |
1338 |
|
|
1339 |
|
;; Set to nil if more than one protocol added to |
1340 |
|
;; gnus-article-encrypt-protocol-alist. |
1341 |
|
(defcustom gnus-article-encrypt-protocol "PGP" |
1342 |
|
"The protocol used for encrypt articles. |
1343 |
|
It is a string, such as \"PGP\". If nil, ask user." |
1344 |
|
:type 'string |
1345 |
|
:group 'mime-security) |
1346 |
|
|
1347 |
|
(defvar gnus-article-wash-function nil |
1348 |
|
"Function used for converting HTML into text.") |
1349 |
|
|
1350 |
|
(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error)) |
1351 |
|
(mm-coding-system-p 'utf-8) |
1352 |
|
(executable-find idna-program)) |
1353 |
|
"Whether IDNA decoding of headers is used when viewing messages. |
1354 |
|
This requires GNU Libidn, and by default only enabled if it is found." |
1355 |
|
:group 'gnus-article-headers |
1356 |
|
:type 'boolean) |
1357 |
|
|
1358 |
|
(defcustom gnus-article-over-scroll nil |
1359 |
|
"If non-nil, allow scrolling the article buffer even when there no more text." |
1360 |
|
:group 'gnus-article |
1361 |
|
:type 'boolean) |
1362 |
|
|
1363 |
;;; Internal variables |
;;; Internal variables |
1364 |
|
|
1365 |
|
(defvar gnus-english-month-names |
1366 |
|
'("January" "February" "March" "April" "May" "June" "July" "August" |
1367 |
|
"September" "October" "November" "December")) |
1368 |
|
|
1369 |
(defvar article-goto-body-goes-to-point-min-p nil) |
(defvar article-goto-body-goes-to-point-min-p nil) |
1370 |
(defvar gnus-article-wash-types nil) |
(defvar gnus-article-wash-types nil) |
1371 |
(defvar gnus-article-emphasis-alist nil) |
(defvar gnus-article-emphasis-alist nil) |
1372 |
|
(defvar gnus-article-image-alist nil) |
1373 |
|
|
1374 |
(defvar gnus-article-mime-handle-alist-1 nil) |
(defvar gnus-article-mime-handle-alist-1 nil) |
1375 |
(defvar gnus-treatment-function-alist |
(defvar gnus-treatment-function-alist |
1376 |
'((gnus-treat-strip-banner gnus-article-strip-banner) |
'((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig) |
1377 |
|
(gnus-treat-strip-banner gnus-article-strip-banner) |
1378 |
(gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) |
(gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body) |
1379 |
(gnus-treat-highlight-signature gnus-article-highlight-signature) |
(gnus-treat-highlight-signature gnus-article-highlight-signature) |
1380 |
(gnus-treat-buttonize gnus-article-add-buttons) |
(gnus-treat-buttonize gnus-article-add-buttons) |
1381 |
(gnus-treat-fill-article gnus-article-fill-cited-article) |
(gnus-treat-fill-article gnus-article-fill-cited-article) |
1382 |
(gnus-treat-fill-long-lines gnus-article-fill-long-lines) |
(gnus-treat-fill-long-lines gnus-article-fill-long-lines) |
1383 |
(gnus-treat-strip-cr gnus-article-remove-cr) |
(gnus-treat-strip-cr gnus-article-remove-cr) |
1384 |
(gnus-treat-emphasize gnus-article-emphasize) |
(gnus-treat-unsplit-urls gnus-article-unsplit-urls) |
1385 |
(gnus-treat-display-xface gnus-article-display-x-face) |
(gnus-treat-date-ut gnus-article-date-ut) |
1386 |
|
(gnus-treat-date-local gnus-article-date-local) |
1387 |
|
(gnus-treat-date-english gnus-article-date-english) |
1388 |
|
(gnus-treat-date-lapsed gnus-article-date-lapsed) |
1389 |
|
(gnus-treat-date-original gnus-article-date-original) |
1390 |
|
(gnus-treat-date-user-defined gnus-article-date-user) |
1391 |
|
(gnus-treat-date-iso8601 gnus-article-date-iso8601) |
1392 |
|
(gnus-treat-display-x-face gnus-article-display-x-face) |
1393 |
|
(gnus-treat-display-face gnus-article-display-face) |
1394 |
(gnus-treat-hide-headers gnus-article-maybe-hide-headers) |
(gnus-treat-hide-headers gnus-article-maybe-hide-headers) |
1395 |
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) |
(gnus-treat-hide-boring-headers gnus-article-hide-boring-headers) |
1396 |
(gnus-treat-hide-signature gnus-article-hide-signature) |
(gnus-treat-hide-signature gnus-article-hide-signature) |
|
(gnus-treat-hide-citation gnus-article-hide-citation) |
|
|
(gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) |
|
1397 |
(gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) |
(gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) |
1398 |
(gnus-treat-strip-pgp gnus-article-hide-pgp) |
(gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace) |
1399 |
(gnus-treat-strip-pem gnus-article-hide-pem) |
(gnus-treat-strip-pem gnus-article-hide-pem) |
1400 |
|
(gnus-treat-from-picon gnus-treat-from-picon) |
1401 |
|
(gnus-treat-mail-picon gnus-treat-mail-picon) |
1402 |
|
(gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) |
1403 |
(gnus-treat-highlight-headers gnus-article-highlight-headers) |
(gnus-treat-highlight-headers gnus-article-highlight-headers) |
|
(gnus-treat-highlight-citation gnus-article-highlight-citation) |
|
1404 |
(gnus-treat-highlight-signature gnus-article-highlight-signature) |
(gnus-treat-highlight-signature gnus-article-highlight-signature) |
|
(gnus-treat-date-ut gnus-article-date-ut) |
|
|
(gnus-treat-date-local gnus-article-date-local) |
|
|
(gnus-treat-date-lapsed gnus-article-date-lapsed) |
|
|
(gnus-treat-date-original gnus-article-date-original) |
|
|
(gnus-treat-date-user-defined gnus-article-date-user) |
|
|
(gnus-treat-date-iso8601 gnus-article-date-iso8601) |
|
1405 |
(gnus-treat-strip-trailing-blank-lines |
(gnus-treat-strip-trailing-blank-lines |
1406 |
gnus-article-remove-trailing-blank-lines) |
gnus-article-remove-trailing-blank-lines) |
1407 |
(gnus-treat-strip-leading-blank-lines |
(gnus-treat-strip-leading-blank-lines |
1409 |
(gnus-treat-strip-multiple-blank-lines |
(gnus-treat-strip-multiple-blank-lines |
1410 |
gnus-article-strip-multiple-blank-lines) |
gnus-article-strip-multiple-blank-lines) |
1411 |
(gnus-treat-overstrike gnus-article-treat-overstrike) |
(gnus-treat-overstrike gnus-article-treat-overstrike) |
1412 |
|
(gnus-treat-unfold-headers gnus-article-treat-unfold-headers) |
1413 |
|
(gnus-treat-fold-headers gnus-article-treat-fold-headers) |
1414 |
|
(gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups) |
1415 |
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head) |
(gnus-treat-buttonize-head gnus-article-add-buttons-to-head) |
1416 |
(gnus-treat-display-smileys gnus-smiley-display) |
(gnus-treat-display-smileys gnus-treat-smiley) |
1417 |
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) |
(gnus-treat-capitalize-sentences gnus-article-capitalize-sentences) |
1418 |
(gnus-treat-display-picons gnus-article-display-picons) |
(gnus-treat-wash-html gnus-article-wash-html) |
1419 |
|
(gnus-treat-emphasize gnus-article-emphasize) |
1420 |
|
(gnus-treat-hide-citation gnus-article-hide-citation) |
1421 |
|
(gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) |
1422 |
|
(gnus-treat-highlight-citation gnus-article-highlight-citation) |
1423 |
|
(gnus-treat-body-boundary gnus-article-treat-body-boundary) |
1424 |
(gnus-treat-play-sounds gnus-earcon-display))) |
(gnus-treat-play-sounds gnus-earcon-display))) |
1425 |
|
|
1426 |
(defvar gnus-article-mime-handle-alist nil) |
(defvar gnus-article-mime-handle-alist nil) |
1429 |
|
|
1430 |
(defvar gnus-article-mode-syntax-table |
(defvar gnus-article-mode-syntax-table |
1431 |
(let ((table (copy-syntax-table text-mode-syntax-table))) |
(let ((table (copy-syntax-table text-mode-syntax-table))) |
1432 |
(modify-syntax-entry ?- "w" table) |
;; This causes the citation match run O(2^n). |
1433 |
(modify-syntax-entry ?> ")" table) |
;; (modify-syntax-entry ?- "w" table) |
1434 |
(modify-syntax-entry ?< "(" table) |
(modify-syntax-entry ?> ")<" table) |
1435 |
|
(modify-syntax-entry ?< "(>" table) |
1436 |
|
;; make M-. in article buffers work for `foo' strings |
1437 |
|
(modify-syntax-entry ?' " " table) |
1438 |
|
(modify-syntax-entry ?` " " table) |
1439 |
table) |
table) |
1440 |
"Syntax table used in article mode buffers. |
"Syntax table used in article mode buffers. |
1441 |
Initialized from `text-mode-syntax-table.") |
Initialized from `text-mode-syntax-table.") |
1451 |
|
|
1452 |
(defvar gnus-inhibit-hiding nil) |
(defvar gnus-inhibit-hiding nil) |
1453 |
|
|
1454 |
|
;;; Macros for dealing with the article buffer. |
1455 |
|
|
1456 |
|
(defmacro gnus-with-article-headers (&rest forms) |
1457 |
|
`(save-excursion |
1458 |
|
(set-buffer gnus-article-buffer) |
1459 |
|
(save-restriction |
1460 |
|
(let ((inhibit-read-only t) |
1461 |
|
(inhibit-point-motion-hooks t) |
1462 |
|
(case-fold-search t)) |
1463 |
|
(article-narrow-to-head) |
1464 |
|
,@forms)))) |
1465 |
|
|
1466 |
|
(put 'gnus-with-article-headers 'lisp-indent-function 0) |
1467 |
|
(put 'gnus-with-article-headers 'edebug-form-spec '(body)) |
1468 |
|
|
1469 |
|
(defmacro gnus-with-article-buffer (&rest forms) |
1470 |
|
`(save-excursion |
1471 |
|
(set-buffer gnus-article-buffer) |
1472 |
|
(let ((inhibit-read-only t)) |
1473 |
|
,@forms))) |
1474 |
|
|
1475 |
|
(put 'gnus-with-article-buffer 'lisp-indent-function 0) |
1476 |
|
(put 'gnus-with-article-buffer 'edebug-form-spec '(body)) |
1477 |
|
|
1478 |
|
(defun gnus-article-goto-header (header) |
1479 |
|
"Go to HEADER, which is a regular expression." |
1480 |
|
(re-search-forward (concat "^\\(" header "\\):") nil t)) |
1481 |
|
|
1482 |
(defsubst gnus-article-hide-text (b e props) |
(defsubst gnus-article-hide-text (b e props) |
1483 |
"Set text PROPS on the B to E region, extending `intangible' 1 past B." |
"Set text PROPS on the B to E region, extending `intangible' 1 past B." |
1484 |
(gnus-add-text-properties-when 'article-type nil b e props) |
(gnus-add-text-properties-when 'article-type nil b e props) |
1496 |
|
|
1497 |
(defun gnus-article-hide-text-type (b e type) |
(defun gnus-article-hide-text-type (b e type) |
1498 |
"Hide text of TYPE between B and E." |
"Hide text of TYPE between B and E." |
1499 |
(push type gnus-article-wash-types) |
(gnus-add-wash-type type) |
1500 |
(gnus-article-hide-text |
(gnus-article-hide-text |
1501 |
b e (cons 'article-type (cons type gnus-hidden-properties)))) |
b e (cons 'article-type (cons type gnus-hidden-properties)))) |
1502 |
|
|
1503 |
(defun gnus-article-unhide-text-type (b e type) |
(defun gnus-article-unhide-text-type (b e type) |
1504 |
"Unhide text of TYPE between B and E." |
"Unhide text of TYPE between B and E." |
1505 |
(setq gnus-article-wash-types |
(gnus-delete-wash-type type) |
|
(delq type gnus-article-wash-types)) |
|
1506 |
(remove-text-properties |
(remove-text-properties |
1507 |
b e (cons 'article-type (cons type gnus-hidden-properties))) |
b e (cons 'article-type (cons type gnus-hidden-properties))) |
1508 |
(when (memq 'intangible gnus-hidden-properties) |
(when (memq 'intangible gnus-hidden-properties) |
1542 |
(defsubst gnus-article-header-rank () |
(defsubst gnus-article-header-rank () |
1543 |
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'." |
"Give the rank of the string HEADER as given by `gnus-sorted-header-list'." |
1544 |
(let ((list gnus-sorted-header-list) |
(let ((list gnus-sorted-header-list) |
1545 |
(i 0)) |
(i 1)) |
1546 |
(while list |
(while list |
1547 |
(when (looking-at (car list)) |
(if (looking-at (car list)) |
1548 |
(setq list nil)) |
(setq list nil) |
1549 |
(setq list (cdr list)) |
(setq list (cdr list)) |
1550 |
(incf i)) |
(incf i))) |
1551 |
i)) |
i)) |
1552 |
|
|
1553 |
(defun article-hide-headers (&optional arg delete) |
(defun article-hide-headers (&optional arg delete) |
1554 |
"Hide unwanted headers and possibly sort them as well." |
"Hide unwanted headers and possibly sort them as well." |
1555 |
(interactive) |
(interactive) |
1556 |
;; This function might be inhibited. |
;; This function might be inhibited. |
1557 |
(unless gnus-inhibit-hiding |
(unless gnus-inhibit-hiding |
1558 |
(save-excursion |
(let ((inhibit-read-only nil) |
1559 |
(save-restriction |
(case-fold-search t) |
1560 |
(let ((inhibit-read-only t) |
(max (1+ (length gnus-sorted-header-list))) |
1561 |
(case-fold-search t) |
(inhibit-point-motion-hooks t) |
1562 |
(max (1+ (length gnus-sorted-header-list))) |
(cur (current-buffer)) |
1563 |
(ignored (when (not gnus-visible-headers) |
ignored visible beg) |
1564 |
(cond ((stringp gnus-ignored-headers) |
(save-excursion |
1565 |
gnus-ignored-headers) |
;; `gnus-ignored-headers' and `gnus-visible-headers' may be |
1566 |
((listp gnus-ignored-headers) |
;; group parameters, so we should go to the summary buffer. |
1567 |
(mapconcat 'identity gnus-ignored-headers |
(when (prog1 |
1568 |
"\\|"))))) |
(condition-case nil |
1569 |
(visible |
(progn (set-buffer gnus-summary-buffer) t) |
1570 |
(cond ((stringp gnus-visible-headers) |
(error nil)) |
1571 |
gnus-visible-headers) |
(setq ignored (when (not gnus-visible-headers) |
1572 |
((and gnus-visible-headers |
(cond ((stringp gnus-ignored-headers) |
1573 |
(listp gnus-visible-headers)) |
gnus-ignored-headers) |
1574 |
(mapconcat 'identity gnus-visible-headers "\\|")))) |
((listp gnus-ignored-headers) |
1575 |
(inhibit-point-motion-hooks t) |
(mapconcat 'identity |
1576 |
beg) |
gnus-ignored-headers |
1577 |
|
"\\|")))) |
1578 |
|
visible (cond ((stringp gnus-visible-headers) |
1579 |
|
gnus-visible-headers) |
1580 |
|
((and gnus-visible-headers |
1581 |
|
(listp gnus-visible-headers)) |
1582 |
|
(mapconcat 'identity |
1583 |
|
gnus-visible-headers |
1584 |
|
"\\|"))))) |
1585 |
|
(set-buffer cur)) |
1586 |
|
(save-restriction |
1587 |
;; First we narrow to just the headers. |
;; First we narrow to just the headers. |
1588 |
(article-narrow-to-head) |
(article-narrow-to-head) |
1589 |
;; Hide any "From " lines at the beginning of (mail) articles. |
;; Hide any "From " lines at the beginning of (mail) articles. |
1596 |
;; `gnus-ignored-headers' and `gnus-visible-headers' to |
;; `gnus-ignored-headers' and `gnus-visible-headers' to |
1597 |
;; select which header lines is to remain visible in the |
;; select which header lines is to remain visible in the |
1598 |
;; article buffer. |
;; article buffer. |
1599 |
(while (re-search-forward "^[^ \t]*:" nil t) |
(while (re-search-forward "^[^ \t:]*:" nil t) |
1600 |
(beginning-of-line) |
(beginning-of-line) |
1601 |
;; Mark the rank of the header. |
;; Mark the rank of the header. |
1602 |
(put-text-property |
(put-text-property |
1611 |
(when (setq beg (text-property-any |
(when (setq beg (text-property-any |
1612 |
(point-min) (point-max) 'message-rank (+ 2 max))) |
(point-min) (point-max) 'message-rank (+ 2 max))) |
1613 |
;; We delete the unwanted headers. |
;; We delete the unwanted headers. |
1614 |
(push 'headers gnus-article-wash-types) |
(gnus-add-wash-type 'headers) |
1615 |
(add-text-properties (point-min) (+ 5 (point-min)) |
(add-text-properties (point-min) (+ 5 (point-min)) |
1616 |
'(article-type headers dummy-invisible t)) |
'(article-type headers dummy-invisible t)) |
1617 |
(delete-region beg (point-max)))))))) |
(delete-region beg (point-max)))))))) |
1639 |
(while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) |
(while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t) |
1640 |
(forward-line -1) |
(forward-line -1) |
1641 |
(gnus-article-hide-text-type |
(gnus-article-hide-text-type |
1642 |
(progn (beginning-of-line) (point)) |
(gnus-point-at-bol) |
1643 |
(progn |
(progn |
1644 |
(end-of-line) |
(end-of-line) |
1645 |
(if (re-search-forward "^[^ \t]" nil t) |
(if (re-search-forward "^[^ \t]" nil t) |
1648 |
'boring-headers))) |
'boring-headers))) |
1649 |
;; Hide boring Newsgroups header. |
;; Hide boring Newsgroups header. |
1650 |
((eq elem 'newsgroups) |
((eq elem 'newsgroups) |
1651 |
(when (equal (gnus-fetch-field "newsgroups") |
(when (gnus-string-equal |
1652 |
(gnus-group-real-name |
(gnus-fetch-field "newsgroups") |
1653 |
(if (boundp 'gnus-newsgroup-name) |
(gnus-group-real-name |
1654 |
gnus-newsgroup-name |
(if (boundp 'gnus-newsgroup-name) |
1655 |
""))) |
gnus-newsgroup-name |
1656 |
|
""))) |
1657 |
(gnus-article-hide-header "newsgroups"))) |
(gnus-article-hide-header "newsgroups"))) |
1658 |
|
((eq elem 'to-address) |
1659 |
|
(let ((to (message-fetch-field "to")) |
1660 |
|
(to-address |
1661 |
|
(gnus-parameter-to-address |
1662 |
|
(if (boundp 'gnus-newsgroup-name) |
1663 |
|
gnus-newsgroup-name "")))) |
1664 |
|
(when (and to to-address |
1665 |
|
(ignore-errors |
1666 |
|
(gnus-string-equal |
1667 |
|
;; only one address in To |
1668 |
|
(nth 1 (mail-extract-address-components to)) |
1669 |
|
to-address))) |
1670 |
|
(gnus-article-hide-header "to")))) |
1671 |
|
((eq elem 'to-list) |
1672 |
|
(let ((to (message-fetch-field "to")) |
1673 |
|
(to-list |
1674 |
|
(gnus-parameter-to-list |
1675 |
|
(if (boundp 'gnus-newsgroup-name) |
1676 |
|
gnus-newsgroup-name "")))) |
1677 |
|
(when (and to to-list |
1678 |
|
(ignore-errors |
1679 |
|
(gnus-string-equal |
1680 |
|
;; only one address in To |
1681 |
|
(nth 1 (mail-extract-address-components to)) |
1682 |
|
to-list))) |
1683 |
|
(gnus-article-hide-header "to")))) |
1684 |
|
((eq elem 'cc-list) |
1685 |
|
(let ((cc (message-fetch-field "cc")) |
1686 |
|
(to-list |
1687 |
|
(gnus-parameter-to-list |
1688 |
|
(if (boundp 'gnus-newsgroup-name) |
1689 |
|
gnus-newsgroup-name "")))) |
1690 |
|
(when (and cc to-list |
1691 |
|
(ignore-errors |
1692 |
|
(gnus-string-equal |
1693 |
|
;; only one address in CC |
1694 |
|
(nth 1 (mail-extract-address-components cc)) |
1695 |
|
to-list))) |
1696 |
|
(gnus-article-hide-header "cc")))) |
1697 |
((eq elem 'followup-to) |
((eq elem 'followup-to) |
1698 |
(when (equal (message-fetch-field "followup-to") |
(when (gnus-string-equal |
1699 |
(message-fetch-field "newsgroups")) |
(message-fetch-field "followup-to") |
1700 |
|
(message-fetch-field "newsgroups")) |
1701 |
(gnus-article-hide-header "followup-to"))) |
(gnus-article-hide-header "followup-to"))) |
1702 |
((eq elem 'reply-to) |
((eq elem 'reply-to) |
1703 |
(let ((from (message-fetch-field "from")) |
(if (gnus-group-find-parameter |
1704 |
(reply-to (message-fetch-field "reply-to"))) |
gnus-newsgroup-name 'broken-reply-to) |
1705 |
(when (and |
(gnus-article-hide-header "reply-to") |
1706 |
|
(let ((from (message-fetch-field "from")) |
1707 |
|
(reply-to (message-fetch-field "reply-to"))) |
1708 |
|
(when |
1709 |
|
(and |
1710 |
from reply-to |
from reply-to |
1711 |
(ignore-errors |
(ignore-errors |
1712 |
(equal |
(equal |
1713 |
(nth 1 (mail-extract-address-components from)) |
(sort (mapcar |
1714 |
(nth 1 (mail-extract-address-components reply-to))))) |
(lambda (x) (downcase (cadr x))) |
1715 |
(gnus-article-hide-header "reply-to")))) |
(mail-extract-address-components from t)) |
1716 |
|
'string<) |
1717 |
|
(sort (mapcar |
1718 |
|
(lambda (x) (downcase (cadr x))) |
1719 |
|
(mail-extract-address-components reply-to t)) |
1720 |
|
'string<)))) |
1721 |
|
(gnus-article-hide-header "reply-to"))))) |
1722 |
((eq elem 'date) |
((eq elem 'date) |
1723 |
(let ((date (message-fetch-field "date"))) |
(let ((date (message-fetch-field "date"))) |
1724 |
(when (and date |
(when (and date |
1765 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1766 |
(when (re-search-forward (concat "^" header ":") nil t) |
(when (re-search-forward (concat "^" header ":") nil t) |
1767 |
(gnus-article-hide-text-type |
(gnus-article-hide-text-type |
1768 |
(progn (beginning-of-line) (point)) |
(gnus-point-at-bol) |
1769 |
(progn |
(progn |
1770 |
(end-of-line) |
(end-of-line) |
1771 |
(if (re-search-forward "^[^ \t]" nil t) |
(if (re-search-forward "^[^ \t]" nil t) |
1805 |
(forward-line 1)))))) |
(forward-line 1)))))) |
1806 |
|
|
1807 |
(defun article-treat-dumbquotes () |
(defun article-treat-dumbquotes () |
1808 |
"Translate M****s*** sm*rtq**t*s into proper text. |
"Translate M****s*** sm*rtq**t*s and other symbols into proper text. |
1809 |
Note that this function guesses whether a character is a sm*rtq**t* or |
Note that this function guesses whether a character is a sm*rtq**t* or |
1810 |
not, so it should only be used interactively. |
not, so it should only be used interactively. |
1811 |
|
|
1812 |
Sm*rtq**t*s are M****s***'s unilateral extension to the character map |
Sm*rtq**t*s are M****s***'s unilateral extension to the |
1813 |
in an attempt to provide more quoting characters. If you see |
iso-8859-1 character map in an attempt to provide more quoting |
1814 |
something like \\222 or \\264 where you're expecting some kind of |
characters. If you see something like \\222 or \\264 where |
1815 |
apostrophe or quotation mark, then try this wash." |
you're expecting some kind of apostrophe or quotation mark, then |
1816 |
|
try this wash." |
1817 |
(interactive) |
(interactive) |
1818 |
(article-translate-strings gnus-article-dumbquotes-map)) |
(article-translate-strings gnus-article-dumbquotes-map)) |
1819 |
|
|
1872 |
(put-text-property |
(put-text-property |
1873 |
(point) (1+ (point)) 'face 'underline))))))))) |
(point) (1+ (point)) 'face 'underline))))))))) |
1874 |
|
|
1875 |
|
(defun gnus-article-treat-unfold-headers () |
1876 |
|
"Unfold folded message headers. |
1877 |
|
Only the headers that fit into the current window width will be |
1878 |
|
unfolded." |
1879 |
|
(interactive) |
1880 |
|
(gnus-with-article-headers |
1881 |
|
(let (length) |
1882 |
|
(while (not (eobp)) |
1883 |
|
(save-restriction |
1884 |
|
(mail-header-narrow-to-field) |
1885 |
|
(let ((header (buffer-string))) |
1886 |
|
(with-temp-buffer |
1887 |
|
(insert header) |
1888 |
|
(goto-char (point-min)) |
1889 |
|
(while (re-search-forward "\n[\t ]" nil t) |
1890 |
|
(replace-match " " t t))) |
1891 |
|
(setq length (- (point-max) (point-min) 1))) |
1892 |
|
(when (< length (window-width)) |
1893 |
|
(while (re-search-forward "\n[\t ]" nil t) |
1894 |
|
(replace-match " " t t))) |
1895 |
|
(goto-char (point-max))))))) |
1896 |
|
|
1897 |
|
(defun gnus-article-treat-fold-headers () |
1898 |
|
"Fold message headers." |
1899 |
|
(interactive) |
1900 |
|
(gnus-with-article-headers |
1901 |
|
(while (not (eobp)) |
1902 |
|
(save-restriction |
1903 |
|
(mail-header-narrow-to-field) |
1904 |
|
(mail-header-fold-field) |
1905 |
|
(goto-char (point-max)))))) |
1906 |
|
|
1907 |
|
(defun gnus-treat-smiley () |
1908 |
|
"Toggle display of textual emoticons (\"smileys\") as small graphical icons." |
1909 |
|
(interactive) |
1910 |
|
(gnus-with-article-buffer |
1911 |
|
(if (memq 'smiley gnus-article-wash-types) |
1912 |
|
(gnus-delete-images 'smiley) |
1913 |
|
(article-goto-body) |
1914 |
|
(let ((images (smiley-region (point) (point-max)))) |
1915 |
|
(when images |
1916 |
|
(gnus-add-wash-type 'smiley) |
1917 |
|
(dolist (image images) |
1918 |
|
(gnus-add-image 'smiley image))))))) |
1919 |
|
|
1920 |
|
(defun gnus-article-remove-images () |
1921 |
|
"Remove all images from the article buffer." |
1922 |
|
(interactive) |
1923 |
|
(gnus-with-article-buffer |
1924 |
|
(dolist (elem gnus-article-image-alist) |
1925 |
|
(gnus-delete-images (car elem))))) |
1926 |
|
|
1927 |
|
(defun gnus-article-treat-fold-newsgroups () |
1928 |
|
"Unfold folded message headers. |
1929 |
|
Only the headers that fit into the current window width will be |
1930 |
|
unfolded." |
1931 |
|
(interactive) |
1932 |
|
(gnus-with-article-headers |
1933 |
|
(while (gnus-article-goto-header "newsgroups\\|followup-to") |
1934 |
|
(save-restriction |
1935 |
|
(mail-header-narrow-to-field) |
1936 |
|
(while (re-search-forward ", *" nil t) |
1937 |
|
(replace-match ", " t t)) |
1938 |
|
(mail-header-fold-field) |
1939 |
|
(goto-char (point-max)))))) |
1940 |
|
|
1941 |
|
(defun gnus-article-treat-body-boundary () |
1942 |
|
"Place a boundary line at the end of the headers." |
1943 |
|
(interactive) |
1944 |
|
(when (and gnus-body-boundary-delimiter |
1945 |
|
(> (length gnus-body-boundary-delimiter) 0)) |
1946 |
|
(gnus-with-article-headers |
1947 |
|
(goto-char (point-max)) |
1948 |
|
(let ((start (point))) |
1949 |
|
(insert "X-Boundary: ") |
1950 |
|
(gnus-add-text-properties start (point) '(invisible t intangible t)) |
1951 |
|
(insert (let (str) |
1952 |
|
(while (>= (1- (window-width)) (length str)) |
1953 |
|
(setq str (concat str gnus-body-boundary-delimiter))) |
1954 |
|
(substring str 0 (1- (window-width)))) |
1955 |
|
"\n") |
1956 |
|
(gnus-put-text-property start (point) 'gnus-decoration 'header))))) |
1957 |
|
|
1958 |
(defun article-fill-long-lines () |
(defun article-fill-long-lines () |
1959 |
"Fill lines that are wider than the window width." |
"Fill lines that are wider than the window width." |
1960 |
(interactive) |
(interactive) |
1967 |
(while (not (eobp)) |
(while (not (eobp)) |
1968 |
(end-of-line) |
(end-of-line) |
1969 |
(when (>= (current-column) (min fill-column width)) |
(when (>= (current-column) (min fill-column width)) |
1970 |
(narrow-to-region (point) (gnus-point-at-bol)) |
(narrow-to-region (min (1+ (point)) (point-max)) |
1971 |
(fill-paragraph nil) |
(gnus-point-at-bol)) |
1972 |
(goto-char (point-max)) |
(let ((goback (point-marker))) |
1973 |
|
(fill-paragraph nil) |
1974 |
|
(goto-char (marker-position goback))) |
1975 |
(widen)) |
(widen)) |
1976 |
(forward-line 1))))))) |
(forward-line 1))))))) |
1977 |
|
|
2015 |
(forward-line 1) |
(forward-line 1) |
2016 |
(point)))))) |
(point)))))) |
2017 |
|
|
2018 |
|
(defun article-display-face () |
2019 |
|
"Display any Face headers in the header." |
2020 |
|
(interactive) |
2021 |
|
(let ((wash-face-p buffer-read-only)) |
2022 |
|
(gnus-with-article-headers |
2023 |
|
;; When displaying parts, this function can be called several times on |
2024 |
|
;; the same article, without any intended toggle semantic (as typing `W |
2025 |
|
;; D d' would have). So face deletion must occur only when we come from |
2026 |
|
;; an interactive command, that is when the *Article* buffer is |
2027 |
|
;; read-only. |
2028 |
|
(if (and wash-face-p (memq 'face gnus-article-wash-types)) |
2029 |
|
(gnus-delete-images 'face) |
2030 |
|
(let (face faces) |
2031 |
|
(save-excursion |
2032 |
|
(when (and wash-face-p |
2033 |
|
(progn |
2034 |
|
(goto-char (point-min)) |
2035 |
|
(not (re-search-forward "^Face:[\t ]*" nil t))) |
2036 |
|
(gnus-buffer-live-p gnus-original-article-buffer)) |
2037 |
|
(set-buffer gnus-original-article-buffer)) |
2038 |
|
(save-restriction |
2039 |
|
(mail-narrow-to-head) |
2040 |
|
(while (gnus-article-goto-header "Face") |
2041 |
|
(push (mail-header-field-value) faces)))) |
2042 |
|
(while (setq face (pop faces)) |
2043 |
|
(let ((png (gnus-convert-face-to-png face)) |
2044 |
|
image) |
2045 |
|
(when png |
2046 |
|
(setq image (gnus-create-image png 'png t)) |
2047 |
|
(gnus-article-goto-header "from") |
2048 |
|
(when (bobp) |
2049 |
|
(insert "From: [no `from' set]\n") |
2050 |
|
(forward-char -17)) |
2051 |
|
(gnus-add-wash-type 'face) |
2052 |
|
(gnus-add-image 'face image) |
2053 |
|
(gnus-put-image image nil 'face)))))) |
2054 |
|
))) |
2055 |
|
|
2056 |
(defun article-display-x-face (&optional force) |
(defun article-display-x-face (&optional force) |
2057 |
"Look for an X-Face header and display it if present." |
"Look for an X-Face header and display it if present." |
2058 |
(interactive (list 'force)) |
(interactive (list 'force)) |
2059 |
(save-excursion |
(let ((wash-face-p buffer-read-only)) ;; When type `W f' |
2060 |
;; Delete the old process, if any. |
(gnus-with-article-headers |
2061 |
(when (process-status "article-x-face") |
;; Delete the old process, if any. |
2062 |
(delete-process "article-x-face")) |
(when (process-status "article-x-face") |
2063 |
(let ((inhibit-point-motion-hooks t) |
(delete-process "article-x-face")) |
2064 |
(case-fold-search t) |
;; See the comment in `article-display-face'. |
2065 |
from last) |
(if (and wash-face-p (memq 'xface gnus-article-wash-types)) |
2066 |
(save-restriction |
;; We have already displayed X-Faces, so we remove them |
2067 |
(article-narrow-to-head) |
;; instead. |
2068 |
(goto-char (point-min)) |
(gnus-delete-images 'xface) |
2069 |
(setq from (message-fetch-field "from")) |
;; Display X-Faces. |
2070 |
(goto-char (point-min)) |
(let (x-faces from face) |
|
(while (and gnus-article-x-face-command |
|
|
(not last) |
|
|
(or force |
|
|
;; Check whether this face is censored. |
|
|
(not gnus-article-x-face-too-ugly) |
|
|
(and gnus-article-x-face-too-ugly from |
|
|
(not (string-match gnus-article-x-face-too-ugly |
|
|
from)))) |
|
|
;; Has to be present. |
|
|
(re-search-forward "^X-Face: " nil t)) |
|
|
;; This used to try to do multiple faces (`while' instead of |
|
|
;; `when' above), but (a) sending multiple EOFs to xv doesn't |
|
|
;; work (b) it can crash some versions of Emacs (c) are |
|
|
;; multiple faces really something to encourage? |
|
|
(when (stringp gnus-article-x-face-command) |
|
|
(setq last t)) |
|
|
;; We now have the area of the buffer where the X-Face is stored. |
|
2071 |
(save-excursion |
(save-excursion |
2072 |
(let ((beg (point)) |
(when (and wash-face-p |
2073 |
(end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) |
(progn |
2074 |
;; We display the face. |
(goto-char (point-min)) |
2075 |
(if (symbolp gnus-article-x-face-command) |
(not (re-search-forward |
2076 |
;; The command is a lisp function, so we call it. |
"^X-Face\\(-[0-9]+\\)?:[\t ]*" nil t))) |
2077 |
(if (gnus-functionp gnus-article-x-face-command) |
(gnus-buffer-live-p gnus-original-article-buffer)) |
2078 |
(funcall gnus-article-x-face-command beg end) |
;; If type `W f', use gnus-original-article-buffer, |
2079 |
(error "%s is not a function" gnus-article-x-face-command)) |
;; otherwise use the current buffer because displaying |
2080 |
;; The command is a string, so we interpret the command |
;; RFC822 parts calls this function too. |
2081 |
;; as a, well, command, and fork it off. |
(set-buffer gnus-original-article-buffer)) |
2082 |
(let ((process-connection-type nil)) |
(save-restriction |
2083 |
(process-kill-without-query |
(mail-narrow-to-head) |
2084 |
(start-process |
(while (gnus-article-goto-header "X-Face") |
2085 |
"article-x-face" nil shell-file-name shell-command-switch |
(push (mail-header-field-value) x-faces)) |
2086 |
gnus-article-x-face-command)) |
(setq from (message-fetch-field "from")))) |
2087 |
(process-send-region "article-x-face" beg end) |
;; Sending multiple EOFs to xv doesn't work, so we only do a |
2088 |
(process-send-eof "article-x-face")))))))))) |
;; single external face. |
2089 |
|
(when (stringp gnus-article-x-face-command) |
2090 |
|
(setq x-faces (list (car x-faces)))) |
2091 |
|
(while (and (setq face (pop x-faces)) |
2092 |
|
gnus-article-x-face-command |
2093 |
|
(or force |
2094 |
|
;; Check whether this face is censored. |
2095 |
|
(not gnus-article-x-face-too-ugly) |
2096 |
|
(and gnus-article-x-face-too-ugly from |
2097 |
|
(not (string-match gnus-article-x-face-too-ugly |
2098 |
|
from))))) |
2099 |
|
;; We display the face. |
2100 |
|
(cond ((stringp gnus-article-x-face-command) |
2101 |
|
;; The command is a string, so we interpret the command |
2102 |
|
;; as a, well, command, and fork it off. |
2103 |
|
(let ((process-connection-type nil)) |
2104 |
|
(process-kill-without-query |
2105 |
|
(start-process |
2106 |
|
"article-x-face" nil shell-file-name |
2107 |
|
shell-command-switch gnus-article-x-face-command)) |
2108 |
|
(with-temp-buffer |
2109 |
|
(insert face) |
2110 |
|
(process-send-region "article-x-face" |
2111 |
|
(point-min) (point-max))) |
2112 |
|
(process-send-eof "article-x-face"))) |
2113 |
|
((functionp gnus-article-x-face-command) |
2114 |
|
;; The command is a lisp function, so we call it. |
2115 |
|
(funcall gnus-article-x-face-command face)) |
2116 |
|
(t |
2117 |
|
(error "%s is not a function" |
2118 |
|
gnus-article-x-face-command))))))))) |
2119 |
|
|
2120 |
(defun article-decode-mime-words () |
(defun article-decode-mime-words () |
2121 |
"Decode all MIME-encoded words in the article." |
"Decode all MIME-encoded words in the article." |
2123 |
(save-excursion |
(save-excursion |
2124 |
(set-buffer gnus-article-buffer) |
(set-buffer gnus-article-buffer) |
2125 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2126 |
buffer-read-only |
(inhibit-read-only t) |
2127 |
(mail-parse-charset gnus-newsgroup-charset) |
(mail-parse-charset gnus-newsgroup-charset) |
2128 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
2129 |
(save-excursion (set-buffer gnus-summary-buffer) |
(save-excursion (set-buffer gnus-summary-buffer) |
2135 |
If PROMPT (the prefix), prompt for a coding system to use." |
If PROMPT (the prefix), prompt for a coding system to use." |
2136 |
(interactive "P") |
(interactive "P") |
2137 |
(let ((inhibit-point-motion-hooks t) (case-fold-search t) |
(let ((inhibit-point-motion-hooks t) (case-fold-search t) |
2138 |
buffer-read-only |
(inhibit-read-only t) |
2139 |
(mail-parse-charset gnus-newsgroup-charset) |
(mail-parse-charset gnus-newsgroup-charset) |
2140 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
2141 |
(save-excursion (condition-case nil |
(save-excursion (condition-case nil |
2185 |
(set-buffer gnus-summary-buffer) |
(set-buffer gnus-summary-buffer) |
2186 |
(error)) |
(error)) |
2187 |
gnus-newsgroup-ignored-charsets)) |
gnus-newsgroup-ignored-charsets)) |
2188 |
buffer-read-only) |
(inhibit-read-only t)) |
2189 |
(save-restriction |
(save-restriction |
2190 |
(article-narrow-to-head) |
(article-narrow-to-head) |
2191 |
(funcall gnus-decode-header-function (point-min) (point-max))))) |
(funcall gnus-decode-header-function (point-min) (point-max))))) |
2192 |
|
|
2193 |
(defun article-de-quoted-unreadable (&optional force) |
(defun article-decode-group-name () |
2194 |
|
"Decode group names in `Newsgroups:'." |
2195 |
|
(let ((inhibit-point-motion-hooks t) |
2196 |
|
(inhibit-read-only t) |
2197 |
|
(method (gnus-find-method-for-group gnus-newsgroup-name))) |
2198 |
|
(when (and (or gnus-group-name-charset-method-alist |
2199 |
|
gnus-group-name-charset-group-alist) |
2200 |
|
(gnus-buffer-live-p gnus-original-article-buffer)) |
2201 |
|
(save-restriction |
2202 |
|
(article-narrow-to-head) |
2203 |
|
(with-current-buffer gnus-original-article-buffer |
2204 |
|
(goto-char (point-min))) |
2205 |
|
(while (re-search-forward |
2206 |
|
"^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) |
2207 |
|
(replace-match (save-match-data |
2208 |
|
(gnus-decode-newsgroups |
2209 |
|
;; XXX how to use data in article buffer? |
2210 |
|
(with-current-buffer gnus-original-article-buffer |
2211 |
|
(re-search-forward |
2212 |
|
"^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" |
2213 |
|
nil t) |
2214 |
|
(match-string 1)) |
2215 |
|
gnus-newsgroup-name method)) |
2216 |
|
t t nil 1)) |
2217 |
|
(goto-char (point-min)) |
2218 |
|
(with-current-buffer gnus-original-article-buffer |
2219 |
|
(goto-char (point-min))) |
2220 |
|
(while (re-search-forward |
2221 |
|
"^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t) |
2222 |
|
(replace-match (save-match-data |
2223 |
|
(gnus-decode-newsgroups |
2224 |
|
;; XXX how to use data in article buffer? |
2225 |
|
(with-current-buffer gnus-original-article-buffer |
2226 |
|
(re-search-forward |
2227 |
|
"^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" |
2228 |
|
nil t) |
2229 |
|
(match-string 1)) |
2230 |
|
gnus-newsgroup-name method)) |
2231 |
|
t t nil 1)))))) |
2232 |
|
|
2233 |
|
(autoload 'idna-to-unicode "idna") |
2234 |
|
|
2235 |
|
(defun article-decode-idna-rhs () |
2236 |
|
"Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer." |
2237 |
|
(when gnus-use-idna |
2238 |
|
(save-restriction |
2239 |
|
(let ((inhibit-point-motion-hooks t) |
2240 |
|
(inhibit-read-only t)) |
2241 |
|
(article-narrow-to-head) |
2242 |
|
(goto-char (point-min)) |
2243 |
|
(while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) |
2244 |
|
(let (ace unicode) |
2245 |
|
(when (save-match-data |
2246 |
|
(and (setq ace (match-string 1)) |
2247 |
|
(save-excursion |
2248 |
|
(and (re-search-backward "^[^ \t]" nil t) |
2249 |
|
(looking-at "From\\|To\\|Cc"))) |
2250 |
|
(setq unicode (idna-to-unicode ace)))) |
2251 |
|
(unless (string= ace unicode) |
2252 |
|
(replace-match unicode nil nil nil 1))))))))) |
2253 |
|
|
2254 |
|
(defun article-de-quoted-unreadable (&optional force read-charset) |
2255 |
"Translate a quoted-printable-encoded article. |
"Translate a quoted-printable-encoded article. |
2256 |
If FORCE, decode the article whether it is marked as quoted-printable |
If FORCE, decode the article whether it is marked as quoted-printable |
2257 |
or not." |
or not. |
2258 |
(interactive (list 'force)) |
If READ-CHARSET, ask for a coding system." |
2259 |
|
(interactive (list 'force current-prefix-arg)) |
2260 |
(save-excursion |
(save-excursion |
2261 |
(let ((inhibit-read-only t) type charset) |
(let ((inhibit-read-only t) type charset) |
2262 |
(if (gnus-buffer-live-p gnus-original-article-buffer) |
(if (gnus-buffer-live-p gnus-original-article-buffer) |
2271 |
(mail-content-type-get ctl 'charset))) |
(mail-content-type-get ctl 'charset))) |
2272 |
(if (stringp charset) |
(if (stringp charset) |
2273 |
(setq charset (intern (downcase charset))))))) |
(setq charset (intern (downcase charset))))))) |
2274 |
|
(if read-charset |
2275 |
|
(setq charset (mm-read-coding-system "Charset: " charset))) |
2276 |
(unless charset |
(unless charset |
2277 |
(setq charset gnus-newsgroup-charset)) |
(setq charset gnus-newsgroup-charset)) |
2278 |
(when (or force |
(when (or force |
2282 |
(quoted-printable-decode-region |
(quoted-printable-decode-region |
2283 |
(point) (point-max) (mm-charset-to-coding-system charset)))))) |
(point) (point-max) (mm-charset-to-coding-system charset)))))) |
2284 |
|
|
2285 |
(defun article-de-base64-unreadable (&optional force) |
(defun article-de-base64-unreadable (&optional force read-charset) |
2286 |
"Translate a base64 article. |
"Translate a base64 article. |
2287 |
If FORCE, decode the article whether it is marked as base64 not." |
If FORCE, decode the article whether it is marked as base64 not. |
2288 |
(interactive (list 'force)) |
If READ-CHARSET, ask for a coding system." |
2289 |
|
(interactive (list 'force current-prefix-arg)) |
2290 |
(save-excursion |
(save-excursion |
2291 |
(let ((inhibit-read-only t) type charset) |
(let ((inhibit-read-only t) type charset) |
2292 |
(if (gnus-buffer-live-p gnus-original-article-buffer) |
(if (gnus-buffer-live-p gnus-original-article-buffer) |
2301 |
(mail-content-type-get ctl 'charset))) |
(mail-content-type-get ctl 'charset))) |
2302 |
(if (stringp charset) |
(if (stringp charset) |
2303 |
(setq charset (intern (downcase charset))))))) |
(setq charset (intern (downcase charset))))))) |
2304 |
|
(if read-charset |
2305 |
|
(setq charset (mm-read-coding-system "Charset: " charset))) |
2306 |
(unless charset |
(unless charset |
2307 |
(setq charset gnus-newsgroup-charset)) |
(setq charset gnus-newsgroup-charset)) |
2308 |
(when (or force |
(when (or force |
2326 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
2327 |
(rfc1843-decode-region (point-min) (point-max))))) |
(rfc1843-decode-region (point-min) (point-max))))) |
2328 |
|
|
2329 |
(defun article-wash-html () |
(defun article-unsplit-urls () |
2330 |
"Format an html article." |
"Remove the newlines that some other mailers insert into URLs." |
2331 |
(interactive) |
(interactive) |
2332 |
(save-excursion |
(save-excursion |
2333 |
|
(let ((inhibit-read-only t)) |
2334 |
|
(goto-char (point-min)) |
2335 |
|
(while (re-search-forward |
2336 |
|
"^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) |
2337 |
|
(replace-match "\\1\\3" t))) |
2338 |
|
(when (interactive-p) |
2339 |
|
(gnus-treat-article nil)))) |
2340 |
|
|
2341 |
|
|
2342 |
|
(defun article-wash-html (&optional read-charset) |
2343 |
|
"Format an HTML article. |
2344 |
|
If READ-CHARSET, ask for a coding system." |
2345 |
|
(interactive "P") |
2346 |
|
(save-excursion |
2347 |
(let ((inhibit-read-only t) |
(let ((inhibit-read-only t) |
2348 |
charset) |
charset) |
2349 |
(if (gnus-buffer-live-p gnus-original-article-buffer) |
(when (gnus-buffer-live-p gnus-original-article-buffer) |
2350 |
(with-current-buffer gnus-original-article-buffer |
(with-current-buffer gnus-original-article-buffer |
2351 |
(let* ((ct (gnus-fetch-field "content-type")) |
(let* ((ct (gnus-fetch-field "content-type")) |
2352 |
(ctl (and ct |
(ctl (and ct |
2353 |
(ignore-errors |
(ignore-errors |
2354 |
(mail-header-parse-content-type ct))))) |
(mail-header-parse-content-type ct))))) |
2355 |
(setq charset (and ctl |
(setq charset (and ctl |
2356 |
(mail-content-type-get ctl 'charset))) |
(mail-content-type-get ctl 'charset))) |
2357 |
(if (stringp charset) |
(when (stringp charset) |
2358 |
(setq charset (intern (downcase charset))))))) |
(setq charset (intern (downcase charset))))))) |
2359 |
|
(when read-charset |
2360 |
|
(setq charset (mm-read-coding-system "Charset: " charset))) |
2361 |
(unless charset |
(unless charset |
2362 |
(setq charset gnus-newsgroup-charset)) |
(setq charset gnus-newsgroup-charset)) |
2363 |
(article-goto-body) |
(article-goto-body) |
2364 |
(save-window-excursion |
(save-window-excursion |
2365 |
(save-restriction |
(save-restriction |
2366 |
(narrow-to-region (point) (point-max)) |
(narrow-to-region (point) (point-max)) |
2367 |
(mm-setup-w3) |
(let* ((func (or gnus-article-wash-function mm-text-html-renderer)) |
2368 |
(let ((w3-strict-width (window-width)) |
(entry (assq func mm-text-html-washer-alist))) |
2369 |
(url-gateway-unplugged t) |
(when entry |
2370 |
(url-standalone-mode t)) |
(setq func (cdr entry))) |
2371 |
(condition-case var |
(cond |
2372 |
(w3-region (point-min) (point-max)) |
((functionp func) |
2373 |
(error)))))))) |
(funcall func)) |
2374 |
|
(t |
2375 |
|
(apply (car func) (cdr func)))))))))) |
2376 |
|
|
2377 |
|
(defun gnus-article-wash-html-with-w3 () |
2378 |
|
"Wash the current buffer with w3." |
2379 |
|
(mm-setup-w3) |
2380 |
|
(let ((w3-strict-width (window-width)) |
2381 |
|
(url-standalone-mode t) |
2382 |
|
(url-gateway-unplugged t) |
2383 |
|
(w3-honor-stylesheets nil)) |
2384 |
|
(condition-case () |
2385 |
|
(w3-region (point-min) (point-max)) |
2386 |
|
(error)))) |
2387 |
|
|
2388 |
|
(defun gnus-article-wash-html-with-w3m () |
2389 |
|
"Wash the current buffer with emacs-w3m." |
2390 |
|
(mm-setup-w3m) |
2391 |
|
(save-restriction |
2392 |
|
(narrow-to-region (point) (point-max)) |
2393 |
|
(let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp) |
2394 |
|
w3m-force-redisplay) |
2395 |
|
(w3m-region (point-min) (point-max))) |
2396 |
|
(when (and mm-inline-text-html-with-w3m-keymap |
2397 |
|
(boundp 'w3m-minor-mode-map) |
2398 |
|
w3m-minor-mode-map) |
2399 |
|
(add-text-properties |
2400 |
|
(point-min) (point-max) |
2401 |
|
(list 'keymap w3m-minor-mode-map |
2402 |
|
;; Put the mark meaning this part was rendered by emacs-w3m. |
2403 |
|
'mm-inline-text-html-with-w3m t))))) |
2404 |
|
|
2405 |
(defun article-hide-list-identifiers () |
(defun article-hide-list-identifiers () |
2406 |
"Remove list identifies from the Subject header. |
"Remove list identifies from the Subject header. |
2407 |
The `gnus-list-identifiers' variable specifies what to do." |
The `gnus-list-identifiers' variable specifies what to do." |
2408 |
(interactive) |
(interactive) |
2409 |
(save-excursion |
(let ((inhibit-point-motion-hooks t) |
2410 |
(save-restriction |
(regexp (if (consp gnus-list-identifiers) |
2411 |
(let ((inhibit-point-motion-hooks t) |
(mapconcat 'identity gnus-list-identifiers " *\\|") |
2412 |
buffer-read-only) |
gnus-list-identifiers)) |
2413 |
(article-narrow-to-head) |
(inhibit-read-only t)) |
2414 |
(let ((regexp (if (stringp gnus-list-identifiers) gnus-list-identifiers |
(when regexp |
2415 |
(mapconcat 'identity gnus-list-identifiers " *\\|")))) |
(save-excursion |
2416 |
(when regexp |
(save-restriction |
2417 |
(goto-char (point-min)) |
(article-narrow-to-head) |
2418 |
(when (re-search-forward |
(goto-char (point-min)) |
2419 |
(concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp |
(while (re-search-forward |
2420 |
" *\\)\\)+\\(Re: +\\)?\\)") |
(concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)") |
2421 |
nil t) |
nil t) |
2422 |
(let ((s (or (match-string 3) (match-string 5)))) |
(delete-region (match-beginning 2) (match-end 0)) |
2423 |
(delete-region (match-beginning 1) (match-end 1)) |
(beginning-of-line)) |
2424 |
(when s |
(when (re-search-forward |
2425 |
(goto-char (match-beginning 1)) |
"^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t) |
2426 |
(insert s)))))))))) |
(delete-region (match-beginning 1) (match-end 1)))))))) |
|
|
|
|
(defun article-hide-pgp () |
|
|
"Remove any PGP headers and signatures in the current article." |
|
|
(interactive) |
|
|
(save-excursion |
|
|
(save-restriction |
|
|
(let ((inhibit-point-motion-hooks t) |
|
|
buffer-read-only beg end) |
|
|
(article-goto-body) |
|
|
;; Hide the "header". |
|
|
(when (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) |
|
|
(push 'pgp gnus-article-wash-types) |
|
|
(delete-region (match-beginning 0) (match-end 0)) |
|
|
;; Remove armor headers (rfc2440 6.2) |
|
|
(delete-region (point) (or (re-search-forward "^[ \t]*\n" nil t) |
|
|
(point))) |
|
|
(setq beg (point)) |
|
|
;; Hide the actual signature. |
|
|
(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) |
|
|
(setq end (1+ (match-beginning 0))) |
|
|
(delete-region |
|
|
end |
|
|
(if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) |
|
|
(match-end 0) |
|
|
;; Perhaps we shouldn't hide to the end of the buffer |
|
|
;; if there is no end to the signature? |
|
|
(point-max)))) |
|
|
;; Hide "- " PGP quotation markers. |
|
|
(when (and beg end) |
|
|
(narrow-to-region beg end) |
|
|
(goto-char (point-min)) |
|
|
(while (re-search-forward "^- " nil t) |
|
|
(delete-region |
|
|
(match-beginning 0) (match-end 0))) |
|
|
(widen)) |
|
|
(gnus-run-hooks 'gnus-article-hide-pgp-hook)))))) |
|
2427 |
|
|
2428 |
(defun article-hide-pem (&optional arg) |
(defun article-hide-pem (&optional arg) |
2429 |
"Toggle hiding of any PEM headers and signatures in the current article. |
"Toggle hiding of any PEM headers and signatures in the current article. |
2432 |
(interactive (gnus-article-hidden-arg)) |
(interactive (gnus-article-hidden-arg)) |
2433 |
(unless (gnus-article-check-hidden-text 'pem arg) |
(unless (gnus-article-check-hidden-text 'pem arg) |
2434 |
(save-excursion |
(save-excursion |
2435 |
(let (buffer-read-only end) |
(let ((inhibit-read-only t) end) |
2436 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2437 |
;; Hide the horrendously ugly "header". |
;; Hide the horrendously ugly "header". |
2438 |
(when (and (search-forward |
(when (and (search-forward |
2439 |
"\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" |
"\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" |
2440 |
nil t) |
nil t) |
2441 |
(setq end (1+ (match-beginning 0)))) |
(setq end (1+ (match-beginning 0)))) |
2442 |
(push 'pem gnus-article-wash-types) |
(gnus-add-wash-type 'pem) |
2443 |
(gnus-article-hide-text-type |
(gnus-article-hide-text-type |
2444 |
end |
end |
2445 |
(if (search-forward "\n\n" nil t) |
(if (search-forward "\n\n" nil t) |
2453 |
(match-beginning 0) (match-end 0) 'pem))))))) |
(match-beginning 0) (match-end 0) 'pem))))))) |
2454 |
|
|
2455 |
(defun article-strip-banner () |
(defun article-strip-banner () |
2456 |
"Strip the banner specified by the `banner' group parameter." |
"Strip the banners specified by the `banner' group parameter and by |
2457 |
|
`gnus-article-address-banner-alist'." |
2458 |
(interactive) |
(interactive) |
2459 |
(save-excursion |
(save-excursion |
2460 |
(save-restriction |
(save-restriction |
2461 |
|
(let ((inhibit-point-motion-hooks t)) |
2462 |
|
(when (gnus-parameter-banner gnus-newsgroup-name) |
2463 |
|
(article-really-strip-banner |
2464 |
|
(gnus-parameter-banner gnus-newsgroup-name))) |
2465 |
|
(when gnus-article-address-banner-alist |
2466 |
|
(article-really-strip-banner |
2467 |
|
(let ((from (save-restriction |
2468 |
|
(widen) |
2469 |
|
(article-narrow-to-head) |
2470 |
|
(mail-fetch-field "from")))) |
2471 |
|
(when (and from |
2472 |
|
(setq from |
2473 |
|
(caar (mail-header-parse-addresses from)))) |
2474 |
|
(catch 'found |
2475 |
|
(dolist (pair gnus-article-address-banner-alist) |
2476 |
|
(when (string-match (car pair) from) |
2477 |
|
(throw 'found (cdr pair))))))))))))) |
2478 |
|
|
2479 |
|
(defun article-really-strip-banner (banner) |
2480 |
|
"Strip the banner specified by the argument." |
2481 |
|
(save-excursion |
2482 |
|
(save-restriction |
2483 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
|
(banner (gnus-group-find-parameter gnus-newsgroup-name 'banner)) |
|
2484 |
(gnus-signature-limit nil) |
(gnus-signature-limit nil) |
2485 |
buffer-read-only beg end) |
(inhibit-read-only t)) |
2486 |
(when banner |
(article-goto-body) |
2487 |
(article-goto-body) |
(cond |
2488 |
(cond |
((eq banner 'signature) |
2489 |
((eq banner 'signature) |
(when (gnus-article-narrow-to-signature) |
2490 |
(when (gnus-article-narrow-to-signature) |
(widen) |
2491 |
(widen) |
(forward-line -1) |
2492 |
(forward-line -1) |
(delete-region (point) (point-max)))) |
2493 |
(delete-region (point) (point-max)))) |
((symbolp banner) |
2494 |
((symbolp banner) |
(if (setq banner (cdr (assq banner gnus-article-banner-alist))) |
2495 |
(if (setq banner (cdr (assq banner gnus-article-banner-alist))) |
(while (re-search-forward banner nil t) |
2496 |
(while (re-search-forward banner nil t) |
(delete-region (match-beginning 0) (match-end 0))))) |
2497 |
(delete-region (match-beginning 0) (match-end 0))))) |
((stringp banner) |
2498 |
((stringp banner) |
(while (re-search-forward banner nil t) |
2499 |
(while (re-search-forward banner nil t) |
(delete-region (match-beginning 0) (match-end 0))))))))) |
|
(delete-region (match-beginning 0) (match-end 0)))))))))) |
|
2500 |
|
|
2501 |
(defun article-babel () |
(defun article-babel () |
2502 |
"Translate article using an online translation service." |
"Translate article using an online translation service." |
2509 |
(start (point)) |
(start (point)) |
2510 |
(end (point-max)) |
(end (point-max)) |
2511 |
(orig (buffer-substring start end)) |
(orig (buffer-substring start end)) |
2512 |
(trans (babel-as-string orig))) |
(trans (babel-as-string orig))) |
2513 |
(save-restriction |
(save-restriction |
2514 |
(narrow-to-region start end) |
(narrow-to-region start end) |
2515 |
(delete-region start end) |
(delete-region start end) |
2516 |
(insert trans)))))) |
(insert trans)))))) |
2517 |
|
|
2518 |
(defun article-hide-signature (&optional arg) |
(defun article-hide-signature (&optional arg) |
2519 |
"Hide the signature in the current article. |
"Hide the signature in the current article. |
2526 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
2527 |
(when (gnus-article-narrow-to-signature) |
(when (gnus-article-narrow-to-signature) |
2528 |
(gnus-article-hide-text-type |
(gnus-article-hide-text-type |
2529 |
(point-min) (point-max) 'signature))))))) |
(point-min) (point-max) 'signature)))))) |
2530 |
|
(gnus-set-mode-line 'article)) |
2531 |
|
|
2532 |
(defun article-strip-headers-in-body () |
(defun article-strip-headers-in-body () |
2533 |
"Strip offensive headers from bodies." |
"Strip offensive headers from bodies." |
2543 |
(interactive) |
(interactive) |
2544 |
(save-excursion |
(save-excursion |
2545 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2546 |
buffer-read-only) |
(inhibit-read-only t)) |
2547 |
(when (article-goto-body) |
(when (article-goto-body) |
2548 |
(while (and (not (eobp)) |
(while (and (not (eobp)) |
2549 |
(looking-at "[ \t]*$")) |
(looking-at "[ \t]*$")) |
2578 |
(interactive) |
(interactive) |
2579 |
(save-excursion |
(save-excursion |
2580 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2581 |
buffer-read-only) |
(inhibit-read-only t)) |
2582 |
;; First make all blank lines empty. |
;; First make all blank lines empty. |
2583 |
(article-goto-body) |
(article-goto-body) |
2584 |
(while (re-search-forward "^[ \t]+$" nil t) |
(while (re-search-forward "^[ \t]+$" nil t) |
2587 |
(replace-match "" nil t))) |
(replace-match "" nil t))) |
2588 |
;; Then replace multiple empty lines with a single empty line. |
;; Then replace multiple empty lines with a single empty line. |
2589 |
(article-goto-body) |
(article-goto-body) |
2590 |
(while (re-search-forward "\n\n\n+" nil t) |
(while (re-search-forward "\n\n\\(\n+\\)" nil t) |
2591 |
(unless (gnus-annotation-in-region-p |
(unless (gnus-annotation-in-region-p |
2592 |
(match-beginning 0) (match-end 0)) |
(match-beginning 0) (match-end 0)) |
2593 |
(replace-match "\n\n" t t)))))) |
(delete-region (match-beginning 1) (match-end 1))))))) |
2594 |
|
|
2595 |
(defun article-strip-leading-space () |
(defun article-strip-leading-space () |
2596 |
"Remove all white space from the beginning of the lines in the article." |
"Remove all white space from the beginning of the lines in the article." |
2597 |
(interactive) |
(interactive) |
2598 |
(save-excursion |
(save-excursion |
2599 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2600 |
buffer-read-only) |
(inhibit-read-only t)) |
2601 |
(article-goto-body) |
(article-goto-body) |
2602 |
(while (re-search-forward "^[ \t]+" nil t) |
(while (re-search-forward "^[ \t]+" nil t) |
2603 |
(replace-match "" t t))))) |
(replace-match "" t t))))) |
2607 |
(interactive) |
(interactive) |
2608 |
(save-excursion |
(save-excursion |
2609 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2610 |
buffer-read-only) |
(inhibit-read-only t)) |
2611 |
(article-goto-body) |
(article-goto-body) |
2612 |
(while (re-search-forward "[ \t]+$" nil t) |
(while (re-search-forward "[ \t]+$" nil t) |
2613 |
(replace-match "" t t))))) |
(replace-match "" t t))))) |
2624 |
(interactive) |
(interactive) |
2625 |
(save-excursion |
(save-excursion |
2626 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2627 |
buffer-read-only) |
(inhibit-read-only t)) |
2628 |
(article-goto-body) |
(article-goto-body) |
2629 |
(while (re-search-forward "^[ \t]*\n" nil t) |
(while (re-search-forward "^[ \t]*\n" nil t) |
2630 |
(replace-match "" t t))))) |
(replace-match "" t t))))) |
2644 |
(< (- (point-max) (point)) limit)) |
(< (- (point-max) (point)) limit)) |
2645 |
(and (floatp limit) |
(and (floatp limit) |
2646 |
(< (count-lines (point) (point-max)) limit)) |
(< (count-lines (point) (point-max)) limit)) |
2647 |
(and (gnus-functionp limit) |
(and (functionp limit) |
2648 |
(funcall limit)) |
(funcall limit)) |
2649 |
(and (stringp limit) |
(and (stringp limit) |
2650 |
(not (re-search-forward limit nil t)))) |
(not (re-search-forward limit nil t)))) |
2719 |
'article-type type |
'article-type type |
2720 |
(point-min) (point-max) |
(point-min) (point-max) |
2721 |
(cons 'article-type (cons type |
(cons 'article-type (cons type |
2722 |
gnus-hidden-properties))))) |
gnus-hidden-properties))) |
2723 |
|
(gnus-delete-wash-type type))) |
2724 |
|
|
2725 |
(defconst article-time-units |
(defconst article-time-units |
2726 |
`((year . ,(* 365.25 24 60 60)) |
`((year . ,(* 365.25 24 60 60)) |
2731 |
(second . 1)) |
(second . 1)) |
2732 |
"Mapping from time units to seconds.") |
"Mapping from time units to seconds.") |
2733 |
|
|
2734 |
|
(defun gnus-article-forward-header () |
2735 |
|
"Move point to the start of the next header. |
2736 |
|
If the current header is a continuation header, this can be several |
2737 |
|
lines forward." |
2738 |
|
(let ((ended nil)) |
2739 |
|
(while (not ended) |
2740 |
|
(forward-line 1) |
2741 |
|
(if (looking-at "[ \t]+[^ \t]") |
2742 |
|
(forward-line 1) |
2743 |
|
(setq ended t))))) |
2744 |
|
|
2745 |
(defun article-date-ut (&optional type highlight header) |
(defun article-date-ut (&optional type highlight header) |
2746 |
"Convert DATE date to universal time in the current article. |
"Convert DATE date to universal time in the current article. |
2747 |
If TYPE is `local', convert to local time; if it is `lapsed', output |
If TYPE is `local', convert to local time; if it is `lapsed', output |
2753 |
(message-fetch-field "date") |
(message-fetch-field "date") |
2754 |
"")) |
"")) |
2755 |
(tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") |
(tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") |
2756 |
(date-regexp |
(date-regexp |
2757 |
(cond |
(cond |
2758 |
((not gnus-article-date-lapsed-new-header) |
((not gnus-article-date-lapsed-new-header) |
2759 |
tdate-regexp) |
tdate-regexp) |
2779 |
(when (and date (not (string= date ""))) |
(when (and date (not (string= date ""))) |
2780 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2781 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
2782 |
;; Delete any old Date headers. |
;; Delete any old Date headers. |
2783 |
(while (re-search-forward date-regexp nil t) |
(while (re-search-forward date-regexp nil t) |
2784 |
(if pos |
(if pos |
2785 |
(delete-region (progn (beginning-of-line) (point)) |
(delete-region (progn (beginning-of-line) (point)) |
2786 |
(progn (forward-line 1) (point))) |
(progn (gnus-article-forward-header) |
2787 |
|
(point))) |
2788 |
(delete-region (progn (beginning-of-line) (point)) |
(delete-region (progn (beginning-of-line) (point)) |
2789 |
(progn (end-of-line) (point))) |
(progn (gnus-article-forward-header) |
2790 |
|
(forward-char -1) |
2791 |
|
(point))) |
2792 |
(setq pos (point)))) |
(setq pos (point)))) |
2793 |
(when (and (not pos) (re-search-forward tdate-regexp nil t)) |
(when (and (not pos) |
2794 |
|
(re-search-forward tdate-regexp nil t)) |
2795 |
(forward-line 1)) |
(forward-line 1)) |
2796 |
(if pos (goto-char pos)) |
(when pos |
2797 |
|
(goto-char pos)) |
2798 |
(insert (article-make-date-line date (or type 'ut))) |
(insert (article-make-date-line date (or type 'ut))) |
2799 |
(when (not pos) |
(unless pos |
2800 |
(insert "\n") |
(insert "\n") |
2801 |
(forward-line -1)) |
(forward-line -1)) |
2802 |
;; Do highlighting. |
;; Do highlighting. |
2811 |
|
|
2812 |
(defun article-make-date-line (date type) |
(defun article-make-date-line (date type) |
2813 |
"Return a DATE line of TYPE." |
"Return a DATE line of TYPE." |
2814 |
(let ((time (condition-case () |
(unless (memq type '(local ut original user iso8601 lapsed english)) |
2815 |
(date-to-time date) |
(error "Unknown conversion type: %s" type)) |
2816 |
(error '(0 0))))) |
(condition-case () |
2817 |
(cond |
(let ((time (date-to-time date))) |
|
;; Convert to the local timezone. We have to slap a |
|
|
;; `condition-case' round the calls to the timezone |
|
|
;; functions since they aren't particularly resistant to |
|
|
;; buggy dates. |
|
|
((eq type 'local) |
|
|
(let ((tz (car (current-time-zone time)))) |
|
|
(format "Date: %s %s%02d%02d" (current-time-string time) |
|
|
(if (> tz 0) "+" "-") (/ (abs tz) 3600) |
|
|
(/ (% (abs tz) 3600) 60)))) |
|
|
;; Convert to Universal Time. |
|
|
((eq type 'ut) |
|
|
(concat "Date: " |
|
|
(current-time-string |
|
|
(let* ((e (parse-time-string date)) |
|
|
(tm (apply 'encode-time e)) |
|
|
(ms (car tm)) |
|
|
(ls (- (cadr tm) (car (current-time-zone time))))) |
|
|
(cond ((< ls 0) (list (1- ms) (+ ls 65536))) |
|
|
((> ls 65535) (list (1+ ms) (- ls 65536))) |
|
|
(t (list ms ls))))) |
|
|
" UT")) |
|
|
;; Get the original date from the article. |
|
|
((eq type 'original) |
|
|
(concat "Date: " (if (string-match "\n+$" date) |
|
|
(substring date 0 (match-beginning 0)) |
|
|
date))) |
|
|
;; Let the user define the format. |
|
|
((eq type 'user) |
|
|
(if (gnus-functionp gnus-article-time-format) |
|
|
(funcall gnus-article-time-format time) |
|
|
(concat |
|
|
"Date: " |
|
|
(format-time-string gnus-article-time-format time)))) |
|
|
;; ISO 8601. |
|
|
((eq type 'iso8601) |
|
|
(let ((tz (car (current-time-zone time)))) |
|
|
(concat |
|
|
"Date: " |
|
|
(format-time-string "%Y%m%dT%H%M%S" time) |
|
|
(format "%s%02d%02d" |
|
|
(if (> tz 0) "+" "-") (/ (abs tz) 3600) |
|
|
(/ (% (abs tz) 3600) 60))))) |
|
|
;; Do an X-Sent lapsed format. |
|
|
((eq type 'lapsed) |
|
|
;; If the date is seriously mangled, the timezone functions are |
|
|
;; liable to bug out, so we ignore all errors. |
|
|
(let* ((now (current-time)) |
|
|
(real-time (subtract-time now time)) |
|
|
(real-sec (and real-time |
|
|
(+ (* (float (car real-time)) 65536) |
|
|
(cadr real-time)))) |
|
|
(sec (and real-time (abs real-sec))) |
|
|
num prev) |
|
2818 |
(cond |
(cond |
2819 |
((null real-time) |
;; Convert to the local timezone. |
2820 |
"X-Sent: Unknown") |
((eq type 'local) |
2821 |
((zerop sec) |
(let ((tz (car (current-time-zone time)))) |
2822 |
"X-Sent: Now") |
(format "Date: %s %s%02d%02d" (current-time-string time) |
2823 |
(t |
(if (> tz 0) "+" "-") (/ (abs tz) 3600) |
2824 |
(concat |
(/ (% (abs tz) 3600) 60)))) |
2825 |
"X-Sent: " |
;; Convert to Universal Time. |
2826 |
;; This is a bit convoluted, but basically we go |
((eq type 'ut) |
2827 |
;; through the time units for years, weeks, etc, |
(concat "Date: " |
2828 |
;; and divide things to see whether that results |
(current-time-string |
2829 |
;; in positive answers. |
(let* ((e (parse-time-string date)) |
2830 |
(mapconcat |
(tm (apply 'encode-time e)) |
2831 |
(lambda (unit) |
(ms (car tm)) |
2832 |
(if (zerop (setq num (ffloor (/ sec (cdr unit))))) |
(ls (- (cadr tm) (car (current-time-zone time))))) |
2833 |
;; The (remaining) seconds are too few to |
(cond ((< ls 0) (list (1- ms) (+ ls 65536))) |
2834 |
;; be divided into this time unit. |
((> ls 65535) (list (1+ ms) (- ls 65536))) |
2835 |
"" |
(t (list ms ls))))) |
2836 |
;; It's big enough, so we output it. |
" UT")) |
2837 |
(setq sec (- sec (* num (cdr unit)))) |
;; Get the original date from the article. |
2838 |
(prog1 |
((eq type 'original) |
2839 |
(concat (if prev ", " "") (int-to-string |
(concat "Date: " (if (string-match "\n+$" date) |
2840 |
(floor num)) |
(substring date 0 (match-beginning 0)) |
2841 |
" " (symbol-name (car unit)) |
date))) |
2842 |
(if (> num 1) "s" "")) |
;; Let the user define the format. |
2843 |
(setq prev t)))) |
((eq type 'user) |
2844 |
article-time-units "") |
(let ((format (or (condition-case nil |
2845 |
;; If dates are odd, then it might appear like the |
(with-current-buffer gnus-summary-buffer |
2846 |
;; article was sent in the future. |
gnus-article-time-format) |
2847 |
(if (> real-sec 0) |
(error nil)) |
2848 |
" ago" |
gnus-article-time-format))) |
2849 |
" in the future")))))) |
(if (functionp format) |
2850 |
(t |
(funcall format time) |
2851 |
(error "Unknown conversion type: %s" type))))) |
(concat "Date: " (format-time-string format time))))) |
2852 |
|
;; ISO 8601. |
2853 |
|
((eq type 'iso8601) |
2854 |
|
(let ((tz (car (current-time-zone time)))) |
2855 |
|
(concat |
2856 |
|
"Date: " |
2857 |
|
(format-time-string "%Y%m%dT%H%M%S" time) |
2858 |
|
(format "%s%02d%02d" |
2859 |
|
(if (> tz 0) "+" "-") (/ (abs tz) 3600) |
2860 |
|
(/ (% (abs tz) 3600) 60))))) |
2861 |
|
;; Do an X-Sent lapsed format. |
2862 |
|
((eq type 'lapsed) |
2863 |
|
;; If the date is seriously mangled, the timezone functions are |
2864 |
|
;; liable to bug out, so we ignore all errors. |
2865 |
|
(let* ((now (current-time)) |
2866 |
|
(real-time (subtract-time now time)) |
2867 |
|
(real-sec (and real-time |
2868 |
|
(+ (* (float (car real-time)) 65536) |
2869 |
|
(cadr real-time)))) |
2870 |
|
(sec (and real-time (abs real-sec))) |
2871 |
|
num prev) |
2872 |
|
(cond |
2873 |
|
((null real-time) |
2874 |
|
"X-Sent: Unknown") |
2875 |
|
((zerop sec) |
2876 |
|
"X-Sent: Now") |
2877 |
|
(t |
2878 |
|
(concat |
2879 |
|
"X-Sent: " |
2880 |
|
;; This is a bit convoluted, but basically we go |
2881 |
|
;; through the time units for years, weeks, etc, |
2882 |
|
;; and divide things to see whether that results |
2883 |
|
;; in positive answers. |
2884 |
|
(mapconcat |
2885 |
|
(lambda (unit) |
2886 |
|
(if (zerop (setq num (ffloor (/ sec (cdr unit))))) |
2887 |
|
;; The (remaining) seconds are too few to |
2888 |
|
;; be divided into this time unit. |
2889 |
|
"" |
2890 |
|
;; It's big enough, so we output it. |
2891 |
|
(setq sec (- sec (* num (cdr unit)))) |
2892 |
|
(prog1 |
2893 |
|
(concat (if prev ", " "") (int-to-string |
2894 |
|
(floor num)) |
2895 |
|
" " (symbol-name (car unit)) |
2896 |
|
(if (> num 1) "s" "")) |
2897 |
|
(setq prev t)))) |
2898 |
|
article-time-units "") |
2899 |
|
;; If dates are odd, then it might appear like the |
2900 |
|
;; article was sent in the future. |
2901 |
|
(if (> real-sec 0) |
2902 |
|
" ago" |
2903 |
|
" in the future")))))) |
2904 |
|
;; Display the date in proper English |
2905 |
|
((eq type 'english) |
2906 |
|
(let ((dtime (decode-time time))) |
2907 |
|
(concat |
2908 |
|
"Date: the " |
2909 |
|
(number-to-string (nth 3 dtime)) |
2910 |
|
(let ((digit (% (nth 3 dtime) 10))) |
2911 |
|
(cond |
2912 |
|
((memq (nth 3 dtime) '(11 12 13)) "th") |
2913 |
|
((= digit 1) "st") |
2914 |
|
((= digit 2) "nd") |
2915 |
|
((= digit 3) "rd") |
2916 |
|
(t "th"))) |
2917 |
|
" of " |
2918 |
|
(nth (1- (nth 4 dtime)) gnus-english-month-names) |
2919 |
|
" " |
2920 |
|
(number-to-string (nth 5 dtime)) |
2921 |
|
" at " |
2922 |
|
(format "%02d" (nth 2 dtime)) |
2923 |
|
":" |
2924 |
|
(format "%02d" (nth 1 dtime))))))) |
2925 |
|
(error |
2926 |
|
(format "Date: %s (from Gnus)" date)))) |
2927 |
|
|
2928 |
(defun article-date-local (&optional highlight) |
(defun article-date-local (&optional highlight) |
2929 |
"Convert the current article date to the local timezone." |
"Convert the current article date to the local timezone." |
2930 |
(interactive (list t)) |
(interactive (list t)) |
2931 |
(article-date-ut 'local highlight)) |
(article-date-ut 'local highlight)) |
2932 |
|
|
2933 |
|
(defun article-date-english (&optional highlight) |
2934 |
|
"Convert the current article date to something that is proper English." |
2935 |
|
(interactive (list t)) |
2936 |
|
(article-date-ut 'english highlight)) |
2937 |
|
|
2938 |
(defun article-date-original (&optional highlight) |
(defun article-date-original (&optional highlight) |
2939 |
"Convert the current article date to what it was originally. |
"Convert the current article date to what it was originally. |
2940 |
This is only useful if you have used some other date conversion |
This is only useful if you have used some other date conversion |
2956 |
(lambda (w) |
(lambda (w) |
2957 |
(set-buffer (window-buffer w)) |
(set-buffer (window-buffer w)) |
2958 |
(when (eq major-mode 'gnus-article-mode) |
(when (eq major-mode 'gnus-article-mode) |
2959 |
(goto-char (point-min)) |
(let ((mark (point-marker))) |
2960 |
(when (re-search-forward "^X-Sent:" nil t) |
(goto-char (point-min)) |
2961 |
(article-date-lapsed t)))) |
(when (re-search-forward "^X-Sent:" nil t) |
2962 |
|
(article-date-lapsed t)) |
2963 |
|
(goto-char (marker-position mark)) |
2964 |
|
(move-marker mark nil)))) |
2965 |
nil 'visible))))) |
nil 'visible))))) |
2966 |
|
|
2967 |
(defun gnus-start-date-timer (&optional n) |
(defun gnus-start-date-timer (&optional n) |
2993 |
(interactive (list t)) |
(interactive (list t)) |
2994 |
(article-date-ut 'iso8601 highlight)) |
(article-date-ut 'iso8601 highlight)) |
2995 |
|
|
2996 |
(defun article-show-all () |
;; (defun article-show-all () |
2997 |
"Show all hidden text in the article buffer." |
;; "Show all hidden text in the article buffer." |
2998 |
|
;; (interactive) |
2999 |
|
;; (save-excursion |
3000 |
|
;; (let ((inhibit-read-only t)) |
3001 |
|
;; (gnus-article-unhide-text (point-min) (point-max))))) |
3002 |
|
|
3003 |
|
(defun article-remove-leading-whitespace () |
3004 |
|
"Remove excessive whitespace from all headers." |
3005 |
(interactive) |
(interactive) |
3006 |
(save-excursion |
(save-excursion |
3007 |
(let ((inhibit-read-only t)) |
(save-restriction |
3008 |
(gnus-article-unhide-text (point-min) (point-max))))) |
(let ((inhibit-read-only t)) |
3009 |
|
(article-narrow-to-head) |
3010 |
|
(goto-char (point-min)) |
3011 |
|
(while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t) |
3012 |
|
(delete-region (match-beginning 1) (match-end 1))))))) |
3013 |
|
|
3014 |
(defun article-emphasize (&optional arg) |
(defun article-emphasize (&optional arg) |
3015 |
"Emphasize text according to `gnus-emphasis-alist'." |
"Emphasize text according to `gnus-emphasis-alist'." |
3035 |
visible (nth 2 elem) |
visible (nth 2 elem) |
3036 |
face (nth 3 elem)) |
face (nth 3 elem)) |
3037 |
(while (re-search-forward regexp nil t) |
(while (re-search-forward regexp nil t) |
3038 |
(when (and (match-beginning visible) (match-beginning invisible)) |
(when (and (match-beginning visible) (match-beginning invisible)) |
3039 |
(push 'emphasis gnus-article-wash-types) |
(gnus-article-hide-text |
3040 |
(gnus-article-hide-text |
(match-beginning invisible) (match-end invisible) props) |
3041 |
(match-beginning invisible) (match-end invisible) props) |
(gnus-article-unhide-text-type |
3042 |
(gnus-article-unhide-text-type |
(match-beginning visible) (match-end visible) 'emphasis) |
3043 |
(match-beginning visible) (match-end visible) 'emphasis) |
(gnus-put-overlay-excluding-newlines |
3044 |
(gnus-put-text-property-excluding-newlines |
(match-beginning visible) (match-end visible) 'face face) |
3045 |
(match-beginning visible) (match-end visible) 'face face) |
(gnus-add-wash-type 'emphasis) |
3046 |
(goto-char (match-end invisible))))))))) |
(goto-char (match-end invisible))))))))) |
3047 |
|
|
3048 |
(defun gnus-article-setup-highlight-words (&optional highlight-words) |
(defun gnus-article-setup-highlight-words (&optional highlight-words) |
3049 |
"Setup newsgroup emphasis alist." |
"Setup newsgroup emphasis alist." |
3145 |
;; A single split name was found |
;; A single split name was found |
3146 |
((= 1 (length split-name)) |
((= 1 (length split-name)) |
3147 |
(let* ((name (expand-file-name |
(let* ((name (expand-file-name |
3148 |
(car split-name) gnus-article-save-directory)) |
(car split-name) |
3149 |
|
gnus-article-save-directory)) |
3150 |
(dir (cond ((file-directory-p name) |
(dir (cond ((file-directory-p name) |
3151 |
(file-name-as-directory name)) |
(file-name-as-directory name)) |
3152 |
((file-exists-p name) name) |
((file-exists-p name) name) |
3170 |
(car (push result file-name-history))))))) |
(car (push result file-name-history))))))) |
3171 |
;; Create the directory. |
;; Create the directory. |
3172 |
(gnus-make-directory (file-name-directory file)) |
(gnus-make-directory (file-name-directory file)) |
3173 |
;; If we have read a directory, we append the default file name. |
;; If we have read a directory, we append the default file name. |
3174 |
(when (file-directory-p file) |
(when (file-directory-p file) |
3175 |
(setq file (expand-file-name (file-name-nondirectory default-name) |
(setq file (expand-file-name (file-name-nondirectory |
3176 |
|
default-name) |
3177 |
(file-name-as-directory file)))) |
(file-name-as-directory file)))) |
3178 |
;; Possibly translate some characters. |
;; Possibly translate some characters. |
3179 |
(nnheader-translate-file-chars file)))))) |
(nnheader-translate-file-chars file)))))) |
3220 |
(save-restriction |
(save-restriction |
3221 |
(widen) |
(widen) |
3222 |
(if (and (file-readable-p filename) |
(if (and (file-readable-p filename) |
3223 |
|
(file-regular-p filename) |
3224 |
(mail-file-babyl-p filename)) |
(mail-file-babyl-p filename)) |
3225 |
(rmail-output-to-rmail-file filename t) |
(rmail-output-to-rmail-file filename t) |
3226 |
(gnus-output-to-mail filename))))) |
(gnus-output-to-mail filename))))) |
3245 |
filename) |
filename) |
3246 |
|
|
3247 |
(defun gnus-summary-write-to-file (&optional filename) |
(defun gnus-summary-write-to-file (&optional filename) |
3248 |
"Write this article to a file. |
"Write this article to a file, overwriting it if the file exists. |
3249 |
Optional argument FILENAME specifies file name. |
Optional argument FILENAME specifies file name. |
3250 |
The directory to save in defaults to `gnus-article-save-directory'." |
The directory to save in defaults to `gnus-article-save-directory'." |
3251 |
(gnus-summary-save-in-file nil t)) |
(gnus-summary-save-in-file nil t)) |
3294 |
(shell-command-on-region (point-min) (point-max) command nil))) |
(shell-command-on-region (point-min) (point-max) command nil))) |
3295 |
(setq gnus-last-shell-command command)) |
(setq gnus-last-shell-command command)) |
3296 |
|
|
3297 |
|
(defmacro gnus-read-string (prompt &optional initial-contents history |
3298 |
|
default-value) |
3299 |
|
"Like `read-string' but allow for older XEmacsen that don't have the 5th arg." |
3300 |
|
(if (and (featurep 'xemacs) |
3301 |
|
(< emacs-minor-version 2)) |
3302 |
|
`(read-string ,prompt ,initial-contents ,history) |
3303 |
|
`(read-string ,prompt ,initial-contents ,history ,default-value))) |
3304 |
|
|
3305 |
|
(defun gnus-summary-pipe-to-muttprint (&optional command) |
3306 |
|
"Pipe this article to muttprint." |
3307 |
|
(setq command (gnus-read-string |
3308 |
|
"Print using command: " gnus-summary-muttprint-program |
3309 |
|
nil gnus-summary-muttprint-program)) |
3310 |
|
(gnus-summary-save-in-pipe command)) |
3311 |
|
|
3312 |
;;; Article file names when saving. |
;;; Article file names when saving. |
3313 |
|
|
3314 |
(defun gnus-capitalize-newsgroup (newsgroup) |
(defun gnus-capitalize-newsgroup (newsgroup) |
3361 |
(expand-file-name |
(expand-file-name |
3362 |
(if (gnus-use-long-file-name 'not-save) |
(if (gnus-use-long-file-name 'not-save) |
3363 |
newsgroup |
newsgroup |
3364 |
(expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))) |
(file-relative-name |
3365 |
|
(expand-file-name "news" (gnus-newsgroup-directory-form newsgroup)) |
3366 |
|
default-directory)) |
3367 |
gnus-article-save-directory))) |
gnus-article-save-directory))) |
3368 |
|
|
3369 |
|
(defun gnus-sender-save-name (newsgroup headers &optional last-file) |
3370 |
|
"Generate file name from sender." |
3371 |
|
(let ((from (mail-header-from headers))) |
3372 |
|
(expand-file-name |
3373 |
|
(if (and from (string-match "\\([^ <]+\\)@" from)) |
3374 |
|
(match-string 1 from) |
3375 |
|
"nobody") |
3376 |
|
gnus-article-save-directory))) |
3377 |
|
|
3378 |
|
(defun article-verify-x-pgp-sig () |
3379 |
|
"Verify X-PGP-Sig." |
3380 |
|
(interactive) |
3381 |
|
(if (gnus-buffer-live-p gnus-original-article-buffer) |
3382 |
|
(let ((sig (with-current-buffer gnus-original-article-buffer |
3383 |
|
(gnus-fetch-field "X-PGP-Sig"))) |
3384 |
|
items info headers) |
3385 |
|
(when (and sig |
3386 |
|
mml2015-use |
3387 |
|
(mml2015-clear-verify-function)) |
3388 |
|
(with-temp-buffer |
3389 |
|
(insert-buffer-substring gnus-original-article-buffer) |
3390 |
|
(setq items (split-string sig)) |
3391 |
|
(message-narrow-to-head) |
3392 |
|
(let ((inhibit-point-motion-hooks t) |
3393 |
|
(case-fold-search t)) |
3394 |
|
;; Don't verify multiple headers. |
3395 |
|
(setq headers (mapconcat (lambda (header) |
3396 |
|
(concat header ": " |
3397 |
|
(mail-fetch-field header) |
3398 |
|
"\n")) |
3399 |
|
(split-string (nth 1 items) ",") ""))) |
3400 |
|
(delete-region (point-min) (point-max)) |
3401 |
|
(insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n") |
3402 |
|
(insert "X-Signed-Headers: " (nth 1 items) "\n") |
3403 |
|
(insert headers) |
3404 |
|
(widen) |
3405 |
|
(forward-line) |
3406 |
|
(while (not (eobp)) |
3407 |
|
(if (looking-at "^-") |
3408 |
|
(insert "- ")) |
3409 |
|
(forward-line)) |
3410 |
|
(insert "\n-----BEGIN PGP SIGNATURE-----\n") |
3411 |
|
(insert "Version: " (car items) "\n\n") |
3412 |
|
(insert (mapconcat 'identity (cddr items) "\n")) |
3413 |
|
(insert "\n-----END PGP SIGNATURE-----\n") |
3414 |
|
(let ((mm-security-handle (list (format "multipart/signed")))) |
3415 |
|
(mml2015-clean-buffer) |
3416 |
|
(let ((coding-system-for-write (or gnus-newsgroup-charset |
3417 |
|
'iso-8859-1))) |
3418 |
|
(funcall (mml2015-clear-verify-function))) |
3419 |
|
(setq info |
3420 |
|
(or (mm-handle-multipart-ctl-parameter |
3421 |
|
mm-security-handle 'gnus-details) |
3422 |
|
(mm-handle-multipart-ctl-parameter |
3423 |
|
mm-security-handle 'gnus-info))))) |
3424 |
|
(when info |
3425 |
|
(let ((inhibit-read-only t) bface eface) |
3426 |
|
(save-restriction |
3427 |
|
(message-narrow-to-head) |
3428 |
|
(goto-char (point-max)) |
3429 |
|
(forward-line -1) |
3430 |
|
(setq bface (get-text-property (gnus-point-at-bol) 'face) |
3431 |
|
eface (get-text-property (1- (gnus-point-at-eol)) 'face)) |
3432 |
|
(message-remove-header "X-Gnus-PGP-Verify") |
3433 |
|
(if (re-search-forward "^X-PGP-Sig:" nil t) |
3434 |
|
(forward-line) |
3435 |
|
(goto-char (point-max))) |
3436 |
|
(narrow-to-region (point) (point)) |
3437 |
|
(insert "X-Gnus-PGP-Verify: " info "\n") |
3438 |
|
(goto-char (point-min)) |
3439 |
|
(forward-line) |
3440 |
|
(while (not (eobp)) |
3441 |
|
(if (not (looking-at "^[ \t]")) |
3442 |
|
(insert " ")) |
3443 |
|
(forward-line)) |
3444 |
|
;; Do highlighting. |
3445 |
|
(goto-char (point-min)) |
3446 |
|
(when (looking-at "\\([^:]+\\): *") |
3447 |
|
(put-text-property (match-beginning 1) (1+ (match-end 1)) |
3448 |
|
'face bface) |
3449 |
|
(put-text-property (match-end 0) (point-max) |
3450 |
|
'face eface))))))))) |
3451 |
|
|
3452 |
|
(defun article-verify-cancel-lock () |
3453 |
|
"Verify Cancel-Lock header." |
3454 |
|
(interactive) |
3455 |
|
(if (gnus-buffer-live-p gnus-original-article-buffer) |
3456 |
|
(canlock-verify gnus-original-article-buffer))) |
3457 |
|
|
3458 |
(eval-and-compile |
(eval-and-compile |
3459 |
(mapcar |
(mapcar |
3460 |
(lambda (func) |
(lambda (func) |
3465 |
(setq afunc func |
(setq afunc func |
3466 |
gfunc (intern (format "gnus-%s" func)))) |
gfunc (intern (format "gnus-%s" func)))) |
3467 |
(defalias gfunc |
(defalias gfunc |
3468 |
(if (fboundp afunc) |
(when (fboundp afunc) |
3469 |
`(lambda (&optional interactive &rest args) |
`(lambda (&optional interactive &rest args) |
3470 |
,(documentation afunc t) |
,(documentation afunc t) |
3471 |
(interactive (list t)) |
(interactive (list t)) |
3475 |
(call-interactively ',afunc) |
(call-interactively ',afunc) |
3476 |
(apply ',afunc args)))))))) |
(apply ',afunc args)))))))) |
3477 |
'(article-hide-headers |
'(article-hide-headers |
3478 |
|
article-verify-x-pgp-sig |
3479 |
|
article-verify-cancel-lock |
3480 |
article-hide-boring-headers |
article-hide-boring-headers |
3481 |
article-treat-overstrike |
article-treat-overstrike |
3482 |
article-fill-long-lines |
article-fill-long-lines |
3483 |
article-capitalize-sentences |
article-capitalize-sentences |
3484 |
article-remove-cr |
article-remove-cr |
3485 |
|
article-remove-leading-whitespace |
3486 |
article-display-x-face |
article-display-x-face |
3487 |
|
article-display-face |
3488 |
article-de-quoted-unreadable |
article-de-quoted-unreadable |
3489 |
article-de-base64-unreadable |
article-de-base64-unreadable |
3490 |
article-decode-HZ |
article-decode-HZ |
3491 |
article-wash-html |
article-wash-html |
3492 |
|
article-unsplit-urls |
3493 |
article-hide-list-identifiers |
article-hide-list-identifiers |
|
article-hide-pgp |
|
3494 |
article-strip-banner |
article-strip-banner |
3495 |
article-babel |
article-babel |
3496 |
article-hide-pem |
article-hide-pem |
3504 |
article-strip-blank-lines |
article-strip-blank-lines |
3505 |
article-strip-all-blank-lines |
article-strip-all-blank-lines |
3506 |
article-date-local |
article-date-local |
3507 |
|
article-date-english |
3508 |
article-date-iso8601 |
article-date-iso8601 |
3509 |
article-date-original |
article-date-original |
3510 |
article-date-ut |
article-date-ut |
3516 |
article-emphasize |
article-emphasize |
3517 |
article-treat-dumbquotes |
article-treat-dumbquotes |
3518 |
article-normalize-headers |
article-normalize-headers |
3519 |
(article-show-all . gnus-article-show-all-headers)))) |
;; (article-show-all . gnus-article-show-all-headers) |
3520 |
|
))) |
3521 |
|
|
3522 |
;;; |
;;; |
3523 |
;;; Gnus article mode |
;;; Gnus article mode |
3542 |
">" end-of-buffer |
">" end-of-buffer |
3543 |
"\C-c\C-i" gnus-info-find-node |
"\C-c\C-i" gnus-info-find-node |
3544 |
"\C-c\C-b" gnus-bug |
"\C-c\C-b" gnus-bug |
3545 |
|
"R" gnus-article-reply-with-original |
3546 |
|
"F" gnus-article-followup-with-original |
3547 |
"\C-hk" gnus-article-describe-key |
"\C-hk" gnus-article-describe-key |
3548 |
"\C-hc" gnus-article-describe-key-briefly |
"\C-hc" gnus-article-describe-key-briefly |
3549 |
|
|
3556 |
(substitute-key-definition |
(substitute-key-definition |
3557 |
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) |
'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) |
3558 |
|
|
|
(defvar gnus-article-post-menu nil) |
|
|
|
|
3559 |
(defun gnus-article-make-menu-bar () |
(defun gnus-article-make-menu-bar () |
3560 |
|
(unless (boundp 'gnus-article-commands-menu) |
3561 |
|
(gnus-summary-make-menu-bar)) |
3562 |
(gnus-turn-off-edit-menu 'article) |
(gnus-turn-off-edit-menu 'article) |
3563 |
(unless (boundp 'gnus-article-article-menu) |
(unless (boundp 'gnus-article-article-menu) |
3564 |
(easy-menu-define |
(easy-menu-define |
3580 |
["Hide citation" gnus-article-hide-citation t] |
["Hide citation" gnus-article-hide-citation t] |
3581 |
["Treat overstrike" gnus-article-treat-overstrike t] |
["Treat overstrike" gnus-article-treat-overstrike t] |
3582 |
["Remove carriage return" gnus-article-remove-cr t] |
["Remove carriage return" gnus-article-remove-cr t] |
3583 |
|
["Remove leading whitespace" gnus-article-remove-leading-whitespace t] |
3584 |
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] |
["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] |
3585 |
["Remove base64" gnus-article-de-base64-unreadable t] |
["Remove base64" gnus-article-de-base64-unreadable t] |
3586 |
["Treat html" gnus-article-wash-html t] |
["Treat html" gnus-article-wash-html t] |
3587 |
|
["Remove newlines from within URLs" gnus-article-unsplit-urls t] |
3588 |
["Decode HZ" gnus-article-decode-HZ t])) |
["Decode HZ" gnus-article-decode-HZ t])) |
3589 |
|
|
3590 |
;; Note "Commands" menu is defined in gnus-sum.el for consistency |
;; Note "Commands" menu is defined in gnus-sum.el for consistency |
3591 |
|
|
3592 |
(when (boundp 'gnus-summary-post-menu) |
;; Note "Post" menu is defined in gnus-sum.el for consistency |
|
(cond |
|
|
((not (keymapp gnus-summary-post-menu)) |
|
|
(setq gnus-article-post-menu gnus-summary-post-menu)) |
|
|
((not gnus-article-post-menu) |
|
|
;; Don't share post menu. |
|
|
(setq gnus-article-post-menu |
|
|
(copy-keymap gnus-summary-post-menu)))) |
|
|
(define-key gnus-article-mode-map [menu-bar post] |
|
|
(cons "Post" gnus-article-post-menu))) |
|
3593 |
|
|
3594 |
(gnus-run-hooks 'gnus-article-menu-hook))) |
(gnus-run-hooks 'gnus-article-menu-hook))) |
3595 |
|
|
|
;; Fixme: do something for the Emacs tool bar in Article mode a la |
|
|
;; Summary. |
|
|
|
|
3596 |
(defun gnus-article-mode () |
(defun gnus-article-mode () |
3597 |
"Major mode for displaying an article. |
"Major mode for displaying an article. |
3598 |
|
|
3615 |
(make-local-variable 'minor-mode-alist) |
(make-local-variable 'minor-mode-alist) |
3616 |
(use-local-map gnus-article-mode-map) |
(use-local-map gnus-article-mode-map) |
3617 |
(when (gnus-visual-p 'article-menu 'menu) |
(when (gnus-visual-p 'article-menu 'menu) |
3618 |
(gnus-article-make-menu-bar)) |
(gnus-article-make-menu-bar) |
3619 |
|
(when gnus-summary-tool-bar-map |
3620 |
|
(set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) |
3621 |
(gnus-update-format-specifications nil 'article-mode) |
(gnus-update-format-specifications nil 'article-mode) |
3622 |
(set (make-local-variable 'page-delimiter) gnus-page-delimiter) |
(set (make-local-variable 'page-delimiter) gnus-page-delimiter) |
3623 |
(make-local-variable 'gnus-page-broken) |
(set (make-local-variable 'gnus-page-broken) nil) |
3624 |
(make-local-variable 'gnus-button-marker-list) |
(make-local-variable 'gnus-button-marker-list) |
3625 |
(make-local-variable 'gnus-article-current-summary) |
(make-local-variable 'gnus-article-current-summary) |
3626 |
(make-local-variable 'gnus-article-mime-handles) |
(make-local-variable 'gnus-article-mime-handles) |
3627 |
(make-local-variable 'gnus-article-decoded-p) |
(make-local-variable 'gnus-article-decoded-p) |
3628 |
(make-local-variable 'gnus-article-mime-handle-alist) |
(make-local-variable 'gnus-article-mime-handle-alist) |
3629 |
(make-local-variable 'gnus-article-wash-types) |
(make-local-variable 'gnus-article-wash-types) |
3630 |
|
(make-local-variable 'gnus-article-image-alist) |
3631 |
|
(make-local-variable 'gnus-article-charset) |
3632 |
|
(make-local-variable 'gnus-article-ignored-charsets) |
3633 |
(gnus-set-default-directory) |
(gnus-set-default-directory) |
3634 |
(buffer-disable-undo) |
(buffer-disable-undo) |
3635 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
3665 |
(if (get-buffer name) |
(if (get-buffer name) |
3666 |
(save-excursion |
(save-excursion |
3667 |
(set-buffer name) |
(set-buffer name) |
3668 |
|
(when (and gnus-article-edit-mode |
3669 |
|
(buffer-modified-p) |
3670 |
|
(not |
3671 |
|
(y-or-n-p "Article mode edit in progress; discard? "))) |
3672 |
|
(error "Action aborted")) |
3673 |
|
(set (make-local-variable 'gnus-article-edit-mode) nil) |
3674 |
(when gnus-article-mime-handles |
(when gnus-article-mime-handles |
3675 |
(mm-destroy-parts gnus-article-mime-handles) |
(mm-destroy-parts gnus-article-mime-handles) |
3676 |
(setq gnus-article-mime-handles nil)) |
(setq gnus-article-mime-handles nil)) |
3678 |
(setq gnus-article-mime-handle-alist nil) |
(setq gnus-article-mime-handle-alist nil) |
3679 |
(buffer-disable-undo) |
(buffer-disable-undo) |
3680 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
3681 |
|
;; This list just keeps growing if we don't reset it. |
3682 |
|
(setq gnus-button-marker-list nil) |
3683 |
(unless (eq major-mode 'gnus-article-mode) |
(unless (eq major-mode 'gnus-article-mode) |
3684 |
(gnus-article-mode)) |
(gnus-article-mode)) |
3685 |
(current-buffer)) |
(current-buffer)) |
3694 |
;; from the head of the article. |
;; from the head of the article. |
3695 |
(defun gnus-article-set-window-start (&optional line) |
(defun gnus-article-set-window-start (&optional line) |
3696 |
(set-window-start |
(set-window-start |
3697 |
(get-buffer-window gnus-article-buffer t) |
(gnus-get-buffer-window gnus-article-buffer t) |
3698 |
(save-excursion |
(save-excursion |
3699 |
(set-buffer gnus-article-buffer) |
(set-buffer gnus-article-buffer) |
3700 |
(goto-char (point-min)) |
(goto-char (point-min)) |
3738 |
(cons gnus-newsgroup-name article)) |
(cons gnus-newsgroup-name article)) |
3739 |
(set-buffer gnus-summary-buffer) |
(set-buffer gnus-summary-buffer) |
3740 |
(setq gnus-current-article article) |
(setq gnus-current-article article) |
3741 |
(if (eq (gnus-article-mark article) gnus-undownloaded-mark) |
(if (and (memq article gnus-newsgroup-undownloaded) |
3742 |
|
(not (gnus-online (gnus-find-method-for-group |
3743 |
|
gnus-newsgroup-name)))) |
3744 |
(progn |
(progn |
3745 |
(gnus-summary-set-agent-mark article) |
(gnus-summary-set-agent-mark article) |
3746 |
(message "Message marked for downloading")) |
(message "Message marked for downloading")) |
3804 |
(gnus-article-prepare-display) |
(gnus-article-prepare-display) |
3805 |
;; Do page break. |
;; Do page break. |
3806 |
(goto-char (point-min)) |
(goto-char (point-min)) |
3807 |
(setq gnus-page-broken |
(when gnus-break-pages |
3808 |
(when gnus-break-pages |
(gnus-narrow-to-page))) |
|
(gnus-narrow-to-page) |
|
|
t))) |
|
3809 |
(let ((gnus-article-mime-handle-alist-1 |
(let ((gnus-article-mime-handle-alist-1 |
3810 |
gnus-article-mime-handle-alist)) |
gnus-article-mime-handle-alist)) |
3811 |
(gnus-set-mode-line 'article)) |
(gnus-set-mode-line 'article)) |
3812 |
(article-goto-body) |
(article-goto-body) |
3813 |
|
(unless (bobp) |
3814 |
|
(forward-line -1)) |
3815 |
(set-window-point (get-buffer-window (current-buffer)) (point)) |
(set-window-point (get-buffer-window (current-buffer)) (point)) |
3816 |
(gnus-configure-windows 'article) |
(gnus-configure-windows 'article) |
3817 |
t)))))) |
t)))))) |
3822 |
;; Hooks for getting information from the article. |
;; Hooks for getting information from the article. |
3823 |
;; This hook must be called before being narrowed. |
;; This hook must be called before being narrowed. |
3824 |
(let ((gnus-article-buffer (current-buffer)) |
(let ((gnus-article-buffer (current-buffer)) |
3825 |
buffer-read-only) |
buffer-read-only |
3826 |
|
(inhibit-read-only t)) |
3827 |
(unless (eq major-mode 'gnus-article-mode) |
(unless (eq major-mode 'gnus-article-mode) |
3828 |
(gnus-article-mode)) |
(gnus-article-mode)) |
3829 |
(setq buffer-read-only nil |
(setq buffer-read-only nil |
3830 |
gnus-article-wash-types nil) |
gnus-article-wash-types nil |
3831 |
|
gnus-article-image-alist nil) |
3832 |
(gnus-run-hooks 'gnus-tmp-internal-hook) |
(gnus-run-hooks 'gnus-tmp-internal-hook) |
3833 |
(when gnus-display-mime-function |
(when gnus-display-mime-function |
3834 |
(funcall gnus-display-mime-function)) |
(funcall gnus-display-mime-function)) |
3839 |
;;; |
;;; |
3840 |
|
|
3841 |
(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" |
(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n" |
3842 |
"The following specs can be used: |
"Format of the MIME buttons. |
3843 |
|
|
3844 |
|
Valid specifiers include: |
3845 |
%t The MIME type |
%t The MIME type |
3846 |
%T MIME type, along with additional info |
%T MIME type, along with additional info |
3847 |
%n The `name' parameter |
%n The `name' parameter |
3848 |
%d The description, if any |
%d The description, if any |
3849 |
%l The length of the encoded part |
%l The length of the encoded part |
3850 |
%p The part identifier number |
%p The part identifier number |
3851 |
%e Dots if the part isn't displayed") |
%e Dots if the part isn't displayed |
3852 |
|
|
3853 |
|
General format specifiers can also be used. See Info node |
3854 |
|
`(gnus)Formatting Variables'.") |
3855 |
|
|
3856 |
(defvar gnus-mime-button-line-format-alist |
(defvar gnus-mime-button-line-format-alist |
3857 |
'((?t gnus-tmp-type ?s) |
'((?t gnus-tmp-type ?s) |
3866 |
'((gnus-article-press-button "\r" "Toggle Display") |
'((gnus-article-press-button "\r" "Toggle Display") |
3867 |
(gnus-mime-view-part "v" "View Interactively...") |
(gnus-mime-view-part "v" "View Interactively...") |
3868 |
(gnus-mime-view-part-as-type "t" "View As Type...") |
(gnus-mime-view-part-as-type "t" "View As Type...") |
3869 |
|
(gnus-mime-view-part-as-charset "C" "View As charset...") |
3870 |
(gnus-mime-save-part "o" "Save...") |
(gnus-mime-save-part "o" "Save...") |
3871 |
|
(gnus-mime-save-part-and-strip "\C-o" "Save and Strip") |
3872 |
|
(gnus-mime-delete-part "d" "Delete part") |
3873 |
(gnus-mime-copy-part "c" "View As Text, In Other Buffer") |
(gnus-mime-copy-part "c" "View As Text, In Other Buffer") |
3874 |
(gnus-mime-inline-part "i" "View As Text, In This Buffer") |
(gnus-mime-inline-part "i" "View As Text, In This Buffer") |
3875 |
(gnus-mime-internalize-part "E" "View Internally") |
(gnus-mime-view-part-internally "E" "View Internally") |
3876 |
(gnus-mime-externalize-part "e" "View Externally") |
(gnus-mime-view-part-externally "e" "View Externally") |
3877 |
|
(gnus-mime-print-part "p" "Print") |
3878 |
(gnus-mime-pipe-part "|" "Pipe To Command...") |
(gnus-mime-pipe-part "|" "Pipe To Command...") |
3879 |
(gnus-mime-action-on-part "." "Take action on the part"))) |
(gnus-mime-action-on-part "." "Take action on the part..."))) |
3880 |
|
|
3881 |
(defun gnus-article-mime-part-status () |
(defun gnus-article-mime-part-status () |
3882 |
(if gnus-article-mime-handle-alist-1 |
(if gnus-article-mime-handle-alist-1 |
3883 |
(format " (%d parts)" (length gnus-article-mime-handle-alist-1)) |
(if (eq 1 (length gnus-article-mime-handle-alist-1)) |
3884 |
|
" (1 part)" |
3885 |
|
(format " (%d parts)" (length gnus-article-mime-handle-alist-1))) |
3886 |
"")) |
"")) |
3887 |
|
|
3888 |
(defvar gnus-mime-button-map |
(defvar gnus-mime-button-map |
3889 |
(let ((map (make-sparse-keymap))) |
(let ((map (make-sparse-keymap))) |
3890 |
;; Not for Emacs 21: fixme better. |
(unless (>= (string-to-number emacs-version) 21) |
3891 |
;; (set-keymap-parent map gnus-article-mode-map) |
;; XEmacs doesn't care. |
3892 |
|
(set-keymap-parent map gnus-article-mode-map)) |
3893 |
(define-key map gnus-mouse-2 'gnus-article-push-button) |
(define-key map gnus-mouse-2 'gnus-article-push-button) |
3894 |
(define-key map gnus-down-mouse-3 'gnus-mime-button-menu) |
(define-key map gnus-down-mouse-3 'gnus-mime-button-menu) |
3895 |
(dolist (c gnus-mime-button-commands) |
(dolist (c gnus-mime-button-commands) |
3896 |
(define-key map (cadr c) (car c))) |
(define-key map (cadr c) (car c))) |
3897 |
map)) |
map)) |
3898 |
|
|
3899 |
(defun gnus-mime-button-menu (event) |
(easy-menu-define |
3900 |
"Construct a context-sensitive menu of MIME commands." |
gnus-mime-button-menu gnus-mime-button-map "MIME button menu." |
3901 |
(interactive "e") |
`("MIME Part" |
3902 |
(save-excursion |
,@(mapcar (lambda (c) |
3903 |
(mouse-set-point event) |
(vector (caddr c) (car c) :enable t)) |
3904 |
(gnus-article-check-buffer) |
gnus-mime-button-commands))) |
3905 |
(let ((response (x-popup-menu |
|
3906 |
t `("MIME Part" |
(eval-when-compile |
3907 |
("" ,@(mapcar (lambda (c) |
(define-compiler-macro popup-menu (&whole form |
3908 |
(cons (caddr c) (car c))) |
menu &optional position prefix) |
3909 |
gnus-mime-button-commands)))))) |
(if (and (fboundp 'popup-menu) |
3910 |
(if response |
(not (memq 'popup-menu (assoc "lmenu" load-history)))) |
3911 |
(call-interactively response))))) |
form |
3912 |
|
;; Gnus is probably running under Emacs 20. |
3913 |
|
`(let* ((menu (cdr ,menu)) |
3914 |
|
(response (x-popup-menu |
3915 |
|
t (list (car menu) |
3916 |
|
(cons "" (mapcar (lambda (c) |
3917 |
|
(cons (caddr c) (car c))) |
3918 |
|
(cdr menu))))))) |
3919 |
|
(if response |
3920 |
|
(call-interactively (nth 3 (assq response menu)))))))) |
3921 |
|
|
3922 |
|
(defun gnus-mime-button-menu (event prefix) |
3923 |
|
"Construct a context-sensitive menu of MIME commands." |
3924 |
|
(interactive "e\nP") |
3925 |
|
(save-window-excursion |
3926 |
|
(let ((pos (event-start event))) |
3927 |
|
(select-window (posn-window pos)) |
3928 |
|
(goto-char (posn-point pos)) |
3929 |
|
(gnus-article-check-buffer) |
3930 |
|
(popup-menu gnus-mime-button-menu nil prefix)))) |
3931 |
|
|
3932 |
(defun gnus-mime-view-all-parts (&optional handles) |
(defun gnus-mime-view-all-parts (&optional handles) |
3933 |
"View all the MIME parts." |
"View all the MIME parts." |
3937 |
(let ((handles (or handles gnus-article-mime-handles)) |
(let ((handles (or handles gnus-article-mime-handles)) |
3938 |
(mail-parse-charset gnus-newsgroup-charset) |
(mail-parse-charset gnus-newsgroup-charset) |
3939 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
3940 |
(save-excursion (set-buffer gnus-summary-buffer) |
(with-current-buffer gnus-summary-buffer |
3941 |
gnus-newsgroup-ignored-charsets))) |
gnus-newsgroup-ignored-charsets))) |
3942 |
(if (stringp (car handles)) |
(when handles |
3943 |
(gnus-mime-view-all-parts (cdr handles)) |
(mm-remove-parts handles) |
3944 |
(mapcar 'mm-display-part handles))))) |
(goto-char (point-min)) |
3945 |
|
(or (search-forward "\n\n") (goto-char (point-max))) |
3946 |
|
(let ((inhibit-read-only t)) |
3947 |
|
(delete-region (point) (point-max)) |
3948 |
|
(mm-display-parts handles)))))) |
3949 |
|
|
3950 |
|
(defun gnus-mime-save-part-and-strip () |
3951 |
|
"Save the MIME part under point then replace it with an external body." |
3952 |
|
(interactive) |
3953 |
|
(gnus-article-check-buffer) |
3954 |
|
(when (gnus-group-read-only-p) |
3955 |
|
(error "The current group does not support deleting of parts")) |
3956 |
|
(when (mm-complicated-handles gnus-article-mime-handles) |
3957 |
|
(error "\ |
3958 |
|
The current article has a complicated MIME structure, giving up...")) |
3959 |
|
(when (gnus-yes-or-no-p "\ |
3960 |
|
Deleting parts may malfunction or destroy the article; continue? ") |
3961 |
|
(let* ((data (get-text-property (point) 'gnus-data)) |
3962 |
|
file param |
3963 |
|
(handles gnus-article-mime-handles)) |
3964 |
|
(setq file (and data (mm-save-part data))) |
3965 |
|
(when file |
3966 |
|
(with-current-buffer (mm-handle-buffer data) |
3967 |
|
(erase-buffer) |
3968 |
|
(insert "Content-Type: " (mm-handle-media-type data)) |
3969 |
|
(mml-insert-parameter-string (cdr (mm-handle-type data)) |
3970 |
|
'(charset)) |
3971 |
|
(insert "\n") |
3972 |
|
(insert "Content-ID: " (message-make-message-id) "\n") |
3973 |
|
(insert "Content-Transfer-Encoding: binary\n") |
3974 |
|
(insert "\n")) |
3975 |
|
(setcdr data |
3976 |
|
(cdr (mm-make-handle nil |
3977 |
|
`("message/external-body" |
3978 |
|
(access-type . "LOCAL-FILE") |
3979 |
|
(name . ,file))))) |
3980 |
|
(set-buffer gnus-summary-buffer) |
3981 |
|
(gnus-article-edit-article |
3982 |
|
`(lambda () |
3983 |
|
(erase-buffer) |
3984 |
|
(let ((mail-parse-charset (or gnus-article-charset |
3985 |
|
',gnus-newsgroup-charset)) |
3986 |
|
(mail-parse-ignored-charsets |
3987 |
|
(or gnus-article-ignored-charsets |
3988 |
|
',gnus-newsgroup-ignored-charsets)) |
3989 |
|
(mbl mml-buffer-list)) |
3990 |
|
(setq mml-buffer-list nil) |
3991 |
|
(insert-buffer gnus-original-article-buffer) |
3992 |
|
(mime-to-mml ',handles) |
3993 |
|
(setq gnus-article-mime-handles nil) |
3994 |
|
(let ((mbl1 mml-buffer-list)) |
3995 |
|
(setq mml-buffer-list mbl) |
3996 |
|
(set (make-local-variable 'mml-buffer-list) mbl1)) |
3997 |
|
(gnus-make-local-hook 'kill-buffer-hook) |
3998 |
|
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) |
3999 |
|
`(lambda (no-highlight) |
4000 |
|
(let ((mail-parse-charset (or gnus-article-charset |
4001 |
|
',gnus-newsgroup-charset)) |
4002 |
|
(message-options message-options) |
4003 |
|
(message-options-set-recipient) |
4004 |
|
(mail-parse-ignored-charsets |
4005 |
|
(or gnus-article-ignored-charsets |
4006 |
|
',gnus-newsgroup-ignored-charsets))) |
4007 |
|
(mml-to-mime) |
4008 |
|
(mml-destroy-buffers) |
4009 |
|
(remove-hook 'kill-buffer-hook |
4010 |
|
'mml-destroy-buffers t) |
4011 |
|
(kill-local-variable 'mml-buffer-list)) |
4012 |
|
(gnus-summary-edit-article-done |
4013 |
|
,(or (mail-header-references gnus-current-headers) "") |
4014 |
|
,(gnus-group-read-only-p) |
4015 |
|
,gnus-summary-buffer no-highlight))))))) |
4016 |
|
|
4017 |
|
(defun gnus-mime-delete-part () |
4018 |
|
"Delete the MIME part under point. |
4019 |
|
Replace it with some information about the removed part." |
4020 |
|
(interactive) |
4021 |
|
(gnus-article-check-buffer) |
4022 |
|
(when (gnus-group-read-only-p) |
4023 |
|
(error "The current group does not support deleting of parts")) |
4024 |
|
(when (mm-complicated-handles gnus-article-mime-handles) |
4025 |
|
(error "\ |
4026 |
|
The current article has a complicated MIME structure, giving up...")) |
4027 |
|
(when (gnus-yes-or-no-p "\ |
4028 |
|
Deleting parts may malfunction or destroy the article; continue? ") |
4029 |
|
(let* ((data (get-text-property (point) 'gnus-data)) |
4030 |
|
(handles gnus-article-mime-handles) |
4031 |
|
(none "(none)") |
4032 |
|
(description |
4033 |
|
(or |
4034 |
|
(mail-decode-encoded-word-string (or (mm-handle-description data) |
4035 |
|
none)))) |
4036 |
|
(filename |
4037 |
|
(or (mail-content-type-get (mm-handle-disposition data) 'filename) |
4038 |
|
none)) |
4039 |
|
(type (mm-handle-media-type data))) |
4040 |
|
(unless data |
4041 |
|
(error "No MIME part under point")) |
4042 |
|
(with-current-buffer (mm-handle-buffer data) |
4043 |
|
(let ((bsize (format "%s" (buffer-size)))) |
4044 |
|
(erase-buffer) |
4045 |
|
(insert |
4046 |
|
(concat |
4047 |
|
",----\n" |
4048 |
|
"| The following attachment has been deleted:\n" |
4049 |
|
"|\n" |
4050 |
|
"| Type: " type "\n" |
4051 |
|
"| Filename: " filename "\n" |
4052 |
|
"| Size (encoded): " bsize " Byte\n" |
4053 |
|
"| Description: " description "\n" |
4054 |
|
"`----\n")) |
4055 |
|
(setcdr data |
4056 |
|
(cdr (mm-make-handle |
4057 |
|
nil `("text/plain") nil nil |
4058 |
|
(list "attachment") |
4059 |
|
(format "Deleted attachment (%s bytes)" bsize)))))) |
4060 |
|
(set-buffer gnus-summary-buffer) |
4061 |
|
;; FIXME: maybe some of the following code (borrowed from |
4062 |
|
;; `gnus-mime-save-part-and-strip') isn't necessary? |
4063 |
|
(gnus-article-edit-article |
4064 |
|
`(lambda () |
4065 |
|
(erase-buffer) |
4066 |
|
(let ((mail-parse-charset (or gnus-article-charset |
4067 |
|
',gnus-newsgroup-charset)) |
4068 |
|
(mail-parse-ignored-charsets |
4069 |
|
(or gnus-article-ignored-charsets |
4070 |
|
',gnus-newsgroup-ignored-charsets)) |
4071 |
|
(mbl mml-buffer-list)) |
4072 |
|
(setq mml-buffer-list nil) |
4073 |
|
(insert-buffer gnus-original-article-buffer) |
4074 |
|
(mime-to-mml ',handles) |
4075 |
|
(setq gnus-article-mime-handles nil) |
4076 |
|
(let ((mbl1 mml-buffer-list)) |
4077 |
|
(setq mml-buffer-list mbl) |
4078 |
|
(set (make-local-variable 'mml-buffer-list) mbl1)) |
4079 |
|
(gnus-make-local-hook 'kill-buffer-hook) |
4080 |
|
(add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))) |
4081 |
|
`(lambda (no-highlight) |
4082 |
|
(let ((mail-parse-charset (or gnus-article-charset |
4083 |
|
',gnus-newsgroup-charset)) |
4084 |
|
(message-options message-options) |
4085 |
|
(message-options-set-recipient) |
4086 |
|
(mail-parse-ignored-charsets |
4087 |
|
(or gnus-article-ignored-charsets |
4088 |
|
',gnus-newsgroup-ignored-charsets))) |
4089 |
|
(mml-to-mime) |
4090 |
|
(mml-destroy-buffers) |
4091 |
|
(remove-hook 'kill-buffer-hook |
4092 |
|
'mml-destroy-buffers t) |
4093 |
|
(kill-local-variable 'mml-buffer-list)) |
4094 |
|
(gnus-summary-edit-article-done |
4095 |
|
,(or (mail-header-references gnus-current-headers) "") |
4096 |
|
,(gnus-group-read-only-p) |
4097 |
|
,gnus-summary-buffer no-highlight))))) |
4098 |
|
;; Not in `gnus-mime-save-part-and-strip': |
4099 |
|
(gnus-article-edit-done) |
4100 |
|
(gnus-summary-expand-window) |
4101 |
|
(gnus-summary-show-article)) |
4102 |
|
|
4103 |
(defun gnus-mime-save-part () |
(defun gnus-mime-save-part () |
4104 |
"Save the MIME part under point." |
"Save the MIME part under point." |
4105 |
(interactive) |
(interactive) |
4106 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4107 |
(let ((data (get-text-property (point) 'gnus-data))) |
(let ((data (get-text-property (point) 'gnus-data))) |
4108 |
(mm-save-part data))) |
(when data |
4109 |
|
(mm-save-part data)))) |
4110 |
|
|
4111 |
(defun gnus-mime-pipe-part () |
(defun gnus-mime-pipe-part () |
4112 |
"Pipe the MIME part under point to a process." |
"Pipe the MIME part under point to a process." |
4113 |
(interactive) |
(interactive) |
4114 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4115 |
(let ((data (get-text-property (point) 'gnus-data))) |
(let ((data (get-text-property (point) 'gnus-data))) |
4116 |
(mm-pipe-part data))) |
(when data |
4117 |
|
(mm-pipe-part data)))) |
4118 |
|
|
4119 |
(defun gnus-mime-view-part () |
(defun gnus-mime-view-part () |
4120 |
"Interactively choose a viewing method for the MIME part under point." |
"Interactively choose a viewing method for the MIME part under point." |
4121 |
(interactive) |
(interactive) |
4122 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4123 |
(let ((data (get-text-property (point) 'gnus-data))) |
(let ((data (get-text-property (point) 'gnus-data))) |
4124 |
(push (setq data (copy-sequence data)) gnus-article-mime-handles) |
(when data |
4125 |
(mm-interactively-view-part data))) |
(setq gnus-article-mime-handles |
4126 |
|
(mm-merge-handles |
4127 |
|
gnus-article-mime-handles (setq data (copy-sequence data)))) |
4128 |
|
(mm-interactively-view-part data)))) |
4129 |
|
|
4130 |
(defun gnus-mime-view-part-as-type-internal () |
(defun gnus-mime-view-part-as-type-internal () |
4131 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4135 |
(def-type (and name (mm-default-file-encoding name)))) |
(def-type (and name (mm-default-file-encoding name)))) |
4136 |
(and def-type (cons def-type 0)))) |
(and def-type (cons def-type 0)))) |
4137 |
|
|
4138 |
(defun gnus-mime-view-part-as-type (mime-type) |
(defun gnus-mime-view-part-as-type (&optional mime-type) |
4139 |
"Choose a MIME media type, and view the part as such." |
"Choose a MIME media type, and view the part as such." |
4140 |
(interactive |
(interactive) |
4141 |
(list (completing-read |
(unless mime-type |
4142 |
"View as MIME type: " |
(setq mime-type (completing-read |
4143 |
(mapcar #'list (mailcap-mime-types)) |
"View as MIME type: " |
4144 |
nil nil |
(mapcar #'list (mailcap-mime-types)) |
4145 |
(gnus-mime-view-part-as-type-internal)))) |
nil nil |
4146 |
|
(gnus-mime-view-part-as-type-internal)))) |
4147 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4148 |
(let ((handle (get-text-property (point) 'gnus-data))) |
(let ((handle (get-text-property (point) 'gnus-data))) |
4149 |
(gnus-mm-display-part |
(when handle |
4150 |
(mm-make-handle (mm-handle-buffer handle) |
(setq handle |
4151 |
(cons mime-type (cdr (mm-handle-type handle))) |
(mm-make-handle (mm-handle-buffer handle) |
4152 |
(mm-handle-encoding handle) |
(cons mime-type (cdr (mm-handle-type handle))) |
4153 |
(mm-handle-undisplayer handle) |
(mm-handle-encoding handle) |
4154 |
(mm-handle-disposition handle) |
(mm-handle-undisplayer handle) |
4155 |
(mm-handle-description handle) |
(mm-handle-disposition handle) |
4156 |
(mm-handle-cache handle) |
(mm-handle-description handle) |
4157 |
(mm-handle-id handle))))) |
nil |
4158 |
|
(mm-handle-id handle))) |
4159 |
|
(setq gnus-article-mime-handles |
4160 |
|
(mm-merge-handles gnus-article-mime-handles handle)) |
4161 |
|
(gnus-mm-display-part handle)))) |
4162 |
|
|
4163 |
|
(eval-when-compile |
4164 |
|
(require 'jka-compr)) |
4165 |
|
|
4166 |
|
;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days |
4167 |
|
;; emacs can do that itself. |
4168 |
|
;; |
4169 |
|
(defun gnus-mime-jka-compr-maybe-uncompress () |
4170 |
|
"Uncompress the current buffer if `auto-compression-mode' is enabled. |
4171 |
|
The uncompress method used is derived from `buffer-file-name'." |
4172 |
|
(when (and (fboundp 'jka-compr-installed-p) |
4173 |
|
(jka-compr-installed-p)) |
4174 |
|
(let ((info (jka-compr-get-compression-info buffer-file-name))) |
4175 |
|
(when info |
4176 |
|
(let ((basename (file-name-nondirectory buffer-file-name)) |
4177 |
|
(args (jka-compr-info-uncompress-args info)) |
4178 |
|
(prog (jka-compr-info-uncompress-program info)) |
4179 |
|
(message (jka-compr-info-uncompress-message info)) |
4180 |
|
(err-file (jka-compr-make-temp-name))) |
4181 |
|
(if message |
4182 |
|
(message "%s %s..." message basename)) |
4183 |
|
(unwind-protect |
4184 |
|
(unless (memq (apply 'call-process-region |
4185 |
|
(point-min) (point-max) |
4186 |
|
prog |
4187 |
|
t (list t err-file) nil |
4188 |
|
args) |
4189 |
|
jka-compr-acceptable-retval-list) |
4190 |
|
(jka-compr-error prog args basename message err-file)) |
4191 |
|
(jka-compr-delete-temp-file err-file))))))) |
4192 |
|
|
4193 |
(defun gnus-mime-copy-part (&optional handle) |
(defun gnus-mime-copy-part (&optional handle) |
4194 |
"Put the MIME part under point into a new buffer." |
"Put the MIME part under point into a new buffer. |
4195 |
|
If `auto-compression-mode' is enabled, compressed files like .gz and .bz2 |
4196 |
|
are decompressed." |
4197 |
(interactive) |
(interactive) |
4198 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4199 |
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
4200 |
(contents (mm-get-part handle)) |
(contents (and handle (mm-get-part handle))) |
4201 |
(base (file-name-nondirectory |
(base (and handle |
4202 |
(or |
(file-name-nondirectory |
4203 |
(mail-content-type-get (mm-handle-type handle) 'name) |
(or |
4204 |
(mail-content-type-get (mm-handle-type handle) |
(mail-content-type-get (mm-handle-type handle) 'name) |
4205 |
'filename) |
(mail-content-type-get (mm-handle-disposition handle) |
4206 |
"*decoded*"))) |
'filename) |
4207 |
(buffer (generate-new-buffer base))) |
"*decoded*")))) |
4208 |
(switch-to-buffer buffer) |
(buffer (and base (generate-new-buffer base)))) |
4209 |
(insert contents) |
(when contents |
4210 |
;; We do it this way to make `normal-mode' set the appropriate mode. |
(switch-to-buffer buffer) |
4211 |
(unwind-protect |
(insert contents) |
4212 |
(progn |
;; We do it this way to make `normal-mode' set the appropriate mode. |
4213 |
(setq buffer-file-name (expand-file-name base)) |
(unwind-protect |
4214 |
(normal-mode)) |
(progn |
4215 |
(setq buffer-file-name nil)) |
(setq buffer-file-name (expand-file-name base)) |
4216 |
(goto-char (point-min)))) |
(gnus-mime-jka-compr-maybe-uncompress) |
4217 |
|
(normal-mode)) |
4218 |
|
(setq buffer-file-name nil)) |
4219 |
|
(goto-char (point-min))))) |
4220 |
|
|
4221 |
|
(defun gnus-mime-print-part (&optional handle filename) |
4222 |
|
"Print the MIME part under point." |
4223 |
|
(interactive (list nil (ps-print-preprint current-prefix-arg))) |
4224 |
|
(gnus-article-check-buffer) |
4225 |
|
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
4226 |
|
(contents (and handle (mm-get-part handle))) |
4227 |
|
(file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory))) |
4228 |
|
(printer (mailcap-mime-info (mm-handle-media-type handle) "print"))) |
4229 |
|
(when contents |
4230 |
|
(if printer |
4231 |
|
(unwind-protect |
4232 |
|
(progn |
4233 |
|
(mm-save-part-to-file handle file) |
4234 |
|
(call-process shell-file-name nil |
4235 |
|
(generate-new-buffer " *mm*") |
4236 |
|
nil |
4237 |
|
shell-command-switch |
4238 |
|
(mm-mailcap-command |
4239 |
|
printer file (mm-handle-type handle)))) |
4240 |
|
(delete-file file)) |
4241 |
|
(with-temp-buffer |
4242 |
|
(insert contents) |
4243 |
|
(gnus-print-buffer)) |
4244 |
|
(ps-despool filename))))) |
4245 |
|
|
4246 |
(defun gnus-mime-inline-part (&optional handle arg) |
(defun gnus-mime-inline-part (&optional handle arg) |
4247 |
"Insert the MIME part under point into the current buffer." |
"Insert the MIME part under point into the current buffer." |
4250 |
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
4251 |
contents charset |
contents charset |
4252 |
(b (point)) |
(b (point)) |
4253 |
buffer-read-only) |
(inhibit-read-only t)) |
4254 |
(if (mm-handle-undisplayer handle) |
(when handle |
4255 |
(mm-remove-part handle) |
(if (and (not arg) (mm-handle-undisplayer handle)) |
4256 |
(setq contents (mm-get-part handle)) |
(mm-remove-part handle) |
4257 |
(cond |
(setq contents (mm-get-part handle)) |
4258 |
((not arg) |
(cond |
4259 |
(setq charset (or (mail-content-type-get |
((not arg) |
4260 |
(mm-handle-type handle) 'charset) |
(setq charset (or (mail-content-type-get |
4261 |
gnus-newsgroup-charset))) |
(mm-handle-type handle) 'charset) |
4262 |
((numberp arg) |
gnus-newsgroup-charset))) |
4263 |
(setq charset |
((numberp arg) |
4264 |
(or (cdr (assq arg |
(if (mm-handle-undisplayer handle) |
4265 |
gnus-summary-show-article-charset-alist)) |
(mm-remove-part handle)) |
4266 |
(read-coding-system "Charset: "))))) |
(setq charset |
4267 |
(forward-line 2) |
(or (cdr (assq arg |
4268 |
(mm-insert-inline handle |
gnus-summary-show-article-charset-alist)) |
4269 |
(if (and charset |
(mm-read-coding-system "Charset: "))))) |
4270 |
(setq charset (mm-charset-to-coding-system |
(forward-line 2) |
4271 |
charset)) |
(mm-insert-inline handle |
4272 |
(not (eq charset 'ascii))) |
(if (and charset |
4273 |
(mm-decode-coding-string contents charset) |
(setq charset (mm-charset-to-coding-system |
4274 |
contents)) |
charset)) |
4275 |
(goto-char b)))) |
(not (eq charset 'ascii))) |
4276 |
|
(mm-decode-coding-string contents charset) |
4277 |
|
contents)) |
4278 |
|
(goto-char b))))) |
4279 |
|
|
4280 |
|
(defun gnus-mime-view-part-as-charset (&optional handle arg) |
4281 |
|
"Insert the MIME part under point into the current buffer using the |
4282 |
|
specified charset." |
4283 |
|
(interactive (list nil current-prefix-arg)) |
4284 |
|
(gnus-article-check-buffer) |
4285 |
|
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
4286 |
|
contents charset |
4287 |
|
(b (point)) |
4288 |
|
(inhibit-read-only t)) |
4289 |
|
(when handle |
4290 |
|
(if (mm-handle-undisplayer handle) |
4291 |
|
(mm-remove-part handle)) |
4292 |
|
(let ((gnus-newsgroup-charset |
4293 |
|
(or (cdr (assq arg |
4294 |
|
gnus-summary-show-article-charset-alist)) |
4295 |
|
(mm-read-coding-system "Charset: "))) |
4296 |
|
(gnus-newsgroup-ignored-charsets 'gnus-all)) |
4297 |
|
(gnus-article-press-button))))) |
4298 |
|
|
4299 |
(defun gnus-mime-externalize-part (&optional handle) |
(defun gnus-mime-view-part-externally (&optional handle) |
4300 |
"View the MIME part under point with an external viewer." |
"View the MIME part under point with an external viewer." |
4301 |
(interactive) |
(interactive) |
4302 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4307 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
4308 |
(save-excursion (set-buffer gnus-summary-buffer) |
(save-excursion (set-buffer gnus-summary-buffer) |
4309 |
gnus-newsgroup-ignored-charsets))) |
gnus-newsgroup-ignored-charsets))) |
4310 |
(if (mm-handle-undisplayer handle) |
(when handle |
4311 |
(mm-remove-part handle) |
(if (mm-handle-undisplayer handle) |
4312 |
(mm-display-part handle)))) |
(mm-remove-part handle) |
4313 |
|
(mm-display-part handle))))) |
4314 |
|
|
4315 |
(defun gnus-mime-internalize-part (&optional handle) |
(defun gnus-mime-view-part-internally (&optional handle) |
4316 |
"View the MIME part under point with an internal viewer. |
"View the MIME part under point with an internal viewer. |
4317 |
In no internal viewer is available, use an external viewer." |
If no internal viewer is available, use an external viewer." |
4318 |
(interactive) |
(interactive) |
4319 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4320 |
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
(let* ((handle (or handle (get-text-property (point) 'gnus-data))) |
4323 |
(mail-parse-charset gnus-newsgroup-charset) |
(mail-parse-charset gnus-newsgroup-charset) |
4324 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
4325 |
(save-excursion (set-buffer gnus-summary-buffer) |
(save-excursion (set-buffer gnus-summary-buffer) |
4326 |
gnus-newsgroup-ignored-charsets))) |
gnus-newsgroup-ignored-charsets)) |
4327 |
(if (mm-handle-undisplayer handle) |
(inhibit-read-only t)) |
4328 |
(mm-remove-part handle) |
(when handle |
4329 |
(mm-display-part handle)))) |
(if (mm-handle-undisplayer handle) |
4330 |
|
(mm-remove-part handle) |
4331 |
|
(mm-display-part handle))))) |
4332 |
|
|
4333 |
(defun gnus-mime-action-on-part (&optional action) |
(defun gnus-mime-action-on-part (&optional action) |
4334 |
"Do something with the MIME attachment at \(point\)." |
"Do something with the MIME attachment at \(point\)." |
4335 |
(interactive |
(interactive |
4336 |
(list (completing-read "Action: " gnus-mime-action-alist))) |
(list (completing-read "Action: " gnus-mime-action-alist nil t))) |
4337 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
4338 |
(let ((action-pair (assoc action gnus-mime-action-alist))) |
(let ((action-pair (assoc action gnus-mime-action-alist))) |
4339 |
(if action-pair |
(if action-pair |
4340 |
(funcall (cdr action-pair))))) |
(funcall (cdr action-pair))))) |
4341 |
|
|
|
|
|
4342 |
(defun gnus-article-part-wrapper (n function) |
(defun gnus-article-part-wrapper (n function) |
4343 |
(save-current-buffer |
(save-current-buffer |
4344 |
(set-buffer gnus-article-buffer) |
(set-buffer gnus-article-buffer) |
4368 |
(interactive "p") |
(interactive "p") |
4369 |
(gnus-article-part-wrapper n 'gnus-mime-copy-part)) |
(gnus-article-part-wrapper n 'gnus-mime-copy-part)) |
4370 |
|
|
4371 |
(defun gnus-article-externalize-part (n) |
(defun gnus-article-view-part-as-charset (n) |
4372 |
|
"View MIME part N using a specified charset. |
4373 |
|
N is the numerical prefix." |
4374 |
|
(interactive "p") |
4375 |
|
(gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset)) |
4376 |
|
|
4377 |
|
(defun gnus-article-view-part-externally (n) |
4378 |
"View MIME part N externally, which is the numerical prefix." |
"View MIME part N externally, which is the numerical prefix." |
4379 |
(interactive "p") |
(interactive "p") |
4380 |
(gnus-article-part-wrapper n 'gnus-mime-externalize-part)) |
(gnus-article-part-wrapper n 'gnus-mime-view-part-externally)) |
4381 |
|
|
4382 |
(defun gnus-article-inline-part (n) |
(defun gnus-article-inline-part (n) |
4383 |
"Inline MIME part N, which is the numerical prefix." |
"Inline MIME part N, which is the numerical prefix." |
4429 |
"Display HANDLE and fix MIME button." |
"Display HANDLE and fix MIME button." |
4430 |
(let ((id (get-text-property (point) 'gnus-part)) |
(let ((id (get-text-property (point) 'gnus-part)) |
4431 |
(point (point)) |
(point (point)) |
4432 |
buffer-read-only) |
(inhibit-read-only t)) |
4433 |
(forward-line 1) |
(forward-line 1) |
4434 |
(prog1 |
(prog1 |
4435 |
(let ((window (selected-window)) |
(let ((window (selected-window)) |
4436 |
(mail-parse-charset gnus-newsgroup-charset) |
(mail-parse-charset gnus-newsgroup-charset) |
4437 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
4438 |
(save-excursion (set-buffer gnus-summary-buffer) |
(if (gnus-buffer-live-p gnus-summary-buffer) |
4439 |
gnus-newsgroup-ignored-charsets))) |
(save-excursion |
4440 |
|
(set-buffer gnus-summary-buffer) |
4441 |
|
gnus-newsgroup-ignored-charsets) |
4442 |
|
nil))) |
4443 |
(save-excursion |
(save-excursion |
4444 |
(unwind-protect |
(unwind-protect |
4445 |
(let ((win (get-buffer-window (current-buffer) t)) |
(let ((win (gnus-get-buffer-window (current-buffer) t)) |
4446 |
(beg (point))) |
(beg (point))) |
4447 |
(when win |
(when win |
4448 |
(select-window win)) |
(select-window win)) |
4452 |
;; This will remove the part. |
;; This will remove the part. |
4453 |
(mm-display-part handle) |
(mm-display-part handle) |
4454 |
(save-restriction |
(save-restriction |
4455 |
(narrow-to-region (point) (1+ (point))) |
(narrow-to-region (point) |
4456 |
|
(if (eobp) (point) (1+ (point)))) |
4457 |
(mm-display-part handle) |
(mm-display-part handle) |
4458 |
;; We narrow to the part itself and |
;; We narrow to the part itself and |
4459 |
;; then call the treatment functions. |
;; then call the treatment functions. |
4464 |
nil id |
nil id |
4465 |
(gnus-article-mime-total-parts) |
(gnus-article-mime-total-parts) |
4466 |
(mm-handle-media-type handle))))) |
(mm-handle-media-type handle))))) |
4467 |
(select-window window)))) |
(if (window-live-p window) |
4468 |
|
(select-window window))))) |
4469 |
(goto-char point) |
(goto-char point) |
4470 |
(delete-region (gnus-point-at-bol) (progn (forward-line 1) (point))) |
(gnus-delete-line) |
4471 |
(gnus-insert-mime-button |
(gnus-insert-mime-button |
4472 |
handle id (list (mm-handle-displayed-p handle))) |
handle id (list (mm-handle-displayed-p handle))) |
4473 |
(goto-char point)))) |
(goto-char point)))) |
4474 |
|
|
4475 |
(defun gnus-article-goto-part (n) |
(defun gnus-article-goto-part (n) |
4476 |
"Go to MIME part N." |
"Go to MIME part N." |
4477 |
(let ((point (text-property-any (point-min) (point-max) 'gnus-part n))) |
(gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n))) |
|
(when point |
|
|
(goto-char point)))) |
|
4478 |
|
|
4479 |
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) |
(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed) |
4480 |
(let ((gnus-tmp-name |
(let ((gnus-tmp-name |
4481 |
(or (mail-content-type-get (mm-handle-type handle) |
(or (mail-content-type-get (mm-handle-type handle) 'name) |
4482 |
'name) |
(mail-content-type-get (mm-handle-disposition handle) 'filename) |
4483 |
(mail-content-type-get (mm-handle-disposition handle) |
(mail-content-type-get (mm-handle-type handle) 'url) |
|
'filename) |
|
4484 |
"")) |
"")) |
4485 |
(gnus-tmp-type (mm-handle-media-type handle)) |
(gnus-tmp-type (mm-handle-media-type handle)) |
4486 |
(gnus-tmp-description |
(gnus-tmp-description |
4498 |
(setq gnus-tmp-type-long (concat gnus-tmp-type |
(setq gnus-tmp-type-long (concat gnus-tmp-type |
4499 |
(and (not (equal gnus-tmp-name "")) |
(and (not (equal gnus-tmp-name "")) |
4500 |
(concat "; " gnus-tmp-name)))) |
(concat "; " gnus-tmp-name)))) |
4501 |
(or (equal gnus-tmp-description "") |
(unless (equal gnus-tmp-description "") |
4502 |
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) |
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) |
4503 |
(unless (bolp) |
(unless (bolp) |
4504 |
(insert "\n")) |
(insert "\n")) |
4505 |
(setq b (point)) |
(setq b (point)) |
4506 |
(gnus-eval-format |
(gnus-eval-format |
4507 |
gnus-mime-button-line-format gnus-mime-button-line-format-alist |
gnus-mime-button-line-format gnus-mime-button-line-format-alist |
4508 |
`(keymap ,gnus-mime-button-map |
`(,@(gnus-local-map-property gnus-mime-button-map) |
4509 |
;; Not for Emacs 21: fixme better. |
gnus-callback gnus-mm-display-part |
4510 |
;; local-map ,gnus-mime-button-map |
gnus-part ,gnus-tmp-id |
4511 |
gnus-callback gnus-mm-display-part |
article-type annotation |
4512 |
gnus-part ,gnus-tmp-id |
gnus-data ,handle)) |
4513 |
article-type annotation |
(setq e (if (bolp) |
4514 |
gnus-data ,handle)) |
;; Exclude a newline. |
4515 |
(setq e (point)) |
(1- (point)) |
4516 |
|
(point))) |
4517 |
(widget-convert-button |
(widget-convert-button |
4518 |
'link b e |
'link b e |
4519 |
:mime-handle handle |
:mime-handle handle |
4556 |
;; We have to do this since selecting the window |
;; We have to do this since selecting the window |
4557 |
;; may change the point. So we set the window point. |
;; may change the point. So we set the window point. |
4558 |
(set-window-point window point))) |
(set-window-point window point))) |
4559 |
(let* ((handles (or ihandles (mm-dissect-buffer) (mm-uu-dissect))) |
(let* ((handles (or ihandles |
4560 |
buffer-read-only handle name type b e display) |
(mm-dissect-buffer nil gnus-article-loose-mime) |
4561 |
|
(and gnus-article-emulate-mime |
4562 |
|
(mm-uu-dissect)))) |
4563 |
|
(inhibit-read-only t) handle name type b e display) |
4564 |
(when (and (not ihandles) |
(when (and (not ihandles) |
4565 |
(not gnus-displaying-mime)) |
(not gnus-displaying-mime)) |
4566 |
;; Top-level call; we clean up. |
;; Top-level call; we clean up. |
4595 |
(narrow-to-region (point-min) (point)) |
(narrow-to-region (point-min) (point)) |
4596 |
(gnus-treat-article 'head)))))))) |
(gnus-treat-article 'head)))))))) |
4597 |
|
|
4598 |
(defvar gnus-mime-display-multipart-as-mixed nil) |
(defcustom gnus-mime-display-multipart-as-mixed nil |
4599 |
|
"Display \"multipart\" parts as \"multipart/mixed\". |
4600 |
|
|
4601 |
|
If t, it overrides nil values of |
4602 |
|
`gnus-mime-display-multipart-alternative-as-mixed' and |
4603 |
|
`gnus-mime-display-multipart-related-as-mixed'." |
4604 |
|
:group 'gnus-article-mime |
4605 |
|
:type 'boolean) |
4606 |
|
|
4607 |
|
(defcustom gnus-mime-display-multipart-alternative-as-mixed nil |
4608 |
|
"Display \"multipart/alternative\" parts as \"multipart/mixed\"." |
4609 |
|
:group 'gnus-article-mime |
4610 |
|
:type 'boolean) |
4611 |
|
|
4612 |
|
(defcustom gnus-mime-display-multipart-related-as-mixed nil |
4613 |
|
"Display \"multipart/related\" parts as \"multipart/mixed\". |
4614 |
|
|
4615 |
|
If displaying \"text/html\" is discouraged \(see |
4616 |
|
`mm-discouraged-alternatives'\) images or other material inside a |
4617 |
|
\"multipart/related\" part might be overlooked when this variable is nil." |
4618 |
|
:group 'gnus-article-mime |
4619 |
|
:type 'boolean) |
4620 |
|
|
4621 |
(defun gnus-mime-display-part (handle) |
(defun gnus-mime-display-part (handle) |
4622 |
(cond |
(cond |
4629 |
handle)) |
handle)) |
4630 |
;; multipart/alternative |
;; multipart/alternative |
4631 |
((and (equal (car handle) "multipart/alternative") |
((and (equal (car handle) "multipart/alternative") |
4632 |
(not gnus-mime-display-multipart-as-mixed)) |
(not (or gnus-mime-display-multipart-as-mixed |
4633 |
|
gnus-mime-display-multipart-alternative-as-mixed))) |
4634 |
(let ((id (1+ (length gnus-article-mime-handle-alist)))) |
(let ((id (1+ (length gnus-article-mime-handle-alist)))) |
4635 |
(push (cons id handle) gnus-article-mime-handle-alist) |
(push (cons id handle) gnus-article-mime-handle-alist) |
4636 |
(gnus-mime-display-alternative (cdr handle) nil nil id))) |
(gnus-mime-display-alternative (cdr handle) nil nil id))) |
4637 |
;; multipart/related |
;; multipart/related |
4638 |
((and (equal (car handle) "multipart/related") |
((and (equal (car handle) "multipart/related") |
4639 |
(not gnus-mime-display-multipart-as-mixed)) |
(not (or gnus-mime-display-multipart-as-mixed |
4640 |
|
gnus-mime-display-multipart-related-as-mixed))) |
4641 |
;;;!!!We should find the start part, but we just default |
;;;!!!We should find the start part, but we just default |
4642 |
;;;!!!to the first part. |
;;;!!!to the first part. |
4643 |
|
;;(gnus-mime-display-part (cadr handle)) |
4644 |
|
;;;!!! Most multipart/related is an HTML message plus images. |
4645 |
|
;;;!!! Unfortunately we are unable to let W3 display those |
4646 |
|
;;;!!! included images, so we just display it as a mixed multipart. |
4647 |
|
;;(gnus-mime-display-mixed (cdr handle)) |
4648 |
|
;;;!!! No, w3 can display everything just fine. |
4649 |
(gnus-mime-display-part (cadr handle))) |
(gnus-mime-display-part (cadr handle))) |
4650 |
|
((equal (car handle) "multipart/signed") |
4651 |
|
(gnus-add-wash-type 'signed) |
4652 |
|
(gnus-mime-display-security handle)) |
4653 |
|
((equal (car handle) "multipart/encrypted") |
4654 |
|
(gnus-add-wash-type 'encrypted) |
4655 |
|
(gnus-mime-display-security handle)) |
4656 |
;; Other multiparts are handled like multipart/mixed. |
;; Other multiparts are handled like multipart/mixed. |
4657 |
(t |
(t |
4658 |
(gnus-mime-display-mixed (cdr handle))))) |
(gnus-mime-display-mixed (cdr handle))))) |
4683 |
"inline") |
"inline") |
4684 |
(mm-attachment-override-p handle)))) |
(mm-attachment-override-p handle)))) |
4685 |
(mm-automatic-display-p handle) |
(mm-automatic-display-p handle) |
4686 |
(or (mm-inlined-p handle) |
(or (and |
4687 |
|
(mm-inlinable-p handle) |
4688 |
|
(mm-inlined-p handle)) |
4689 |
(mm-automatic-external-display-p type))) |
(mm-automatic-external-display-p type))) |
4690 |
(setq display t) |
(setq display t) |
4691 |
(when (equal (mm-handle-media-supertype handle) "text") |
(when (equal (mm-handle-media-supertype handle) "text") |
4700 |
handle id (list (or display (and not-attachment text)))) |
handle id (list (or display (and not-attachment text)))) |
4701 |
(gnus-article-insert-newline) |
(gnus-article-insert-newline) |
4702 |
;(gnus-article-insert-newline) |
;(gnus-article-insert-newline) |
4703 |
|
;; Remember modify the number of forward lines. |
4704 |
(setq move t)) |
(setq move t)) |
4705 |
(setq beg (point)) |
(setq beg (point)) |
4706 |
(cond |
(cond |
4707 |
(display |
(display |
4708 |
(when move |
(when move |
4709 |
(forward-line -2) |
(forward-line -1) |
4710 |
(setq beg (point))) |
(setq beg (point))) |
4711 |
(let ((mail-parse-charset gnus-newsgroup-charset) |
(let ((mail-parse-charset gnus-newsgroup-charset) |
4712 |
(mail-parse-ignored-charsets |
(mail-parse-ignored-charsets |
4718 |
(goto-char (point-max))) |
(goto-char (point-max))) |
4719 |
((and text not-attachment) |
((and text not-attachment) |
4720 |
(when move |
(when move |
4721 |
(forward-line -2) |
(forward-line -1) |
4722 |
(setq beg (point))) |
(setq beg (point))) |
4723 |
(gnus-article-insert-newline) |
(gnus-article-insert-newline) |
4724 |
(mm-insert-inline handle (mm-get-part handle)) |
(mm-insert-inline handle (mm-get-part handle)) |
4735 |
(defun gnus-unbuttonized-mime-type-p (type) |
(defun gnus-unbuttonized-mime-type-p (type) |
4736 |
"Say whether TYPE is to be unbuttonized." |
"Say whether TYPE is to be unbuttonized." |
4737 |
(unless gnus-inhibit-mime-unbuttonizing |
(unless gnus-inhibit-mime-unbuttonizing |
4738 |
(catch 'found |
(when (catch 'found |
4739 |
(let ((types gnus-unbuttonized-mime-types)) |
(let ((types gnus-unbuttonized-mime-types)) |
4740 |
(while types |
(while types |
4741 |
(when (string-match (pop types) type) |
(when (string-match (pop types) type) |
4742 |
(throw 'found t))))))) |
(throw 'found t))))) |
4743 |
|
(not (catch 'found |
4744 |
|
(let ((types gnus-buttonized-mime-types)) |
4745 |
|
(while types |
4746 |
|
(when (string-match (pop types) type) |
4747 |
|
(throw 'found t))))))))) |
4748 |
|
|
4749 |
(defun gnus-article-insert-newline () |
(defun gnus-article-insert-newline () |
4750 |
"Insert a newline, but mark it as undeletable." |
"Insert a newline, but mark it as undeletable." |
4755 |
(let* ((preferred (or preferred (mm-preferred-alternative handles))) |
(let* ((preferred (or preferred (mm-preferred-alternative handles))) |
4756 |
(ihandles handles) |
(ihandles handles) |
4757 |
(point (point)) |
(point (point)) |
4758 |
handle buffer-read-only from props begend not-pref) |
handle (inhibit-read-only t) from props begend not-pref) |
4759 |
(save-window-excursion |
(save-window-excursion |
4760 |
(save-restriction |
(save-restriction |
4761 |
(when ibegend |
(when ibegend |
4772 |
(unless (setq not-pref (cadr (member preferred ihandles))) |
(unless (setq not-pref (cadr (member preferred ihandles))) |
4773 |
(setq not-pref (car ihandles))) |
(setq not-pref (car ihandles))) |
4774 |
(when (or ibegend |
(when (or ibegend |
4775 |
|
(not preferred) |
4776 |
(not (gnus-unbuttonized-mime-type-p |
(not (gnus-unbuttonized-mime-type-p |
4777 |
"multipart/alternative"))) |
"multipart/alternative"))) |
4778 |
(gnus-add-text-properties |
(gnus-add-text-properties |
4787 |
',gnus-article-mime-handle-alist)) |
',gnus-article-mime-handle-alist)) |
4788 |
(gnus-mime-display-alternative |
(gnus-mime-display-alternative |
4789 |
',ihandles ',not-pref ',begend ,id)) |
',ihandles ',not-pref ',begend ,id)) |
4790 |
;; Not for Emacs 21: fixme better. |
,@(gnus-local-map-property gnus-mime-button-map) |
|
;; local-map ,gnus-mime-button-map |
|
4791 |
,gnus-mouse-face-prop ,gnus-article-mouse-face |
,gnus-mouse-face-prop ,gnus-article-mouse-face |
4792 |
face ,gnus-article-button-face |
face ,gnus-article-button-face |
|
keymap ,gnus-mime-button-map |
|
4793 |
gnus-part ,id |
gnus-part ,id |
4794 |
gnus-data ,handle)) |
gnus-data ,handle)) |
4795 |
(widget-convert-button 'link from (point) |
(widget-convert-button 'link from (point) |
4811 |
',gnus-article-mime-handle-alist)) |
',gnus-article-mime-handle-alist)) |
4812 |
(gnus-mime-display-alternative |
(gnus-mime-display-alternative |
4813 |
',ihandles ',handle ',begend ,id)) |
',ihandles ',handle ',begend ,id)) |
4814 |
;; Not for Emacs 21: fixme better. |
,@(gnus-local-map-property gnus-mime-button-map) |
|
;; local-map ,gnus-mime-button-map |
|
4815 |
,gnus-mouse-face-prop ,gnus-article-mouse-face |
,gnus-mouse-face-prop ,gnus-article-mouse-face |
4816 |
face ,gnus-article-button-face |
face ,gnus-article-button-face |
|
keymap ,gnus-mime-button-map |
|
4817 |
gnus-part ,id |
gnus-part ,id |
4818 |
gnus-data ,handle)) |
gnus-data ,handle)) |
4819 |
(widget-convert-button 'link from (point) |
(widget-convert-button 'link from (point) |
4842 |
(when ibegend |
(when ibegend |
4843 |
(goto-char point)))) |
(goto-char point)))) |
4844 |
|
|
4845 |
|
(defconst gnus-article-wash-status-strings |
4846 |
|
(let ((alist '((cite "c" "Possible hidden citation text" |
4847 |
|
" " "All citation text visible") |
4848 |
|
(headers "h" "Hidden headers" |
4849 |
|
" " "All headers visible.") |
4850 |
|
(pgp "p" "Encrypted or signed message status hidden" |
4851 |
|
" " "No hidden encryption nor digital signature status") |
4852 |
|
(signature "s" "Signature has been hidden" |
4853 |
|
" " "Signature is visible") |
4854 |
|
(overstrike "o" "Overstrike (^H) characters applied" |
4855 |
|
" " "No overstrike characters applied") |
4856 |
|
(emphasis "e" "/*_Emphasis_*/ characters applied" |
4857 |
|
" " "No /*_emphasis_*/ characters applied"))) |
4858 |
|
result) |
4859 |
|
(dolist (entry alist result) |
4860 |
|
(let ((key (nth 0 entry)) |
4861 |
|
(on (copy-sequence (nth 1 entry))) |
4862 |
|
(on-help (nth 2 entry)) |
4863 |
|
(off (copy-sequence (nth 3 entry))) |
4864 |
|
(off-help (nth 4 entry))) |
4865 |
|
(put-text-property 0 1 'help-echo on-help on) |
4866 |
|
(put-text-property 0 1 'help-echo off-help off) |
4867 |
|
(push (list key on off) result)))) |
4868 |
|
"Alist of strings describing wash status in the mode line. |
4869 |
|
Each entry has the form (KEY ON OF), where the KEY is a symbol |
4870 |
|
representing the particular washing function, ON is the string to use |
4871 |
|
in the article mode line when the washing function is active, and OFF |
4872 |
|
is the string to use when it is inactive.") |
4873 |
|
|
4874 |
|
(defun gnus-article-wash-status-entry (key value) |
4875 |
|
(let ((entry (assoc key gnus-article-wash-status-strings))) |
4876 |
|
(if value (nth 1 entry) (nth 2 entry)))) |
4877 |
|
|
4878 |
(defun gnus-article-wash-status () |
(defun gnus-article-wash-status () |
4879 |
"Return a string which display status of article washing." |
"Return a string which display status of article washing." |
4880 |
(save-excursion |
(save-excursion |
4884 |
(boring (memq 'boring-headers gnus-article-wash-types)) |
(boring (memq 'boring-headers gnus-article-wash-types)) |
4885 |
(pgp (memq 'pgp gnus-article-wash-types)) |
(pgp (memq 'pgp gnus-article-wash-types)) |
4886 |
(pem (memq 'pem gnus-article-wash-types)) |
(pem (memq 'pem gnus-article-wash-types)) |
4887 |
|
(signed (memq 'signed gnus-article-wash-types)) |
4888 |
|
(encrypted (memq 'encrypted gnus-article-wash-types)) |
4889 |
(signature (memq 'signature gnus-article-wash-types)) |
(signature (memq 'signature gnus-article-wash-types)) |
4890 |
(overstrike (memq 'overstrike gnus-article-wash-types)) |
(overstrike (memq 'overstrike gnus-article-wash-types)) |
4891 |
(emphasis (memq 'emphasis gnus-article-wash-types))) |
(emphasis (memq 'emphasis gnus-article-wash-types))) |
4892 |
(format "%c%c%c%c%c%c" |
(concat |
4893 |
(if cite ?c ? ) |
(gnus-article-wash-status-entry 'cite cite) |
4894 |
(if (or headers boring) ?h ? ) |
(gnus-article-wash-status-entry 'headers (or headers boring)) |
4895 |
(if (or pgp pem) ?p ? ) |
(gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted)) |
4896 |
(if signature ?s ? ) |
(gnus-article-wash-status-entry 'signature signature) |
4897 |
(if overstrike ?o ? ) |
(gnus-article-wash-status-entry 'overstrike overstrike) |
4898 |
(if emphasis ?e ? ))))) |
(gnus-article-wash-status-entry 'emphasis emphasis))))) |
4899 |
|
|
4900 |
|
(defun gnus-add-wash-type (type) |
4901 |
|
"Add a washing of TYPE to the current status." |
4902 |
|
(add-to-list 'gnus-article-wash-types type)) |
4903 |
|
|
4904 |
|
(defun gnus-delete-wash-type (type) |
4905 |
|
"Add a washing of TYPE to the current status." |
4906 |
|
(setq gnus-article-wash-types (delq type gnus-article-wash-types))) |
4907 |
|
|
4908 |
|
(defun gnus-add-image (category image) |
4909 |
|
"Add IMAGE of CATEGORY to the list of displayed images." |
4910 |
|
(let ((entry (assq category gnus-article-image-alist))) |
4911 |
|
(unless entry |
4912 |
|
(setq entry (list category)) |
4913 |
|
(push entry gnus-article-image-alist)) |
4914 |
|
(nconc entry (list image)))) |
4915 |
|
|
4916 |
|
(defun gnus-delete-images (category) |
4917 |
|
"Delete all images in CATEGORY." |
4918 |
|
(let ((entry (assq category gnus-article-image-alist))) |
4919 |
|
(dolist (image (cdr entry)) |
4920 |
|
(gnus-remove-image image category)) |
4921 |
|
(setq gnus-article-image-alist (delq entry gnus-article-image-alist)) |
4922 |
|
(gnus-delete-wash-type category))) |
4923 |
|
|
4924 |
(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) |
(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers) |
4925 |
|
|
4961 |
(let ((inhibit-read-only t)) |
(let ((inhibit-read-only t)) |
4962 |
(gnus-remove-text-with-property 'gnus-prev) |
(gnus-remove-text-with-property 'gnus-prev) |
4963 |
(gnus-remove-text-with-property 'gnus-next))) |
(gnus-remove-text-with-property 'gnus-next))) |
4964 |
(when |
(if |
4965 |
(cond ((< arg 0) |
(cond ((< arg 0) |
4966 |
(re-search-backward page-delimiter nil 'move (1+ (abs arg)))) |
(re-search-backward page-delimiter nil 'move (1+ (abs arg)))) |
4967 |
((> arg 0) |
((> arg 0) |
4968 |
(re-search-forward page-delimiter nil 'move arg))) |
(re-search-forward page-delimiter nil 'move arg))) |
4969 |
(goto-char (match-end 0))) |
(goto-char (match-end 0)) |
|
(narrow-to-region |
|
|
(point) |
|
|
(if (re-search-forward page-delimiter nil 'move) |
|
|
(match-beginning 0) |
|
|
(point))) |
|
|
(when (and (gnus-visual-p 'page-marker) |
|
|
(> (point-min) (save-restriction (widen) (point-min)))) |
|
4970 |
(save-excursion |
(save-excursion |
4971 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4972 |
(gnus-insert-prev-page-button))) |
(setq gnus-page-broken |
4973 |
(when (and (gnus-visual-p 'page-marker) |
(and (re-search-forward page-delimiter nil t) t)))) |
4974 |
(< (point-max) (save-restriction (widen) (point-max)))) |
(when gnus-page-broken |
4975 |
(save-excursion |
(narrow-to-region |
4976 |
(goto-char (point-max)) |
(point) |
4977 |
(gnus-insert-next-page-button))))) |
(if (re-search-forward page-delimiter nil 'move) |
4978 |
|
(match-beginning 0) |
4979 |
|
(point))) |
4980 |
|
(when (and (gnus-visual-p 'page-marker) |
4981 |
|
(> (point-min) (save-restriction (widen) (point-min)))) |
4982 |
|
(save-excursion |
4983 |
|
(goto-char (point-min)) |
4984 |
|
(gnus-insert-prev-page-button))) |
4985 |
|
(when (and (gnus-visual-p 'page-marker) |
4986 |
|
(< (+ (point-max) 2) (buffer-size))) |
4987 |
|
(save-excursion |
4988 |
|
(goto-char (point-max)) |
4989 |
|
(gnus-insert-next-page-button)))))) |
4990 |
|
|
4991 |
;; Article mode commands |
;; Article mode commands |
4992 |
|
|
4997 |
(goto-char (point-min)) |
(goto-char (point-min)) |
4998 |
(gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) |
(gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) |
4999 |
|
|
5000 |
|
|
5001 |
(defun gnus-article-goto-prev-page () |
(defun gnus-article-goto-prev-page () |
5002 |
"Show the next page of the article." |
"Show the previous page of the article." |
5003 |
(interactive) |
(interactive) |
5004 |
(if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) |
(if (bobp) |
5005 |
|
(gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) |
5006 |
(gnus-article-prev-page nil))) |
(gnus-article-prev-page nil))) |
5007 |
|
|
5008 |
|
;; This is cleaner but currently breaks `gnus-pick-mode': |
5009 |
|
;; |
5010 |
|
;; (defun gnus-article-goto-next-page () |
5011 |
|
;; "Show the next page of the article." |
5012 |
|
;; (interactive) |
5013 |
|
;; (gnus-eval-in-buffer-window gnus-summary-buffer |
5014 |
|
;; (gnus-summary-next-page))) |
5015 |
|
;; |
5016 |
|
;; (defun gnus-article-goto-prev-page () |
5017 |
|
;; "Show the next page of the article." |
5018 |
|
;; (interactive) |
5019 |
|
;; (gnus-eval-in-buffer-window gnus-summary-buffer |
5020 |
|
;; (gnus-summary-prev-page))) |
5021 |
|
|
5022 |
(defun gnus-article-next-page (&optional lines) |
(defun gnus-article-next-page (&optional lines) |
5023 |
"Show the next page of the current article. |
"Show the next page of the current article. |
5024 |
If end of article, return non-nil. Otherwise return nil. |
If end of article, return non-nil. Otherwise return nil. |
5028 |
(if (save-excursion |
(if (save-excursion |
5029 |
(end-of-line) |
(end-of-line) |
5030 |
(and (pos-visible-in-window-p) ;Not continuation line. |
(and (pos-visible-in-window-p) ;Not continuation line. |
5031 |
(eobp))) |
(>= (1+ (point)) (point-max)))) ;Allow for trailing newline. |
5032 |
;; Nothing in this page. |
;; Nothing in this page. |
5033 |
(if (or (not gnus-page-broken) |
(if (or (not gnus-page-broken) |
5034 |
(save-excursion |
(save-excursion |
5035 |
(save-restriction |
(save-restriction |
5036 |
(widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? |
(widen) |
5037 |
t ;Nothing more. |
(forward-line) |
5038 |
|
(eobp)))) ;Real end-of-buffer? |
5039 |
|
(progn |
5040 |
|
(when gnus-article-over-scroll |
5041 |
|
(gnus-article-next-page-1 lines)) |
5042 |
|
t) ;Nothing more. |
5043 |
(gnus-narrow-to-page 1) ;Go to next page. |
(gnus-narrow-to-page 1) ;Go to next page. |
5044 |
nil) |
nil) |
5045 |
;; More in this page. |
;; More in this page. |
5046 |
(let ((scroll-in-place nil)) |
(gnus-article-next-page-1 lines) |
|
(condition-case () |
|
|
(scroll-up lines) |
|
|
(end-of-buffer |
|
|
;; Long lines may cause an end-of-buffer error. |
|
|
(goto-char (point-max))))) |
|
|
(move-to-window-line 0) |
|
5047 |
nil)) |
nil)) |
5048 |
|
|
5049 |
|
(defun gnus-article-next-page-1 (lines) |
5050 |
|
(let ((scroll-in-place nil)) |
5051 |
|
(condition-case () |
5052 |
|
(scroll-up lines) |
5053 |
|
(end-of-buffer |
5054 |
|
;; Long lines may cause an end-of-buffer error. |
5055 |
|
(goto-char (point-max))))) |
5056 |
|
(move-to-window-line 0)) |
5057 |
|
|
5058 |
(defun gnus-article-prev-page (&optional lines) |
(defun gnus-article-prev-page (&optional lines) |
5059 |
"Show previous page of current article. |
"Show previous page of current article. |
5060 |
Argument LINES specifies lines to be scrolled down." |
Argument LINES specifies lines to be scrolled down." |
5075 |
(goto-char (point-min)))) |
(goto-char (point-min)))) |
5076 |
(move-to-window-line 0))))) |
(move-to-window-line 0))))) |
5077 |
|
|
5078 |
|
(defun gnus-article-only-boring-p () |
5079 |
|
"Decide whether there is only boring text remaining in the article. |
5080 |
|
Something \"interesting\" is a word of at least two letters that does |
5081 |
|
not have a face in `gnus-article-boring-faces'." |
5082 |
|
(when (and gnus-article-skip-boring |
5083 |
|
(boundp 'gnus-article-boring-faces) |
5084 |
|
(symbol-value 'gnus-article-boring-faces)) |
5085 |
|
(save-excursion |
5086 |
|
(catch 'only-boring |
5087 |
|
(while (re-search-forward "\\b\\w\\w" nil t) |
5088 |
|
(forward-char -1) |
5089 |
|
(when (not (gnus-intersection |
5090 |
|
(gnus-faces-at (point)) |
5091 |
|
(symbol-value 'gnus-article-boring-faces))) |
5092 |
|
(throw 'only-boring nil))) |
5093 |
|
(throw 'only-boring t))))) |
5094 |
|
|
5095 |
(defun gnus-article-refer-article () |
(defun gnus-article-refer-article () |
5096 |
"Read article specified by message-id around point." |
"Read article specified by message-id around point." |
5097 |
(interactive) |
(interactive) |
5098 |
(let ((point (point))) |
(save-excursion |
5099 |
(search-forward ">" nil t) ;Move point to end of "<....>". |
(re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t) |
5100 |
(if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) |
(re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t) |
5101 |
(let ((message-id (match-string 1))) |
(if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t) |
5102 |
(goto-char point) |
(let ((msg-id (concat "<" (match-string 0) ">"))) |
5103 |
(set-buffer gnus-summary-buffer) |
(set-buffer gnus-summary-buffer) |
5104 |
(gnus-summary-refer-article message-id)) |
(gnus-summary-refer-article msg-id)) |
|
(goto-char (point)) |
|
5105 |
(error "No references around point")))) |
(error "No references around point")))) |
5106 |
|
|
5107 |
(defun gnus-article-show-summary () |
(defun gnus-article-show-summary () |
5150 |
(interactive "P") |
(interactive "P") |
5151 |
(gnus-article-check-buffer) |
(gnus-article-check-buffer) |
5152 |
(let ((nosaves |
(let ((nosaves |
5153 |
'("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" |
'("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f" |
5154 |
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" |
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" |
5155 |
"=" "^" "\M-^" "|")) |
"=" "^" "\M-^" "|")) |
5156 |
(nosave-but-article |
(nosave-but-article |
5157 |
'("A\r")) |
'("A\r")) |
5158 |
(nosave-in-article |
(nosave-in-article |
5159 |
'("\C-d")) |
'("\C-d")) |
5160 |
(up-to-top |
(up-to-top |
5161 |
'("n" "Gn" "p" "Gp")) |
'("n" "Gn" "p" "Gp")) |
5162 |
keys new-sum-point) |
keys new-sum-point) |
5163 |
(save-excursion |
(save-excursion |
5164 |
(set-buffer gnus-article-current-summary) |
(set-buffer gnus-article-current-summary) |
5165 |
(let (gnus-pick-mode) |
(let (gnus-pick-mode) |
5166 |
(push (or key last-command-event) unread-command-events) |
(push (or key last-command-event) unread-command-events) |
5167 |
(setq keys (if (featurep 'xemacs) |
(setq keys (if (featurep 'xemacs) |
5168 |
(events-to-keys (read-key-sequence nil)) |
(events-to-keys (read-key-sequence nil)) |
5169 |
(read-key-sequence nil))))) |
(read-key-sequence nil))))) |
5170 |
|
|
5171 |
(message "") |
(message "") |
5172 |
|
|
5173 |
(if (or (member keys nosaves) |
(if (or (member keys nosaves) |
5174 |
(member keys nosave-but-article) |
(member keys nosave-but-article) |
5175 |
(member keys nosave-in-article)) |
(member keys nosave-in-article)) |
5176 |
(let (func) |
(let (func) |
5177 |
(save-window-excursion |
(save-window-excursion |
5178 |
(pop-to-buffer gnus-article-current-summary 'norecord) |
(pop-to-buffer gnus-article-current-summary 'norecord) |
5179 |
;; We disable the pick minor mode commands. |
;; We disable the pick minor mode commands. |
5180 |
(let (gnus-pick-mode) |
(let (gnus-pick-mode) |
5181 |
(setq func (lookup-key (current-local-map) keys)))) |
(setq func (lookup-key (current-local-map) keys)))) |
5182 |
(if (or (not func) |
(if (or (not func) |
5183 |
(numberp func)) |
(numberp func)) |
5184 |
(ding) |
(ding) |
5185 |
(unless (member keys nosave-in-article) |
(unless (member keys nosave-in-article) |
5186 |
(set-buffer gnus-article-current-summary)) |
(set-buffer gnus-article-current-summary)) |
5187 |
(call-interactively func) |
(call-interactively func) |
5188 |
(setq new-sum-point (point))) |
(setq new-sum-point (point))) |
5189 |
(when (member keys nosave-but-article) |
(when (member keys nosave-but-article) |
5190 |
(pop-to-buffer gnus-article-buffer 'norecord))) |
(pop-to-buffer gnus-article-buffer 'norecord))) |
5191 |
;; These commands should restore window configuration. |
;; These commands should restore window configuration. |
5192 |
(let ((obuf (current-buffer)) |
(let ((obuf (current-buffer)) |
5193 |
(owin (current-window-configuration)) |
(owin (current-window-configuration)) |
5194 |
(opoint (point)) |
(opoint (point)) |
5195 |
(summary gnus-article-current-summary) |
win func in-buffer selected new-sum-start new-sum-hscroll) |
5196 |
func in-buffer selected) |
(cond (not-restore-window |
5197 |
(if not-restore-window |
(pop-to-buffer gnus-article-current-summary 'norecord)) |
5198 |
(pop-to-buffer summary 'norecord) |
((setq win (get-buffer-window gnus-article-current-summary)) |
5199 |
(switch-to-buffer summary 'norecord)) |
(select-window win)) |
5200 |
(setq in-buffer (current-buffer)) |
(t |
5201 |
;; We disable the pick minor mode commands. |
(switch-to-buffer gnus-article-current-summary 'norecord))) |
5202 |
(if (and (setq func (let (gnus-pick-mode) |
(setq in-buffer (current-buffer)) |
5203 |
|
;; We disable the pick minor mode commands. |
5204 |
|
(if (and (setq func (let (gnus-pick-mode) |
5205 |
(lookup-key (current-local-map) keys))) |
(lookup-key (current-local-map) keys))) |
5206 |
(functionp func)) |
(functionp func)) |
5207 |
(progn |
(progn |
5208 |
(call-interactively func) |
(call-interactively func) |
5209 |
(setq new-sum-point (point)) |
(when (eq win (selected-window)) |
5210 |
|
(setq new-sum-point (point) |
5211 |
|
new-sum-start (window-start win) |
5212 |
|
new-sum-hscroll (window-hscroll win)) |
5213 |
(when (eq in-buffer (current-buffer)) |
(when (eq in-buffer (current-buffer)) |
5214 |
(setq selected (gnus-summary-select-article)) |
(setq selected (gnus-summary-select-article)) |
5215 |
(set-buffer obuf) |
(set-buffer obuf) |
5221 |
1) |
1) |
5222 |
(set-window-point (get-buffer-window (current-buffer)) |
(set-window-point (get-buffer-window (current-buffer)) |
5223 |
(point))) |
(point))) |
5224 |
(let ((win (get-buffer-window gnus-article-current-summary))) |
(when (and (not not-restore-window) |
5225 |
(when win |
new-sum-point) |
5226 |
(set-window-point win new-sum-point)))) ) |
(set-window-point win new-sum-point) |
5227 |
(switch-to-buffer gnus-article-buffer) |
(set-window-start win new-sum-start) |
5228 |
(ding)))))) |
(set-window-hscroll win new-sum-hscroll))))) |
5229 |
|
(set-window-configuration owin) |
5230 |
|
(ding)))))) |
5231 |
|
|
5232 |
(defun gnus-article-describe-key (key) |
(defun gnus-article-describe-key (key) |
5233 |
"Display documentation of the function invoked by KEY. KEY is a string." |
"Display documentation of the function invoked by KEY. KEY is a string." |
5237 |
(save-excursion |
(save-excursion |
5238 |
(set-buffer gnus-article-current-summary) |
(set-buffer gnus-article-current-summary) |
5239 |
(let (gnus-pick-mode) |
(let (gnus-pick-mode) |
5240 |
(push (elt key 0) unread-command-events) |
(if (featurep 'xemacs) |
5241 |
(setq key (if (featurep 'xemacs) |
(progn |
5242 |
(events-to-keys (read-key-sequence "Describe key: ")) |
(push (elt key 0) unread-command-events) |
5243 |
(read-key-sequence "Describe key: ")))) |
(setq key (events-to-keys |
5244 |
|
(read-key-sequence "Describe key: ")))) |
5245 |
|
(setq unread-command-events |
5246 |
|
(mapcar |
5247 |
|
(lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) |
5248 |
|
(string-to-list key))) |
5249 |
|
(setq key (read-key-sequence "Describe key: ")))) |
5250 |
(describe-key key)) |
(describe-key key)) |
5251 |
(describe-key key))) |
(describe-key key))) |
5252 |
|
|
5258 |
(save-excursion |
(save-excursion |
5259 |
(set-buffer gnus-article-current-summary) |
(set-buffer gnus-article-current-summary) |
5260 |
(let (gnus-pick-mode) |
(let (gnus-pick-mode) |
5261 |
(push (elt key 0) unread-command-events) |
(if (featurep 'xemacs) |
5262 |
(setq key (if (featurep 'xemacs) |
(progn |
5263 |
(events-to-keys (read-key-sequence "Describe key: ")) |
(push (elt key 0) unread-command-events) |
5264 |
(read-key-sequence "Describe key: ")))) |
(setq key (events-to-keys |
5265 |
|
(read-key-sequence "Describe key: ")))) |
5266 |
|
(setq unread-command-events |
5267 |
|
(mapcar |
5268 |
|
(lambda (x) (if (>= x 128) (list 'meta (- x 128)) x)) |
5269 |
|
(string-to-list key))) |
5270 |
|
(setq key (read-key-sequence "Describe key: ")))) |
5271 |
(describe-key-briefly key insert)) |
(describe-key-briefly key insert)) |
5272 |
(describe-key-briefly key insert))) |
(describe-key-briefly key insert))) |
5273 |
|
|
5274 |
|
(defun gnus-article-reply-with-original (&optional wide) |
5275 |
|
"Start composing a reply mail to the current message. |
5276 |
|
The text in the region will be yanked. If the region isn't active, |
5277 |
|
the entire article will be yanked." |
5278 |
|
(interactive "P") |
5279 |
|
(let ((article (cdr gnus-article-current)) |
5280 |
|
contents) |
5281 |
|
(if (not (gnus-mark-active-p)) |
5282 |
|
(with-current-buffer gnus-summary-buffer |
5283 |
|
(gnus-summary-reply (list (list article)) wide)) |
5284 |
|
(setq contents (buffer-substring (point) (mark t))) |
5285 |
|
;; Deactivate active regions. |
5286 |
|
(when (and (boundp 'transient-mark-mode) |
5287 |
|
transient-mark-mode) |
5288 |
|
(setq mark-active nil)) |
5289 |
|
(with-current-buffer gnus-summary-buffer |
5290 |
|
(gnus-summary-reply |
5291 |
|
(list (list article contents)) wide))))) |
5292 |
|
|
5293 |
|
(defun gnus-article-followup-with-original () |
5294 |
|
"Compose a followup to the current article. |
5295 |
|
The text in the region will be yanked. If the region isn't active, |
5296 |
|
the entire article will be yanked." |
5297 |
|
(interactive) |
5298 |
|
(let ((article (cdr gnus-article-current)) |
5299 |
|
contents) |
5300 |
|
(if (not (gnus-mark-active-p)) |
5301 |
|
(with-current-buffer gnus-summary-buffer |
5302 |
|
(gnus-summary-followup (list (list article)))) |
5303 |
|
(setq contents (buffer-substring (point) (mark t))) |
5304 |
|
;; Deactivate active regions. |
5305 |
|
(when (and (boundp 'transient-mark-mode) |
5306 |
|
transient-mark-mode) |
5307 |
|
(setq mark-active nil)) |
5308 |
|
(with-current-buffer gnus-summary-buffer |
5309 |
|
(gnus-summary-followup |
5310 |
|
(list (list article contents))))))) |
5311 |
|
|
5312 |
(defun gnus-article-hide (&optional arg force) |
(defun gnus-article-hide (&optional arg force) |
5313 |
"Hide all the gruft in the current article. |
"Hide all the gruft in the current article. |
5314 |
This means that PGP stuff, signatures, cited text and (some) |
This means that signatures, cited text and (some) headers will be |
5315 |
headers will be hidden. |
hidden. |
5316 |
If given a prefix, show the hidden text instead." |
If given a prefix, show the hidden text instead." |
5317 |
(interactive (append (gnus-article-hidden-arg) (list 'force))) |
(interactive (append (gnus-article-hidden-arg) (list 'force))) |
5318 |
(gnus-article-hide-headers arg) |
(gnus-article-hide-headers arg) |
5319 |
(gnus-article-hide-list-identifiers arg) |
(gnus-article-hide-list-identifiers arg) |
|
(gnus-article-hide-pgp arg) |
|
5320 |
(gnus-article-hide-citation-maybe arg force) |
(gnus-article-hide-citation-maybe arg force) |
5321 |
(gnus-article-hide-signature arg)) |
(gnus-article-hide-signature arg)) |
5322 |
|
|
5332 |
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) |
(gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) |
5333 |
(gnus-request-group gnus-newsgroup-name t))) |
(gnus-request-group gnus-newsgroup-name t))) |
5334 |
|
|
5335 |
|
(eval-when-compile |
5336 |
|
(autoload 'nneething-get-file-name "nneething")) |
5337 |
|
|
5338 |
(defun gnus-request-article-this-buffer (article group) |
(defun gnus-request-article-this-buffer (article group) |
5339 |
"Get an article and insert it into this buffer." |
"Get an article and insert it into this buffer." |
5340 |
(let (do-update-line sparse-header) |
(let (do-update-line sparse-header) |
5384 |
gnus-newsgroup-name))) |
gnus-newsgroup-name))) |
5385 |
(when (and (eq (car method) 'nneething) |
(when (and (eq (car method) 'nneething) |
5386 |
(vectorp header)) |
(vectorp header)) |
5387 |
(let ((dir (expand-file-name |
(let ((dir (nneething-get-file-name |
5388 |
(mail-header-subject header) |
(mail-header-id header)))) |
5389 |
(file-name-as-directory |
(when (and (stringp dir) |
5390 |
(or (cadr (assq 'nneething-address method)) |
(file-directory-p dir)) |
|
(nth 1 method)))))) |
|
|
(when (file-directory-p dir) |
|
5391 |
(setq article 'nneething) |
(setq article 'nneething) |
5392 |
(gnus-group-enter-directory dir)))))))) |
(gnus-group-enter-directory dir)))))))) |
5393 |
|
|
5426 |
(numberp article) |
(numberp article) |
5427 |
(gnus-cache-request-article article group)) |
(gnus-cache-request-article article group)) |
5428 |
'article) |
'article) |
5429 |
|
;; Check the agent cache. |
5430 |
|
((gnus-agent-request-article article group) |
5431 |
|
'article) |
5432 |
;; Get the article and put into the article buffer. |
;; Get the article and put into the article buffer. |
5433 |
((or (stringp article) |
((or (stringp article) |
5434 |
(numberp article)) |
(numberp article)) |
5435 |
(let ((gnus-override-method gnus-override-method) |
(let ((gnus-override-method gnus-override-method) |
5436 |
(methods (and (stringp article) |
(methods (and (stringp article) |
5437 |
gnus-refer-article-method)) |
gnus-refer-article-method)) |
5438 |
|
(backend (car (gnus-find-method-for-group |
5439 |
|
gnus-newsgroup-name))) |
5440 |
result |
result |
5441 |
(inhibit-read-only t)) |
(inhibit-read-only t)) |
5442 |
(if (or (not (listp methods)) |
(if (or (not (listp methods)) |
5455 |
(gnus-kill-all-overlays) |
(gnus-kill-all-overlays) |
5456 |
(let ((gnus-newsgroup-name group)) |
(let ((gnus-newsgroup-name group)) |
5457 |
(gnus-check-group-server)) |
(gnus-check-group-server)) |
5458 |
(when (gnus-request-article article group (current-buffer)) |
(cond |
5459 |
|
((gnus-request-article article group (current-buffer)) |
5460 |
(when (numberp article) |
(when (numberp article) |
5461 |
(gnus-async-prefetch-next group article |
(gnus-async-prefetch-next group article |
5462 |
gnus-summary-buffer) |
gnus-summary-buffer) |
5464 |
(gnus-backlog-enter-article |
(gnus-backlog-enter-article |
5465 |
group article (current-buffer)))) |
group article (current-buffer)))) |
5466 |
(setq result 'article)) |
(setq result 'article)) |
5467 |
(if (not result) |
(methods |
5468 |
(if methods |
(setq gnus-override-method (pop methods))) |
5469 |
(setq gnus-override-method (pop methods)) |
((not (string-match "^400 " |
5470 |
(setq result 'done)))) |
(nnheader-get-report backend))) |
5471 |
|
;; If we get 400 server disconnect, reconnect and |
5472 |
|
;; retry; otherwise, assume the article has expired. |
5473 |
|
(setq result 'done)))) |
5474 |
(and (eq result 'article) 'article))) |
(and (eq result 'article) 'article))) |
5475 |
;; It was a pseudo. |
;; It was a pseudo. |
5476 |
(t article))) |
(t article))) |
5490 |
(buffer-disable-undo) |
(buffer-disable-undo) |
5491 |
(setq major-mode 'gnus-original-article-mode) |
(setq major-mode 'gnus-original-article-mode) |
5492 |
(setq buffer-read-only t)) |
(setq buffer-read-only t)) |
5493 |
(let (buffer-read-only) |
(let ((inhibit-read-only t)) |
5494 |
(erase-buffer) |
(erase-buffer) |
5495 |
(insert-buffer-substring gnus-article-buffer)) |
(insert-buffer-substring gnus-article-buffer)) |
5496 |
(setq gnus-original-article (cons group article))) |
(setq gnus-original-article (cons group article))) |
5508 |
(set-buffer gnus-summary-buffer) |
(set-buffer gnus-summary-buffer) |
5509 |
(gnus-summary-update-article do-update-line sparse-header) |
(gnus-summary-update-article do-update-line sparse-header) |
5510 |
(gnus-summary-goto-subject do-update-line nil t) |
(gnus-summary-goto-subject do-update-line nil t) |
5511 |
(set-window-point (get-buffer-window (current-buffer) t) |
(set-window-point (gnus-get-buffer-window (current-buffer) t) |
5512 |
(point)) |
(point)) |
5513 |
(set-buffer buf)))))) |
(set-buffer buf)))))) |
5514 |
|
|
5524 |
(defvar gnus-article-edit-done-function nil) |
(defvar gnus-article-edit-done-function nil) |
5525 |
|
|
5526 |
(defvar gnus-article-edit-mode-map nil) |
(defvar gnus-article-edit-mode-map nil) |
5527 |
|
(defvar gnus-article-edit-mode nil) |
5528 |
|
|
5529 |
;; Should we be using derived.el for this? |
;; Should we be using derived.el for this? |
5530 |
(unless gnus-article-edit-mode-map |
(unless gnus-article-edit-mode-map |
5531 |
(setq gnus-article-edit-mode-map (make-sparse-keymap)) |
(setq gnus-article-edit-mode-map (make-keymap)) |
5532 |
(set-keymap-parent gnus-article-edit-mode-map text-mode-map) |
(set-keymap-parent gnus-article-edit-mode-map text-mode-map) |
5533 |
|
|
5534 |
(gnus-define-keys gnus-article-edit-mode-map |
(gnus-define-keys gnus-article-edit-mode-map |
5535 |
|
"\C-c?" describe-mode |
5536 |
"\C-c\C-c" gnus-article-edit-done |
"\C-c\C-c" gnus-article-edit-done |
5537 |
"\C-c\C-k" gnus-article-edit-exit) |
"\C-c\C-k" gnus-article-edit-exit |
5538 |
|
"\C-c\C-f\C-t" message-goto-to |
5539 |
|
"\C-c\C-f\C-o" message-goto-from |
5540 |
|
"\C-c\C-f\C-b" message-goto-bcc |
5541 |
|
;;"\C-c\C-f\C-w" message-goto-fcc |
5542 |
|
"\C-c\C-f\C-c" message-goto-cc |
5543 |
|
"\C-c\C-f\C-s" message-goto-subject |
5544 |
|
"\C-c\C-f\C-r" message-goto-reply-to |
5545 |
|
"\C-c\C-f\C-n" message-goto-newsgroups |
5546 |
|
"\C-c\C-f\C-d" message-goto-distribution |
5547 |
|
"\C-c\C-f\C-f" message-goto-followup-to |
5548 |
|
"\C-c\C-f\C-m" message-goto-mail-followup-to |
5549 |
|
"\C-c\C-f\C-k" message-goto-keywords |
5550 |
|
"\C-c\C-f\C-u" message-goto-summary |
5551 |
|
"\C-c\C-f\C-i" message-insert-or-toggle-importance |
5552 |
|
"\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to |
5553 |
|
"\C-c\C-b" message-goto-body |
5554 |
|
"\C-c\C-i" message-goto-signature |
5555 |
|
|
5556 |
|
"\C-c\C-t" message-insert-to |
5557 |
|
"\C-c\C-n" message-insert-newsgroups |
5558 |
|
"\C-c\C-o" message-sort-headers |
5559 |
|
"\C-c\C-e" message-elide-region |
5560 |
|
"\C-c\C-v" message-delete-not-region |
5561 |
|
"\C-c\C-z" message-kill-to-signature |
5562 |
|
"\M-\r" message-newline-and-reformat |
5563 |
|
"\C-c\C-a" mml-attach-file |
5564 |
|
"\C-a" message-beginning-of-line |
5565 |
|
"\t" message-tab |
5566 |
|
"\M-;" comment-region) |
5567 |
|
|
5568 |
(gnus-define-keys (gnus-article-edit-wash-map |
(gnus-define-keys (gnus-article-edit-wash-map |
5569 |
"\C-c\C-w" gnus-article-edit-mode-map) |
"\C-c\C-w" gnus-article-edit-mode-map) |
5570 |
"f" gnus-article-edit-full-stops)) |
"f" gnus-article-edit-full-stops)) |
5571 |
|
|
5572 |
|
(easy-menu-define |
5573 |
|
gnus-article-edit-mode-field-menu gnus-article-edit-mode-map "" |
5574 |
|
'("Field" |
5575 |
|
["Fetch To" message-insert-to t] |
5576 |
|
["Fetch Newsgroups" message-insert-newsgroups t] |
5577 |
|
"----" |
5578 |
|
["To" message-goto-to t] |
5579 |
|
["From" message-goto-from t] |
5580 |
|
["Subject" message-goto-subject t] |
5581 |
|
["Cc" message-goto-cc t] |
5582 |
|
["Reply-To" message-goto-reply-to t] |
5583 |
|
["Summary" message-goto-summary t] |
5584 |
|
["Keywords" message-goto-keywords t] |
5585 |
|
["Newsgroups" message-goto-newsgroups t] |
5586 |
|
["Followup-To" message-goto-followup-to t] |
5587 |
|
["Mail-Followup-To" message-goto-mail-followup-to t] |
5588 |
|
["Distribution" message-goto-distribution t] |
5589 |
|
["Body" message-goto-body t] |
5590 |
|
["Signature" message-goto-signature t])) |
5591 |
|
|
5592 |
(define-derived-mode gnus-article-edit-mode message-mode "Article Edit" |
(define-derived-mode gnus-article-edit-mode message-mode "Article Edit" |
5593 |
"Major mode for editing articles. |
"Major mode for editing articles. |
5594 |
This is an extended text-mode. |
This is an extended text-mode. |
5598 |
(make-local-variable 'gnus-prev-winconf) |
(make-local-variable 'gnus-prev-winconf) |
5599 |
(set (make-local-variable 'font-lock-defaults) |
(set (make-local-variable 'font-lock-defaults) |
5600 |
'(message-font-lock-keywords t)) |
'(message-font-lock-keywords t)) |
5601 |
|
(set (make-local-variable 'mail-header-separator) "") |
5602 |
|
(set (make-local-variable 'gnus-article-edit-mode) t) |
5603 |
|
(easy-menu-add message-mode-field-menu message-mode-map) |
5604 |
|
(mml-mode) |
5605 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
5606 |
(buffer-enable-undo) |
(buffer-enable-undo) |
5607 |
(widen)) |
(widen)) |
5630 |
(set-buffer gnus-article-buffer) |
(set-buffer gnus-article-buffer) |
5631 |
(gnus-article-edit-mode) |
(gnus-article-edit-mode) |
5632 |
(funcall start-func) |
(funcall start-func) |
5633 |
|
(set-buffer-modified-p nil) |
5634 |
(gnus-configure-windows 'edit-article) |
(gnus-configure-windows 'edit-article) |
5635 |
(setq gnus-article-edit-done-function exit-func) |
(setq gnus-article-edit-done-function exit-func) |
5636 |
(setq gnus-prev-winconf winconf) |
(setq gnus-prev-winconf winconf) |
5639 |
(defun gnus-article-edit-done (&optional arg) |
(defun gnus-article-edit-done (&optional arg) |
5640 |
"Update the article edits and exit." |
"Update the article edits and exit." |
5641 |
(interactive "P") |
(interactive "P") |
|
(widen) |
|
|
(save-excursion |
|
|
(save-restriction |
|
|
(when (article-goto-body) |
|
|
(let ((lines (count-lines (point) (point-max))) |
|
|
(length (- (point-max) (point))) |
|
|
(case-fold-search t) |
|
|
(body (copy-marker (point)))) |
|
|
(goto-char (point-min)) |
|
|
(when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) |
|
|
(delete-region (match-beginning 1) (match-end 1)) |
|
|
(insert (number-to-string length))) |
|
|
(goto-char (point-min)) |
|
|
(when (re-search-forward |
|
|
"^x-content-length:[ \t]\\([0-9]+\\)" body t) |
|
|
(delete-region (match-beginning 1) (match-end 1)) |
|
|
(insert (number-to-string length))) |
|
|
(goto-char (point-min)) |
|
|
(when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) |
|
|
(delete-region (match-beginning 1) (match-end 1)) |
|
|
(insert (number-to-string lines))))))) |
|
5642 |
(let ((func gnus-article-edit-done-function) |
(let ((func gnus-article-edit-done-function) |
5643 |
(buf (current-buffer)) |
(buf (current-buffer)) |
5644 |
(start (window-start))) |
(start (window-start)) |
5645 |
(gnus-article-edit-exit) |
(p (point)) |
5646 |
|
(winconf gnus-prev-winconf)) |
5647 |
|
(widen) ;; Widen it in case that users narrowed the buffer. |
5648 |
|
(funcall func arg) |
5649 |
|
(set-buffer buf) |
5650 |
|
;; The cache and backlog have to be flushed somewhat. |
5651 |
|
(when gnus-keep-backlog |
5652 |
|
(gnus-backlog-remove-article |
5653 |
|
(car gnus-article-current) (cdr gnus-article-current))) |
5654 |
|
;; Flush original article as well. |
5655 |
(save-excursion |
(save-excursion |
5656 |
(set-buffer buf) |
(when (get-buffer gnus-original-article-buffer) |
5657 |
(let ((inhibit-read-only t)) |
(set-buffer gnus-original-article-buffer) |
5658 |
(funcall func arg)) |
(setq gnus-original-article nil))) |
5659 |
;; The cache and backlog have to be flushed somewhat. |
(when gnus-use-cache |
5660 |
(when gnus-keep-backlog |
(gnus-cache-update-article |
5661 |
(gnus-backlog-remove-article |
(car gnus-article-current) (cdr gnus-article-current))) |
5662 |
(car gnus-article-current) (cdr gnus-article-current))) |
;; We remove all text props from the article buffer. |
5663 |
;; Flush original article as well. |
(kill-all-local-variables) |
5664 |
(save-excursion |
(gnus-set-text-properties (point-min) (point-max) nil) |
5665 |
(when (get-buffer gnus-original-article-buffer) |
(gnus-article-mode) |
5666 |
(set-buffer gnus-original-article-buffer) |
(set-window-configuration winconf) |
|
(setq gnus-original-article nil))) |
|
|
(when gnus-use-cache |
|
|
(gnus-cache-update-article |
|
|
(car gnus-article-current) (cdr gnus-article-current)))) |
|
5667 |
(set-buffer buf) |
(set-buffer buf) |
5668 |
(set-window-start (get-buffer-window buf) start) |
(set-window-start (get-buffer-window buf) start) |
5669 |
(set-window-point (get-buffer-window buf) (point)))) |
(set-window-point (get-buffer-window buf) (point))) |
5670 |
|
(gnus-summary-show-article)) |
5671 |
|
|
5672 |
(defun gnus-article-edit-exit () |
(defun gnus-article-edit-exit () |
5673 |
"Exit the article editing without updating." |
"Exit the article editing without updating." |
5674 |
(interactive) |
(interactive) |
5675 |
;; We remove all text props from the article buffer. |
(when (or (not (buffer-modified-p)) |
5676 |
(let ((buf (buffer-substring-no-properties (point-min) (point-max))) |
(yes-or-no-p "Article modified; kill anyway? ")) |
5677 |
(curbuf (current-buffer)) |
(let ((curbuf (current-buffer)) |
5678 |
(p (point)) |
(p (point)) |
5679 |
(window-start (window-start))) |
(window-start (window-start))) |
5680 |
(erase-buffer) |
(erase-buffer) |
5681 |
(insert buf) |
(if (gnus-buffer-live-p gnus-original-article-buffer) |
5682 |
(let ((winconf gnus-prev-winconf)) |
(insert-buffer gnus-original-article-buffer)) |
5683 |
(gnus-article-mode) |
(let ((winconf gnus-prev-winconf)) |
5684 |
(set-window-configuration winconf) |
(kill-all-local-variables) |
5685 |
;; Tippy-toe some to make sure that point remains where it was. |
(gnus-article-mode) |
5686 |
(save-current-buffer |
(set-window-configuration winconf) |
5687 |
(set-buffer curbuf) |
;; Tippy-toe some to make sure that point remains where it was. |
5688 |
(set-window-start (get-buffer-window (current-buffer)) window-start) |
(save-current-buffer |
5689 |
(goto-char p))))) |
(set-buffer curbuf) |
5690 |
|
(set-window-start (get-buffer-window (current-buffer)) window-start) |
5691 |
|
(goto-char p)))) |
5692 |
|
(gnus-summary-show-article))) |
5693 |
|
|
5694 |
(defun gnus-article-edit-full-stops () |
(defun gnus-article-edit-full-stops () |
5695 |
"Interactively repair spacing at end of sentences." |
"Interactively repair spacing at end of sentences." |
5710 |
|
|
5711 |
(defcustom gnus-button-url-regexp |
(defcustom gnus-button-url-regexp |
5712 |
(if (string-match "[[:digit:]]" "1") ;; support POSIX? |
(if (string-match "[[:digit:]]" "1") ;; support POSIX? |
5713 |
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,[:word:]]+[-a-zA-Z0-9_=#$@~`%&*+|\\/[:word:]]\\)" |
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)" |
5714 |
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)\\)") |
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)") |
5715 |
"Regular expression that matches URLs." |
"Regular expression that matches URLs." |
5716 |
:group 'gnus-article-buttons |
:group 'gnus-article-buttons |
5717 |
:type 'regexp) |
:type 'regexp) |
5718 |
|
|
5719 |
|
(defcustom gnus-button-valid-fqdn-regexp |
5720 |
|
message-valid-fqdn-regexp |
5721 |
|
"Regular expression that matches a valid FQDN." |
5722 |
|
:group 'gnus-article-buttons |
5723 |
|
:type 'regexp) |
5724 |
|
|
5725 |
|
(defcustom gnus-button-man-handler 'manual-entry |
5726 |
|
"Function to use for displaying man pages. |
5727 |
|
The function must take at least one argument with a string naming the |
5728 |
|
man page." |
5729 |
|
:type '(choice (function-item :tag "Man" manual-entry) |
5730 |
|
(function-item :tag "Woman" woman) |
5731 |
|
(function :tag "Other")) |
5732 |
|
:group 'gnus-article-buttons) |
5733 |
|
|
5734 |
|
(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" |
5735 |
|
"Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. |
5736 |
|
If the default site is too slow, try to find a CTAN mirror, see |
5737 |
|
<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also |
5738 |
|
the variable `gnus-button-handle-ctan'." |
5739 |
|
:group 'gnus-article-buttons |
5740 |
|
:link '(custom-manual "(gnus)Group Parameters") |
5741 |
|
:type '(choice (const "http://www.tex.ac.uk/tex-archive/") |
5742 |
|
(const "http://tug.ctan.org/tex-archive/") |
5743 |
|
(const "http://www.dante.de/CTAN/") |
5744 |
|
(string :tag "Other"))) |
5745 |
|
|
5746 |
|
(defcustom gnus-button-ctan-handler 'browse-url |
5747 |
|
"Function to use for displaying CTAN links. |
5748 |
|
The function must take one argument, the string naming the URL." |
5749 |
|
:type '(choice (function-item :tag "Browse Url" browse-url) |
5750 |
|
(function :tag "Other")) |
5751 |
|
:group 'gnus-article-buttons) |
5752 |
|
|
5753 |
|
(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" |
5754 |
|
"Bogus strings removed from CTAN URLs." |
5755 |
|
:group 'gnus-article-buttons |
5756 |
|
:type '(choice (const "^/?tex-archive/\\|/") |
5757 |
|
(regexp :tag "Other"))) |
5758 |
|
|
5759 |
|
(defcustom gnus-button-ctan-directory-regexp |
5760 |
|
(concat |
5761 |
|
"\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20). |
5762 |
|
"biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|" |
5763 |
|
"indexing\\|info\\|language\\|macros\\|support\\|systems\\|" |
5764 |
|
"tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete" |
5765 |
|
"\\)") |
5766 |
|
"Regular expression for ctan directories. |
5767 |
|
It should match all directories in the top level of `gnus-ctan-url'." |
5768 |
|
:group 'gnus-article-buttons |
5769 |
|
:type 'regexp) |
5770 |
|
|
5771 |
|
(defcustom gnus-button-mid-or-mail-regexp |
5772 |
|
(concat "\\b\\(<?[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t ]*@" |
5773 |
|
;; Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de> |
5774 |
|
gnus-button-valid-fqdn-regexp |
5775 |
|
">?\\)\\b") |
5776 |
|
"Regular expression that matches a message ID or a mail address." |
5777 |
|
:group 'gnus-article-buttons |
5778 |
|
:type 'regexp) |
5779 |
|
|
5780 |
|
(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic |
5781 |
|
"What to do when the button on a string as \"foo123@bar.invalid\" is pushed. |
5782 |
|
Strings like this can be either a message ID or a mail address. If it is one |
5783 |
|
of the symbols `mid' or `mail', Gnus will always assume that the string is a |
5784 |
|
message ID or a mail address, respectively. If this variable is set to the |
5785 |
|
symbol `ask', always query the user what do do. If it is a function, this |
5786 |
|
function will be called with the string as it's only argument. The function |
5787 |
|
must return `mid', `mail', `invalid' or `ask'." |
5788 |
|
:group 'gnus-article-buttons |
5789 |
|
:type '(choice (function-item :tag "Heuristic function" |
5790 |
|
gnus-button-mid-or-mail-heuristic) |
5791 |
|
(const ask) |
5792 |
|
(const mid) |
5793 |
|
(const mail))) |
5794 |
|
|
5795 |
|
(defcustom gnus-button-mid-or-mail-heuristic-alist |
5796 |
|
'((-10.0 . ".+\\$.+@") |
5797 |
|
(-10.0 . "#") |
5798 |
|
(-10.0 . "\\*") |
5799 |
|
(-5.0 . "\\+[^+]*\\+.*@") ;; # two plus signs |
5800 |
|
(-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i |
5801 |
|
(-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i; |
5802 |
|
(-1.0 . "^[^a-z]+@") |
5803 |
|
;; |
5804 |
|
(-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@" |
5805 |
|
(-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@" |
5806 |
|
(-3.0 . "[A-Z][A-Z][a-z][a-z].*@") |
5807 |
|
(-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@") |
5808 |
|
;; |
5809 |
|
(-2.0 . "^[0-9]") |
5810 |
|
(-1.0 . "^[0-9][0-9]") |
5811 |
|
;; |
5812 |
|
;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/; |
5813 |
|
(-3.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") |
5814 |
|
;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/; |
5815 |
|
(-5.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]") |
5816 |
|
;; |
5817 |
|
(-3.0 . "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@" |
5818 |
|
(-3.0 . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@") |
5819 |
|
;; "[0-9]{8,}.*\@" |
5820 |
|
(-3.0 |
5821 |
|
. "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@") |
5822 |
|
;; "[0-9]{12,}.*\@" |
5823 |
|
;; compensation for TDMA dated mail addresses: |
5824 |
|
(25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@") |
5825 |
|
;; |
5826 |
|
(-20.0 . "\\.fsf@") ;; Gnus |
5827 |
|
(-20.0 . "^slrn") |
5828 |
|
(-20.0 . "^Pine") |
5829 |
|
(-20.0 . "_-_") ;; Subject change in thread |
5830 |
|
;; |
5831 |
|
(-20.0 . "\\.ln@") ;; leafnode |
5832 |
|
(-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de") |
5833 |
|
(-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent |
5834 |
|
;; |
5835 |
|
;; (5.0 . "") ;; $local_part_len <= 7 |
5836 |
|
(10.0 . "^[^0-9]+@") |
5837 |
|
(3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@") |
5838 |
|
;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part |
5839 |
|
(3.0 . "\@stud") |
5840 |
|
;; |
5841 |
|
(2.0 . "[a-z][a-z][._-][A-Z][a-z].*@") |
5842 |
|
;; |
5843 |
|
(0.5 . "^[A-Z][a-z]") |
5844 |
|
(0.5 . "^[A-Z][a-z][a-z]") |
5845 |
|
(1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3} |
5846 |
|
(2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4} |
5847 |
|
"An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'. |
5848 |
|
|
5849 |
|
A negative RATE indicates a message IDs, whereas a positive indicates a mail |
5850 |
|
address. The REGEXP is processed with `case-fold-search' set to nil." |
5851 |
|
:group 'gnus-article-buttons |
5852 |
|
:type '(repeat (cons (number :tag "Rate") |
5853 |
|
(regexp :tag "Regexp")))) |
5854 |
|
|
5855 |
|
(defun gnus-button-mid-or-mail-heuristic (mid-or-mail) |
5856 |
|
"Guess whether MID-OR-MAIL is a message ID or a mail address. |
5857 |
|
Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail |
5858 |
|
address, `ask' if unsure and `invalid' if the string is invalid." |
5859 |
|
(let ((case-fold-search nil) |
5860 |
|
(list gnus-button-mid-or-mail-heuristic-alist) |
5861 |
|
(result 0) rate regexp lpartlen elem) |
5862 |
|
(setq lpartlen |
5863 |
|
(length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1"))) |
5864 |
|
(gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen) |
5865 |
|
;; Certain special cases... |
5866 |
|
(when (string-match |
5867 |
|
(concat |
5868 |
|
"^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$\\|" |
5869 |
|
"^[0-9]+\\.[0-9]+@compuserve\\|" |
5870 |
|
"@public\\.gmane\\.org") |
5871 |
|
mid-or-mail) |
5872 |
|
(gnus-message 8 "`%s' is a known mail address." mid-or-mail) |
5873 |
|
(setq result 'mail)) |
5874 |
|
(when (string-match "@.*@\\| " mid-or-mail) |
5875 |
|
(gnus-message 8 "`%s' is invalid." mid-or-mail) |
5876 |
|
(setq result 'invalid)) |
5877 |
|
;; Nothing more to do, if result is not a number here... |
5878 |
|
(when (numberp result) |
5879 |
|
(while list |
5880 |
|
(setq elem (car list) |
5881 |
|
rate (car elem) |
5882 |
|
regexp (cdr elem) |
5883 |
|
list (cdr list)) |
5884 |
|
(when (string-match regexp mid-or-mail) |
5885 |
|
(setq result (+ result rate)) |
5886 |
|
(gnus-message |
5887 |
|
9 "`%s' matched `%s', rate `%s', result `%s'." |
5888 |
|
mid-or-mail regexp rate result))) |
5889 |
|
(when (<= lpartlen 7) |
5890 |
|
(setq result (+ result 5.0)) |
5891 |
|
(gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'." |
5892 |
|
mid-or-mail result)) |
5893 |
|
(when (>= lpartlen 12) |
5894 |
|
(gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail) |
5895 |
|
(cond |
5896 |
|
((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail) |
5897 |
|
;; Long local part should contain realname if e-mail address, |
5898 |
|
;; too many digits: message-id. |
5899 |
|
;; $score -= 5.0 + 0.1 * $local_part_len; |
5900 |
|
(setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen)))) |
5901 |
|
(setq result (+ result rate)) |
5902 |
|
(gnus-message |
5903 |
|
9 "Many digits in `%s', rate `%s', result `%s'." |
5904 |
|
mid-or-mail rate result)) |
5905 |
|
((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@" |
5906 |
|
mid-or-mail) |
5907 |
|
;; Too few vowels [^aeiouy]{4,}.*\@ |
5908 |
|
(setq result (+ result -5.0)) |
5909 |
|
(gnus-message |
5910 |
|
9 "Few vowels in `%s', rate `%s', result `%s'." |
5911 |
|
mid-or-mail -5.0 result)) |
5912 |
|
(t |
5913 |
|
(setq result (+ result 5.0)) |
5914 |
|
(gnus-message |
5915 |
|
9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result))))) |
5916 |
|
(gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result) |
5917 |
|
;; Maybe we should make this a customizable alist: (condition . 'result) |
5918 |
|
(cond |
5919 |
|
((symbolp result) result) |
5920 |
|
;; Now convert number into proper results: |
5921 |
|
((< result -10.0) 'mid) |
5922 |
|
((> result 10.0) 'mail) |
5923 |
|
(t 'ask)))) |
5924 |
|
|
5925 |
|
(defun gnus-button-handle-mid-or-mail (mid-or-mail) |
5926 |
|
(let* ((pref gnus-button-prefer-mid-or-mail) guessed |
5927 |
|
(url-mid (concat "news" ":" mid-or-mail)) |
5928 |
|
(url-mailto (concat "mailto" ":" mid-or-mail))) |
5929 |
|
(gnus-message 9 "mid-or-mail=%s" mid-or-mail) |
5930 |
|
(when (fboundp pref) |
5931 |
|
(setq guessed |
5932 |
|
;; get rid of surrounding angles... |
5933 |
|
(funcall pref |
5934 |
|
(gnus-replace-in-string mid-or-mail "^<\\|>$" ""))) |
5935 |
|
(if (or (eq 'mid guessed) (eq 'mail guessed)) |
5936 |
|
(setq pref guessed) |
5937 |
|
(setq pref 'ask))) |
5938 |
|
(if (eq pref 'ask) |
5939 |
|
(save-window-excursion |
5940 |
|
(if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? ")) |
5941 |
|
(setq pref 'mail) |
5942 |
|
(setq pref 'mid)))) |
5943 |
|
(cond ((eq pref 'mid) |
5944 |
|
(gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid) |
5945 |
|
(gnus-button-handle-news url-mid)) |
5946 |
|
((eq pref 'mail) |
5947 |
|
(gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto) |
5948 |
|
(gnus-url-mailto url-mailto)) |
5949 |
|
(t (gnus-message 3 "Invalid string."))))) |
5950 |
|
|
5951 |
|
(defun gnus-button-handle-custom (url) |
5952 |
|
"Follow a Custom URL." |
5953 |
|
(customize-apropos (gnus-url-unhex-string url))) |
5954 |
|
|
5955 |
|
(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)") |
5956 |
|
|
5957 |
|
;; FIXME: Maybe we should merge some of the functions that do quite similar |
5958 |
|
;; stuff? |
5959 |
|
|
5960 |
|
(defun gnus-button-handle-describe-function (url) |
5961 |
|
"Call `describe-function' when pushing the corresponding URL button." |
5962 |
|
(describe-function |
5963 |
|
(intern |
5964 |
|
(gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) |
5965 |
|
|
5966 |
|
(defun gnus-button-handle-describe-variable (url) |
5967 |
|
"Call `describe-variable' when pushing the corresponding URL button." |
5968 |
|
(describe-variable |
5969 |
|
(intern |
5970 |
|
(gnus-replace-in-string url gnus-button-handle-describe-prefix "")))) |
5971 |
|
|
5972 |
|
(defun gnus-button-handle-symbol (url) |
5973 |
|
"Display help on variable or function. |
5974 |
|
Calls `describe-variable' or `describe-function'." |
5975 |
|
(let ((sym (intern url))) |
5976 |
|
(cond |
5977 |
|
((fboundp sym) (describe-function sym)) |
5978 |
|
((boundp sym) (describe-variable sym)) |
5979 |
|
(t (gnus-message 3 "`%s' is not a known function of variable." url))))) |
5980 |
|
|
5981 |
|
(defun gnus-button-handle-describe-key (url) |
5982 |
|
"Call `describe-key' when pushing the corresponding URL button." |
5983 |
|
(let* ((key-string |
5984 |
|
(gnus-replace-in-string url gnus-button-handle-describe-prefix "")) |
5985 |
|
(keys (ignore-errors (eval `(kbd ,key-string))))) |
5986 |
|
(if keys |
5987 |
|
(describe-key keys) |
5988 |
|
(gnus-message 3 "Invalid key sequence in button: %s" key-string)))) |
5989 |
|
|
5990 |
|
(defun gnus-button-handle-apropos (url) |
5991 |
|
"Call `apropos' when pushing the corresponding URL button." |
5992 |
|
(apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) |
5993 |
|
|
5994 |
|
(defun gnus-button-handle-apropos-command (url) |
5995 |
|
"Call `apropos' when pushing the corresponding URL button." |
5996 |
|
(apropos-command |
5997 |
|
(gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) |
5998 |
|
|
5999 |
|
(defun gnus-button-handle-apropos-variable (url) |
6000 |
|
"Call `apropos' when pushing the corresponding URL button." |
6001 |
|
(funcall |
6002 |
|
(if (fboundp 'apropos-variable) 'apropos-variable 'apropos) |
6003 |
|
(gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) |
6004 |
|
|
6005 |
|
(defun gnus-button-handle-apropos-documentation (url) |
6006 |
|
"Call `apropos' when pushing the corresponding URL button." |
6007 |
|
(funcall |
6008 |
|
(if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos) |
6009 |
|
(gnus-replace-in-string url gnus-button-handle-describe-prefix ""))) |
6010 |
|
|
6011 |
|
(defun gnus-button-handle-library (url) |
6012 |
|
"Call `locate-library' when pushing the corresponding URL button." |
6013 |
|
(gnus-message 9 "url=`%s'" url) |
6014 |
|
(let* ((lib (locate-library url)) |
6015 |
|
(file (gnus-replace-in-string (or lib "") "\.elc" ".el"))) |
6016 |
|
(if (not lib) |
6017 |
|
(gnus-message 1 "Cannot locale library `%s'." url) |
6018 |
|
(find-file-read-only file)))) |
6019 |
|
|
6020 |
|
(defun gnus-button-handle-ctan (url) |
6021 |
|
"Call `browse-url' when pushing a CTAN URL button." |
6022 |
|
(funcall |
6023 |
|
gnus-button-ctan-handler |
6024 |
|
(concat |
6025 |
|
gnus-ctan-url |
6026 |
|
(gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp "")))) |
6027 |
|
|
6028 |
|
(defcustom gnus-button-tex-level 5 |
6029 |
|
"*Integer that says how many TeX-related buttons Gnus will show. |
6030 |
|
The higher the number, the more buttons will appear and the more false |
6031 |
|
positives are possible. Note that you can set this variable local to |
6032 |
|
specific groups. Setting it higher in TeX groups is probably a good idea. |
6033 |
|
See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on |
6034 |
|
how to set variables in specific groups." |
6035 |
|
:group 'gnus-article-buttons |
6036 |
|
:link '(custom-manual "(gnus)Group Parameters") |
6037 |
|
:type 'integer) |
6038 |
|
|
6039 |
|
(defcustom gnus-button-man-level 5 |
6040 |
|
"*Integer that says how many man-related buttons Gnus will show. |
6041 |
|
The higher the number, the more buttons will appear and the more false |
6042 |
|
positives are possible. Note that you can set this variable local to |
6043 |
|
specific groups. Setting it higher in Unix groups is probably a good idea. |
6044 |
|
See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on |
6045 |
|
how to set variables in specific groups." |
6046 |
|
:group 'gnus-article-buttons |
6047 |
|
:link '(custom-manual "(gnus)Group Parameters") |
6048 |
|
:type 'integer) |
6049 |
|
|
6050 |
|
(defcustom gnus-button-emacs-level 5 |
6051 |
|
"*Integer that says how many emacs-related buttons Gnus will show. |
6052 |
|
The higher the number, the more buttons will appear and the more false |
6053 |
|
positives are possible. Note that you can set this variable local to |
6054 |
|
specific groups. Setting it higher in Emacs or Gnus related groups is |
6055 |
|
probably a good idea. See Info node `(gnus)Group Parameters' and the variable |
6056 |
|
`gnus-parameters' on how to set variables in specific groups." |
6057 |
|
:group 'gnus-article-buttons |
6058 |
|
:link '(custom-manual "(gnus)Group Parameters") |
6059 |
|
:type 'integer) |
6060 |
|
|
6061 |
|
(defcustom gnus-button-message-level 5 |
6062 |
|
"*Integer that says how many buttons for news or mail messages will appear. |
6063 |
|
The higher the number, the more buttons will appear and the more false |
6064 |
|
positives are possible." |
6065 |
|
;; mail addresses, MIDs, URLs for news, ... |
6066 |
|
:group 'gnus-article-buttons |
6067 |
|
:type 'integer) |
6068 |
|
|
6069 |
|
(defcustom gnus-button-browse-level 5 |
6070 |
|
"*Integer that says how many buttons for browsing will appear. |
6071 |
|
The higher the number, the more buttons will appear and the more false |
6072 |
|
positives are possible." |
6073 |
|
;; stuff handled by `browse-url' or `gnus-button-embedded-url' |
6074 |
|
:group 'gnus-article-buttons |
6075 |
|
:type 'integer) |
6076 |
|
|
6077 |
(defcustom gnus-button-alist |
(defcustom gnus-button-alist |
6078 |
`(("<\\(url:[>\n\t ]*?\\)?news:[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" |
'(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>" |
6079 |
0 t gnus-button-message-id 2) |
0 (>= gnus-button-message-level 0) gnus-button-handle-news 3) |
6080 |
("\\bnews:\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t gnus-button-message-id 1) |
("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t |
6081 |
("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" |
gnus-button-handle-news 2) |
6082 |
1 t |
("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)" |
6083 |
gnus-button-fetch-group 4) |
1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5) |
6084 |
("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)" 0 t gnus-button-fetch-group 2) |
("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)" |
6085 |
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 |
0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3) |
6086 |
t gnus-button-message-id 3) |
;; RFC 2392 (Don't allow `/' in domain part --> CID) |
6087 |
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 2) |
("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)" |
6088 |
("mailto:\\([-a-zA-Z.@_+0-9%]+\\)" 0 t gnus-url-mailto 1) |
0 (>= gnus-button-message-level 0) gnus-button-message-id 2) |
6089 |
("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 1) |
("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" |
6090 |
;; This is how URLs _should_ be embedded in text... |
2 (>= gnus-button-message-level 0) gnus-button-message-id 3) |
6091 |
("<URL: *\\([^<>]*\\)>" 0 t gnus-button-embedded-url 1) |
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" |
6092 |
;; Info manual references. |
0 (>= gnus-button-message-level 0) gnus-url-mailto 2) |
6093 |
("(\\(info\\|Info-goto-node\\)[ \n\t]+\"\\(([^)\"\n]+)[^\"\n]+\\)\")" |
;; RFC 2368 (The mailto URL scheme) |
6094 |
0 t Info-goto-node 2) |
("mailto:\\([-a-z.@_+0-9%=?&]+\\)" |
6095 |
|
0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
6096 |
|
("\\bmailto:\\([^ \n\t]+\\)" |
6097 |
|
0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
6098 |
|
;; CTAN |
6099 |
|
((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" |
6100 |
|
gnus-button-ctan-directory-regexp |
6101 |
|
"[^][>)!;:,'\n\t ]+\\)") |
6102 |
|
0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) |
6103 |
|
((concat "\\btex-archive/\\(" |
6104 |
|
gnus-button-ctan-directory-regexp |
6105 |
|
"/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") |
6106 |
|
1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) |
6107 |
|
((concat |
6108 |
|
"\\b\\(" |
6109 |
|
gnus-button-ctan-directory-regexp |
6110 |
|
"/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") |
6111 |
|
1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) |
6112 |
|
;; This is info (home-grown style) <info://foo/bar+baz> |
6113 |
|
("\\binfo://\\([^'\">\n\t ]+\\)" |
6114 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1) |
6115 |
|
;; Info GNOME style <info:foo#bar_baz> |
6116 |
|
("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)" |
6117 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1) |
6118 |
|
;; Info KDE style <info:(foo)bar baz> |
6119 |
|
("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>" |
6120 |
|
1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2) |
6121 |
|
("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0 |
6122 |
|
(>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2) |
6123 |
|
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET" |
6124 |
|
;; Info links like `C-h i d m CC Mode RET' |
6125 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2) |
6126 |
|
;; This is custom |
6127 |
|
("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)" |
6128 |
|
0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2) |
6129 |
|
("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0 |
6130 |
|
(>= gnus-button-emacs-level 1) gnus-button-handle-custom 1) |
6131 |
|
;; Emacs help commands |
6132 |
|
("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6133 |
|
;; regexp doesn't match arguments containing ` '. |
6134 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1) |
6135 |
|
("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6136 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1) |
6137 |
|
("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6138 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1) |
6139 |
|
("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6140 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1) |
6141 |
|
;; The following entries may lead to many false positives so don't enable |
6142 |
|
;; them by default (use a high button level): |
6143 |
|
("/\\([a-z][-a-z0-9]+\\.el\\)\\>" |
6144 |
|
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) |
6145 |
|
("`\\([a-z][-a-z0-9]+\\.el\\)'" |
6146 |
|
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1) |
6147 |
|
("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'" |
6148 |
|
0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1) |
6149 |
|
("`\\([a-z][a-z0-9]+-[a-z]+\\)'" |
6150 |
|
0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1) |
6151 |
|
("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)" |
6152 |
|
1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1) |
6153 |
|
("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6154 |
|
1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1) |
6155 |
|
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6156 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2) |
6157 |
|
("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET" |
6158 |
|
0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2) |
6159 |
|
("`\\(\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'" |
6160 |
|
;; Unlike the other regexps we really have to require quoting |
6161 |
|
;; here to determine where it ends. |
6162 |
|
1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3) |
6163 |
|
;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)... |
6164 |
|
("<URL: *\\([^<>]*\\)>" |
6165 |
|
1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) |
6166 |
|
;; RFC 2396 (2.4.3., delims) ... |
6167 |
|
("\"URL: *\\([^\"]*\\)\"" |
6168 |
|
1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) |
6169 |
|
;; RFC 2396 (2.4.3., delims) ... |
6170 |
|
("\"URL: *\\([^\"]*\\)\"" |
6171 |
|
1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1) |
6172 |
;; Raw URLs. |
;; Raw URLs. |
6173 |
(,gnus-button-url-regexp 0 t browse-url 0)) |
(gnus-button-url-regexp |
6174 |
|
0 (>= gnus-button-browse-level 0) browse-url 0) |
6175 |
|
;; man pages |
6176 |
|
("\\b\\([a-z][a-z]+\\)([1-9])\\W" |
6177 |
|
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3)) |
6178 |
|
gnus-button-handle-man 1) |
6179 |
|
;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x) |
6180 |
|
("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W" |
6181 |
|
0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5)) |
6182 |
|
gnus-button-handle-man 1) |
6183 |
|
;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm), |
6184 |
|
;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7) |
6185 |
|
("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W" |
6186 |
|
0 (>= gnus-button-man-level 5) gnus-button-handle-man 1) |
6187 |
|
;; MID or mail: To avoid too many false positives we don't try to catch |
6188 |
|
;; all kind of allowed MIDs or mail addresses. Domain part must contain |
6189 |
|
;; at least one dot. TLD must contain two or three chars or be a know TLD |
6190 |
|
;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist' |
6191 |
|
;; so that non-ambiguous entries (see above) match first. |
6192 |
|
(gnus-button-mid-or-mail-regexp |
6193 |
|
0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1)) |
6194 |
"*Alist of regexps matching buttons in article bodies. |
"*Alist of regexps matching buttons in article bodies. |
6195 |
|
|
6196 |
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where |
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where |
6197 |
REGEXP: is the string matching text around the button, |
REGEXP: is the string (case insensitive) matching text around the button (can |
6198 |
|
also be Lisp expression evaluating to a string), |
6199 |
BUTTON: is the number of the regexp grouping actually matching the button, |
BUTTON: is the number of the regexp grouping actually matching the button, |
6200 |
FORM: is a Lisp expression which must eval to true for the button to |
FORM: is a Lisp expression which must eval to true for the button to |
6201 |
be added, |
be added, |
6205 |
CALLBACK can also be a variable, in that case the value of that |
CALLBACK can also be a variable, in that case the value of that |
6206 |
variable it the real callback function." |
variable it the real callback function." |
6207 |
:group 'gnus-article-buttons |
:group 'gnus-article-buttons |
6208 |
:type '(repeat (list regexp |
:type '(repeat (list (choice regexp variable sexp) |
6209 |
(integer :tag "Button") |
(integer :tag "Button") |
6210 |
(sexp :tag "Form") |
(sexp :tag "Form") |
6211 |
(function :tag "Callback") |
(function :tag "Callback") |
6214 |
(integer :tag "Regexp group"))))) |
(integer :tag "Regexp group"))))) |
6215 |
|
|
6216 |
(defcustom gnus-header-button-alist |
(defcustom gnus-header-button-alist |
6217 |
`(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" |
'(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>" |
6218 |
0 t gnus-button-message-id 0) |
0 (>= gnus-button-message-level 0) gnus-button-message-id 0) |
6219 |
("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) |
("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" |
6220 |
|
1 (>= gnus-button-message-level 0) gnus-button-reply 1) |
6221 |
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" |
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" |
6222 |
0 t gnus-button-mailto 0) |
0 (>= gnus-button-message-level 0) gnus-button-mailto 0) |
6223 |
("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url 0) |
("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp |
6224 |
("^Subject:" ,gnus-button-url-regexp 0 t browse-url 0) |
0 (>= gnus-button-browse-level 0) browse-url 0) |
6225 |
("^[^:]+:" ,gnus-button-url-regexp 0 t browse-url 0) |
("^Subject:" gnus-button-url-regexp |
6226 |
("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t |
0 (>= gnus-button-browse-level 0) browse-url 0) |
6227 |
gnus-button-message-id 3)) |
("^[^:]+:" gnus-button-url-regexp |
6228 |
|
0 (>= gnus-button-browse-level 0) browse-url 0) |
6229 |
|
("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)" |
6230 |
|
0 (>= gnus-button-message-level 0) gnus-url-mailto 1) |
6231 |
|
("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)" |
6232 |
|
1 (>= gnus-button-message-level 0) gnus-button-message-id 4)) |
6233 |
"*Alist of headers and regexps to match buttons in article heads. |
"*Alist of headers and regexps to match buttons in article heads. |
6234 |
|
|
6235 |
This alist is very similar to `gnus-button-alist', except that each |
This alist is very similar to `gnus-button-alist', except that each |
6242 |
:group 'gnus-article-buttons |
:group 'gnus-article-buttons |
6243 |
:group 'gnus-article-headers |
:group 'gnus-article-headers |
6244 |
:type '(repeat (list (regexp :tag "Header") |
:type '(repeat (list (regexp :tag "Header") |
6245 |
regexp |
(choice regexp variable) |
6246 |
(integer :tag "Button") |
(integer :tag "Button") |
6247 |
(sexp :tag "Form") |
(sexp :tag "Form") |
6248 |
(function :tag "Callback") |
(function :tag "Callback") |
6266 |
(interactive "e") |
(interactive "e") |
6267 |
(set-buffer (window-buffer (posn-window (event-start event)))) |
(set-buffer (window-buffer (posn-window (event-start event)))) |
6268 |
(let* ((pos (posn-point (event-start event))) |
(let* ((pos (posn-point (event-start event))) |
6269 |
(data (get-text-property pos 'gnus-data)) |
(data (get-text-property pos 'gnus-data)) |
6270 |
(fun (get-text-property pos 'gnus-callback))) |
(fun (get-text-property pos 'gnus-callback))) |
6271 |
(goto-char pos) |
(goto-char pos) |
6272 |
(when fun |
(when fun |
6277 |
If the text at point has a `gnus-callback' property, |
If the text at point has a `gnus-callback' property, |
6278 |
call it with the value of the `gnus-data' text property." |
call it with the value of the `gnus-data' text property." |
6279 |
(interactive) |
(interactive) |
6280 |
(let* ((data (get-text-property (point) 'gnus-data)) |
(let ((data (get-text-property (point) 'gnus-data)) |
6281 |
(fun (get-text-property (point) 'gnus-callback))) |
(fun (get-text-property (point) 'gnus-callback))) |
6282 |
(when fun |
(when fun |
6283 |
(funcall fun data)))) |
(funcall fun data)))) |
6284 |
|
|
6397 |
(article-goto-body) |
(article-goto-body) |
6398 |
(setq beg (point)) |
(setq beg (point)) |
6399 |
(while (setq entry (pop alist)) |
(while (setq entry (pop alist)) |
6400 |
(setq regexp (car entry)) |
(setq regexp (eval (car entry))) |
6401 |
(goto-char beg) |
(goto-char beg) |
6402 |
(while (re-search-forward regexp nil t) |
(while (re-search-forward regexp nil t) |
6403 |
(let* ((start (and entry (match-beginning (nth 1 entry)))) |
(let* ((start (and entry (match-beginning (nth 1 entry)))) |
6439 |
(match-beginning 0)) |
(match-beginning 0)) |
6440 |
(point-max))) |
(point-max))) |
6441 |
(goto-char beg) |
(goto-char beg) |
6442 |
(while (re-search-forward (nth 1 entry) end t) |
(while (re-search-forward (eval (nth 1 entry)) end t) |
6443 |
;; Each match within a header. |
;; Each match within a header. |
6444 |
(let* ((entry (cdr entry)) |
(let* ((entry (cdr entry)) |
6445 |
(start (match-beginning (nth 1 entry))) |
(start (match-beginning (nth 1 entry))) |
6482 |
(let ((inhibit-read-only t) |
(let ((inhibit-read-only t) |
6483 |
(inhibit-point-motion-hooks t)) |
(inhibit-point-motion-hooks t)) |
6484 |
(if (text-property-any end (point-max) 'article-type 'signature) |
(if (text-property-any end (point-max) 'article-type 'signature) |
6485 |
(gnus-remove-text-properties-when |
(progn |
6486 |
'article-type 'signature end (point-max) |
(gnus-delete-wash-type 'signature) |
6487 |
(cons 'article-type (cons 'signature |
(gnus-remove-text-properties-when |
6488 |
gnus-hidden-properties))) |
'article-type 'signature end (point-max) |
6489 |
|
(cons 'article-type (cons 'signature |
6490 |
|
gnus-hidden-properties)))) |
6491 |
|
(gnus-add-wash-type 'signature) |
6492 |
(gnus-add-text-properties-when |
(gnus-add-text-properties-when |
6493 |
'article-type nil end (point-max) |
'article-type nil end (point-max) |
6494 |
(cons 'article-type (cons 'signature |
(cons 'article-type (cons 'signature |
6495 |
gnus-hidden-properties))))))) |
gnus-hidden-properties))))) |
6496 |
|
(let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) |
6497 |
|
(gnus-set-mode-line 'article)))) |
6498 |
|
|
6499 |
(defun gnus-button-entry () |
(defun gnus-button-entry () |
6500 |
;; Return the first entry in `gnus-button-alist' matching this place. |
;; Return the first entry in `gnus-button-alist' matching this place. |
6502 |
(entry nil)) |
(entry nil)) |
6503 |
(while alist |
(while alist |
6504 |
(setq entry (pop alist)) |
(setq entry (pop alist)) |
6505 |
(if (looking-at (car entry)) |
(if (looking-at (eval (car entry))) |
6506 |
(setq alist nil) |
(setq alist nil) |
6507 |
(setq entry nil))) |
(setq entry nil))) |
6508 |
entry)) |
entry)) |
6530 |
(gnus-message 1 "You must define `%S' to use this button" |
(gnus-message 1 "You must define `%S' to use this button" |
6531 |
(cons fun args))))))) |
(cons fun args))))))) |
6532 |
|
|
6533 |
|
(defun gnus-parse-news-url (url) |
6534 |
|
(let (scheme server group message-id articles) |
6535 |
|
(with-temp-buffer |
6536 |
|
(insert url) |
6537 |
|
(goto-char (point-min)) |
6538 |
|
(when (looking-at "\\([A-Za-z]+\\):") |
6539 |
|
(setq scheme (match-string 1)) |
6540 |
|
(goto-char (match-end 0))) |
6541 |
|
(when (looking-at "//\\([^/]+\\)/") |
6542 |
|
(setq server (match-string 1)) |
6543 |
|
(goto-char (match-end 0))) |
6544 |
|
|
6545 |
|
(cond |
6546 |
|
((looking-at "\\(.*@.*\\)") |
6547 |
|
(setq message-id (match-string 1))) |
6548 |
|
((looking-at "\\([^/]+\\)/\\([-0-9]+\\)") |
6549 |
|
(setq group (match-string 1) |
6550 |
|
articles (split-string (match-string 2) "-"))) |
6551 |
|
((looking-at "\\([^/]+\\)/?") |
6552 |
|
(setq group (match-string 1))) |
6553 |
|
(t |
6554 |
|
(error "Unknown news URL syntax")))) |
6555 |
|
(list scheme server group message-id articles))) |
6556 |
|
|
6557 |
|
(defun gnus-button-handle-news (url) |
6558 |
|
"Fetch a news URL." |
6559 |
|
(destructuring-bind (scheme server group message-id articles) |
6560 |
|
(gnus-parse-news-url url) |
6561 |
|
(cond |
6562 |
|
(message-id |
6563 |
|
(save-excursion |
6564 |
|
(set-buffer gnus-summary-buffer) |
6565 |
|
(if server |
6566 |
|
(let ((gnus-refer-article-method (list (list 'nntp server)))) |
6567 |
|
(gnus-summary-refer-article message-id)) |
6568 |
|
(gnus-summary-refer-article message-id)))) |
6569 |
|
(group |
6570 |
|
(gnus-button-fetch-group url))))) |
6571 |
|
|
6572 |
|
(defun gnus-button-handle-man (url) |
6573 |
|
"Fetch a man page." |
6574 |
|
(funcall gnus-button-man-handler url)) |
6575 |
|
|
6576 |
|
(defun gnus-button-handle-info-url (url) |
6577 |
|
"Fetch an info URL." |
6578 |
|
(setq url (mm-subst-char-in-string ?+ ?\ url)) |
6579 |
|
(cond |
6580 |
|
((string-match "^\\([^:/]+\\)?/\\(.*\\)" url) |
6581 |
|
(gnus-info-find-node |
6582 |
|
(concat "(" (or (gnus-url-unhex-string (match-string 1 url)) |
6583 |
|
"Gnus") |
6584 |
|
")" (gnus-url-unhex-string (match-string 2 url))))) |
6585 |
|
((string-match "([^)\"]+)[^\"]+" url) |
6586 |
|
(setq url |
6587 |
|
(gnus-replace-in-string |
6588 |
|
(gnus-replace-in-string url "[\n\t ]+" " ") "\"" "")) |
6589 |
|
(gnus-info-find-node url)) |
6590 |
|
(t (error "Can't parse %s" url)))) |
6591 |
|
|
6592 |
|
(defun gnus-button-handle-info-url-gnome (url) |
6593 |
|
"Fetch GNOME style info URL." |
6594 |
|
(setq url (mm-subst-char-in-string ?_ ?\ url)) |
6595 |
|
(if (string-match "\\([^#]+\\)#?\\(.*\\)" url) |
6596 |
|
(gnus-info-find-node |
6597 |
|
(concat "(" |
6598 |
|
(gnus-url-unhex-string |
6599 |
|
(match-string 1 url)) |
6600 |
|
")" |
6601 |
|
(or (gnus-url-unhex-string |
6602 |
|
(match-string 2 url)) |
6603 |
|
"Top"))) |
6604 |
|
(error "Can't parse %s" url))) |
6605 |
|
|
6606 |
|
(defun gnus-button-handle-info-url-kde (url) |
6607 |
|
"Fetch KDE style info URL." |
6608 |
|
(gnus-info-find-node (gnus-url-unhex-string url))) |
6609 |
|
|
6610 |
|
(defun gnus-button-handle-info-keystrokes (url) |
6611 |
|
"Call `info' when pushing the corresponding URL button." |
6612 |
|
;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'. |
6613 |
|
(info) |
6614 |
|
(Info-directory) |
6615 |
|
(Info-menu url)) |
6616 |
|
|
6617 |
(defun gnus-button-message-id (message-id) |
(defun gnus-button-message-id (message-id) |
6618 |
"Fetch MESSAGE-ID." |
"Fetch MESSAGE-ID." |
6619 |
(save-excursion |
(save-excursion |
6625 |
(if (not (string-match "[:/]" address)) |
(if (not (string-match "[:/]" address)) |
6626 |
;; This is just a simple group url. |
;; This is just a simple group url. |
6627 |
(gnus-group-read-ephemeral-group address gnus-select-method) |
(gnus-group-read-ephemeral-group address gnus-select-method) |
6628 |
(if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$" |
(if (not |
6629 |
address)) |
(string-match |
6630 |
|
"^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?" |
6631 |
|
address)) |
6632 |
(error "Can't parse %s" address) |
(error "Can't parse %s" address) |
6633 |
(gnus-group-read-ephemeral-group |
(gnus-group-read-ephemeral-group |
6634 |
(match-string 4 address) |
(match-string 4 address) |
6636 |
(nntp-address ,(match-string 1 address)) |
(nntp-address ,(match-string 1 address)) |
6637 |
(nntp-port-number ,(if (match-end 3) |
(nntp-port-number ,(if (match-end 3) |
6638 |
(match-string 3 address) |
(match-string 3 address) |
6639 |
"nntp"))))))) |
"nntp"))) |
6640 |
|
nil nil nil |
6641 |
|
(and (match-end 6) (list (string-to-int (match-string 6 address)))))))) |
6642 |
|
|
6643 |
(defun gnus-url-parse-query-string (query &optional downcase) |
(defun gnus-url-parse-query-string (query &optional downcase) |
6644 |
(let (retval pairs cur key val) |
(let (retval pairs cur key val) |
6645 |
(setq pairs (split-string query "&")) |
(setq pairs (split-string query "&")) |
6646 |
(while pairs |
(while pairs |
6647 |
(setq cur (car pairs) |
(setq cur (car pairs) |
6648 |
pairs (cdr pairs)) |
pairs (cdr pairs)) |
6649 |
(if (not (string-match "=" cur)) |
(if (not (string-match "=" cur)) |
6650 |
nil ; Grace |
nil ; Grace |
6651 |
(setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) |
(setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) |
6652 |
val (gnus-url-unhex-string (substring cur (match-end 0) nil))) |
val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) |
6653 |
(if downcase |
(if downcase |
6654 |
(setq key (downcase key))) |
(setq key (downcase key))) |
6655 |
(setq cur (assoc key retval)) |
(setq cur (assoc key retval)) |
6656 |
(if cur |
(if cur |
6657 |
(setcdr cur (cons val (cdr cur))) |
(setcdr cur (cons val (cdr cur))) |
6658 |
(setq retval (cons (list key val) retval))))) |
(setq retval (cons (list key val) retval))))) |
6659 |
retval)) |
retval)) |
6660 |
|
|
|
(defun gnus-url-unhex (x) |
|
|
(if (> x ?9) |
|
|
(if (>= x ?a) |
|
|
(+ 10 (- x ?a)) |
|
|
(+ 10 (- x ?A))) |
|
|
(- x ?0))) |
|
|
|
|
|
(defun gnus-url-unhex-string (str &optional allow-newlines) |
|
|
"Remove %XXX embedded spaces, etc in a url. |
|
|
If optional second argument ALLOW-NEWLINES is non-nil, then allow the |
|
|
decoding of carriage returns and line feeds in the string, which is normally |
|
|
forbidden in URL encoding." |
|
|
(setq str (or str "")) |
|
|
(let ((tmp "") |
|
|
(case-fold-search t)) |
|
|
(while (string-match "%[0-9a-f][0-9a-f]" str) |
|
|
(let* ((start (match-beginning 0)) |
|
|
(ch1 (gnus-url-unhex (elt str (+ start 1)))) |
|
|
(code (+ (* 16 ch1) |
|
|
(gnus-url-unhex (elt str (+ start 2)))))) |
|
|
(setq tmp (concat |
|
|
tmp (substring str 0 start) |
|
|
(cond |
|
|
(allow-newlines |
|
|
(char-to-string code)) |
|
|
((or (= code ?\n) (= code ?\r)) |
|
|
" ") |
|
|
(t (char-to-string code)))) |
|
|
str (substring str (match-end 0))))) |
|
|
(setq tmp (concat tmp str)) |
|
|
tmp)) |
|
|
|
|
6661 |
(defun gnus-url-mailto (url) |
(defun gnus-url-mailto (url) |
6662 |
;; Send mail to someone |
;; Send mail to someone |
6663 |
(when (string-match "mailto:/*\\(.*\\)" url) |
(when (string-match "mailto:/*\\(.*\\)" url) |
6664 |
(setq url (substring url (match-beginning 1) nil))) |
(setq url (substring url (match-beginning 1) nil))) |
6665 |
(let (to args subject func) |
(let (to args subject func) |
6666 |
(if (string-match (regexp-quote "?") url) |
(setq args (gnus-url-parse-query-string |
6667 |
(setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) |
(if (string-match "^\\?" url) |
6668 |
args (gnus-url-parse-query-string |
(substring url 1) |
6669 |
(substring url (match-end 0) nil) t)) |
(if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) |
6670 |
(setq to (gnus-url-unhex-string url))) |
(concat "to=" (match-string 1 url) "&" |
6671 |
(setq args (cons (list "to" to) args) |
(match-string 2 url)) |
6672 |
subject (cdr-safe (assoc "subject" args))) |
(concat "to=" url))) |
6673 |
(message-mail) |
t) |
6674 |
|
subject (cdr-safe (assoc "subject" args))) |
6675 |
|
(gnus-msg-mail) |
6676 |
(while args |
(while args |
6677 |
(setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) |
(setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) |
6678 |
(if (fboundp func) |
(if (fboundp func) |
6679 |
(funcall func) |
(funcall func) |
6680 |
(message-position-on-field (caar args))) |
(message-position-on-field (caar args))) |
6681 |
(insert (mapconcat 'identity (cdar args) ", ")) |
(insert (gnus-replace-in-string |
6682 |
|
(mapconcat 'identity (reverse (cdar args)) ", ") |
6683 |
|
"\r\n" "\n" t)) |
6684 |
(setq args (cdr args))) |
(setq args (cdr args))) |
6685 |
(if subject |
(if subject |
6686 |
(message-goto-body) |
(message-goto-body) |
6687 |
(message-goto-subject)))) |
(message-goto-subject)))) |
6688 |
|
|
|
(defun gnus-button-mailto (address) |
|
|
"Mail to ADDRESS." |
|
|
(set-buffer (gnus-copy-article-buffer)) |
|
|
(message-reply address)) |
|
|
|
|
|
(defalias 'gnus-button-reply 'message-reply) |
|
|
|
|
6689 |
(defun gnus-button-embedded-url (address) |
(defun gnus-button-embedded-url (address) |
6690 |
"Activate ADDRESS with `browse-url'." |
"Activate ADDRESS with `browse-url'." |
6691 |
(browse-url (gnus-strip-whitespace address))) |
(browse-url (gnus-strip-whitespace address))) |
6695 |
(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") |
(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") |
6696 |
(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") |
(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") |
6697 |
|
|
6698 |
(defvar gnus-prev-page-map nil) |
(defvar gnus-prev-page-map |
6699 |
(unless gnus-prev-page-map |
(let ((map (make-sparse-keymap))) |
6700 |
(setq gnus-prev-page-map (make-sparse-keymap)) |
(unless (>= emacs-major-version 21) |
6701 |
(define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) |
;; XEmacs doesn't care. |
6702 |
(define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) |
(set-keymap-parent map gnus-article-mode-map)) |
6703 |
|
(define-key map gnus-mouse-2 'gnus-button-prev-page) |
6704 |
|
(define-key map "\r" 'gnus-button-prev-page) |
6705 |
|
map)) |
6706 |
|
|
6707 |
|
(defvar gnus-next-page-map |
6708 |
|
(let ((map (make-sparse-keymap))) |
6709 |
|
(unless (>= emacs-major-version 21) |
6710 |
|
;; XEmacs doesn't care. |
6711 |
|
(set-keymap-parent map gnus-article-mode-map)) |
6712 |
|
(define-key map gnus-mouse-2 'gnus-button-next-page) |
6713 |
|
(define-key map "\r" 'gnus-button-next-page) |
6714 |
|
map)) |
6715 |
|
|
6716 |
(defun gnus-insert-prev-page-button () |
(defun gnus-insert-prev-page-button () |
6717 |
(let ((inhibit-read-only t)) |
(let ((b (point)) |
6718 |
|
(inhibit-read-only t)) |
6719 |
(gnus-eval-format |
(gnus-eval-format |
6720 |
gnus-prev-page-line-format nil |
gnus-prev-page-line-format nil |
6721 |
`(gnus-prev t local-map ,gnus-prev-page-map |
`(,@(gnus-local-map-property gnus-prev-page-map) |
6722 |
gnus-callback gnus-article-button-prev-page |
gnus-prev t |
6723 |
article-type annotation)))) |
gnus-callback gnus-article-button-prev-page |
6724 |
|
article-type annotation)) |
6725 |
(defvar gnus-next-page-map nil) |
(widget-convert-button |
6726 |
(unless gnus-next-page-map |
'link b (if (bolp) |
6727 |
(setq gnus-next-page-map (make-keymap)) |
;; Exclude a newline. |
6728 |
(suppress-keymap gnus-prev-page-map) |
(1- (point)) |
6729 |
(define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) |
(point)) |
6730 |
(define-key gnus-next-page-map "\r" 'gnus-button-next-page)) |
:action 'gnus-button-prev-page |
6731 |
|
:button-keymap gnus-prev-page-map))) |
6732 |
|
|
6733 |
(defun gnus-button-next-page () |
(defun gnus-button-next-page (&optional args more-args) |
6734 |
"Go to the next page." |
"Go to the next page." |
6735 |
(interactive) |
(interactive) |
6736 |
(let ((win (selected-window))) |
(let ((win (selected-window))) |
6737 |
(select-window (get-buffer-window gnus-article-buffer t)) |
(select-window (gnus-get-buffer-window gnus-article-buffer t)) |
6738 |
(gnus-article-next-page) |
(gnus-article-next-page) |
6739 |
(select-window win))) |
(select-window win))) |
6740 |
|
|
6741 |
(defun gnus-button-prev-page () |
(defun gnus-button-prev-page (&optional args more-args) |
6742 |
"Go to the prev page." |
"Go to the prev page." |
6743 |
(interactive) |
(interactive) |
6744 |
(let ((win (selected-window))) |
(let ((win (selected-window))) |
6745 |
(select-window (get-buffer-window gnus-article-buffer t)) |
(select-window (gnus-get-buffer-window gnus-article-buffer t)) |
6746 |
(gnus-article-prev-page) |
(gnus-article-prev-page) |
6747 |
(select-window win))) |
(select-window win))) |
6748 |
|
|
6749 |
(defun gnus-insert-next-page-button () |
(defun gnus-insert-next-page-button () |
6750 |
(let ((inhibit-read-only t)) |
(let ((b (point)) |
6751 |
|
(inhibit-read-only t)) |
6752 |
(gnus-eval-format gnus-next-page-line-format nil |
(gnus-eval-format gnus-next-page-line-format nil |
6753 |
`(gnus-next |
`(,@(gnus-local-map-property gnus-next-page-map) |
6754 |
t local-map ,gnus-next-page-map |
gnus-next t |
6755 |
gnus-callback gnus-article-button-next-page |
gnus-callback gnus-article-button-next-page |
6756 |
article-type annotation)))) |
article-type annotation)) |
6757 |
|
(widget-convert-button |
6758 |
|
'link b (if (bolp) |
6759 |
|
;; Exclude a newline. |
6760 |
|
(1- (point)) |
6761 |
|
(point)) |
6762 |
|
:action 'gnus-button-next-page |
6763 |
|
:button-keymap gnus-next-page-map))) |
6764 |
|
|
6765 |
(defun gnus-article-button-next-page (arg) |
(defun gnus-article-button-next-page (arg) |
6766 |
"Go to the next page." |
"Go to the next page." |
6767 |
(interactive "P") |
(interactive "P") |
6768 |
(let ((win (selected-window))) |
(let ((win (selected-window))) |
6769 |
(select-window (get-buffer-window gnus-article-buffer t)) |
(select-window (gnus-get-buffer-window gnus-article-buffer t)) |
6770 |
(gnus-article-next-page) |
(gnus-article-next-page) |
6771 |
(select-window win))) |
(select-window win))) |
6772 |
|
|
6774 |
"Go to the prev page." |
"Go to the prev page." |
6775 |
(interactive "P") |
(interactive "P") |
6776 |
(let ((win (selected-window))) |
(let ((win (selected-window))) |
6777 |
(select-window (get-buffer-window gnus-article-buffer t)) |
(select-window (gnus-get-buffer-window gnus-article-buffer t)) |
6778 |
(gnus-article-prev-page) |
(gnus-article-prev-page) |
6779 |
(select-window win))) |
(select-window win))) |
6780 |
|
|
6784 |
|
|
6785 |
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item |
This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item |
6786 |
is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a |
is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a |
6787 |
\(REGEXP . FUNCTION), FUNCTION will be only applied to these newsgroups |
\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups |
6788 |
whose names match REGEXP. |
whose names match REGEXP. |
6789 |
|
|
6790 |
For example: |
For example: |
6834 |
(highlightp (gnus-visual-p 'article-highlight 'highlight)) |
(highlightp (gnus-visual-p 'article-highlight 'highlight)) |
6835 |
val elem) |
val elem) |
6836 |
(gnus-run-hooks 'gnus-part-display-hook) |
(gnus-run-hooks 'gnus-part-display-hook) |
6837 |
(while (setq elem (pop alist)) |
(dolist (elem alist) |
6838 |
(setq val |
(setq val |
6839 |
(save-excursion |
(save-excursion |
6840 |
(if (gnus-buffer-live-p gnus-summary-buffer) |
(when (gnus-buffer-live-p gnus-summary-buffer) |
6841 |
(set-buffer gnus-summary-buffer)) |
(set-buffer gnus-summary-buffer)) |
6842 |
(symbol-value (car elem)))) |
(symbol-value (car elem)))) |
6843 |
(when (and (or (consp val) |
(when (and (or (consp val) |
6844 |
treated-type) |
treated-type) |
6860 |
(cond |
(cond |
6861 |
((null val) |
((null val) |
6862 |
nil) |
nil) |
6863 |
|
(condition |
6864 |
|
(eq condition val)) |
6865 |
((and (listp val) |
((and (listp val) |
6866 |
(stringp (car val))) |
(stringp (car val))) |
6867 |
(apply 'gnus-or (mapcar `(lambda (s) |
(apply 'gnus-or (mapcar `(lambda (s) |
6880 |
(equal (car val) type)) |
(equal (car val) type)) |
6881 |
(t |
(t |
6882 |
(error "%S is not a valid predicate" pred))))) |
(error "%S is not a valid predicate" pred))))) |
|
(condition |
|
|
(eq condition val)) |
|
6883 |
((eq val t) |
((eq val t) |
6884 |
t) |
t) |
6885 |
((eq val 'head) |
((eq val 'head) |
6891 |
(t |
(t |
6892 |
(error "%S is not a valid value" val)))) |
(error "%S is not a valid value" val)))) |
6893 |
|
|
6894 |
|
(defun gnus-article-encrypt-body (protocol &optional n) |
6895 |
|
"Encrypt the article body." |
6896 |
|
(interactive |
6897 |
|
(list |
6898 |
|
(or gnus-article-encrypt-protocol |
6899 |
|
(completing-read "Encrypt protocol: " |
6900 |
|
gnus-article-encrypt-protocol-alist |
6901 |
|
nil t)) |
6902 |
|
current-prefix-arg)) |
6903 |
|
(let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) |
6904 |
|
(unless func |
6905 |
|
(error (format "Can't find the encrypt protocol %s" protocol))) |
6906 |
|
(if (member gnus-newsgroup-name '("nndraft:delayed" |
6907 |
|
"nndraft:drafts" |
6908 |
|
"nndraft:queue")) |
6909 |
|
(error "Can't encrypt the article in group %s" |
6910 |
|
gnus-newsgroup-name)) |
6911 |
|
(gnus-summary-iterate n |
6912 |
|
(save-excursion |
6913 |
|
(set-buffer gnus-summary-buffer) |
6914 |
|
(let ((mail-parse-charset gnus-newsgroup-charset) |
6915 |
|
(mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) |
6916 |
|
(summary-buffer gnus-summary-buffer) |
6917 |
|
references point) |
6918 |
|
(gnus-set-global-variables) |
6919 |
|
(when (gnus-group-read-only-p) |
6920 |
|
(error "The current newsgroup does not support article encrypt")) |
6921 |
|
(gnus-summary-show-article t) |
6922 |
|
(setq references |
6923 |
|
(or (mail-header-references gnus-current-headers) "")) |
6924 |
|
(set-buffer gnus-article-buffer) |
6925 |
|
(let* ((inhibit-read-only t) |
6926 |
|
(headers |
6927 |
|
(mapcar (lambda (field) |
6928 |
|
(and (save-restriction |
6929 |
|
(message-narrow-to-head) |
6930 |
|
(goto-char (point-min)) |
6931 |
|
(search-forward field nil t)) |
6932 |
|
(prog2 |
6933 |
|
(message-narrow-to-field) |
6934 |
|
(buffer-string) |
6935 |
|
(delete-region (point-min) (point-max)) |
6936 |
|
(widen)))) |
6937 |
|
'("Content-Type:" "Content-Transfer-Encoding:" |
6938 |
|
"Content-Disposition:")))) |
6939 |
|
(message-narrow-to-head) |
6940 |
|
(message-remove-header "MIME-Version") |
6941 |
|
(goto-char (point-max)) |
6942 |
|
(setq point (point)) |
6943 |
|
(insert (apply 'concat headers)) |
6944 |
|
(widen) |
6945 |
|
(narrow-to-region point (point-max)) |
6946 |
|
(let ((message-options message-options)) |
6947 |
|
(message-options-set 'message-sender user-mail-address) |
6948 |
|
(message-options-set 'message-recipients user-mail-address) |
6949 |
|
(message-options-set 'message-sign-encrypt 'not) |
6950 |
|
(funcall func)) |
6951 |
|
(goto-char (point-min)) |
6952 |
|
(insert "MIME-Version: 1.0\n") |
6953 |
|
(widen) |
6954 |
|
(gnus-summary-edit-article-done |
6955 |
|
references nil summary-buffer t)) |
6956 |
|
(when gnus-keep-backlog |
6957 |
|
(gnus-backlog-remove-article |
6958 |
|
(car gnus-article-current) (cdr gnus-article-current))) |
6959 |
|
(save-excursion |
6960 |
|
(when (get-buffer gnus-original-article-buffer) |
6961 |
|
(set-buffer gnus-original-article-buffer) |
6962 |
|
(setq gnus-original-article nil))) |
6963 |
|
(when gnus-use-cache |
6964 |
|
(gnus-cache-update-article |
6965 |
|
(car gnus-article-current) (cdr gnus-article-current)))))))) |
6966 |
|
|
6967 |
|
(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n" |
6968 |
|
"The following specs can be used: |
6969 |
|
%t The security MIME type |
6970 |
|
%i Additional info |
6971 |
|
%d Details |
6972 |
|
%D Details if button is pressed") |
6973 |
|
|
6974 |
|
(defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n" |
6975 |
|
"The following specs can be used: |
6976 |
|
%t The security MIME type |
6977 |
|
%i Additional info |
6978 |
|
%d Details |
6979 |
|
%D Details if button is pressed") |
6980 |
|
|
6981 |
|
(defvar gnus-mime-security-button-line-format-alist |
6982 |
|
'((?t gnus-tmp-type ?s) |
6983 |
|
(?i gnus-tmp-info ?s) |
6984 |
|
(?d gnus-tmp-details ?s) |
6985 |
|
(?D gnus-tmp-pressed-details ?s))) |
6986 |
|
|
6987 |
|
(defvar gnus-mime-security-button-map |
6988 |
|
(let ((map (make-sparse-keymap))) |
6989 |
|
(unless (>= (string-to-number emacs-version) 21) |
6990 |
|
(set-keymap-parent map gnus-article-mode-map)) |
6991 |
|
(define-key map gnus-mouse-2 'gnus-article-push-button) |
6992 |
|
(define-key map "\r" 'gnus-article-press-button) |
6993 |
|
map)) |
6994 |
|
|
6995 |
|
(defvar gnus-mime-security-details-buffer nil) |
6996 |
|
|
6997 |
|
(defvar gnus-mime-security-button-pressed nil) |
6998 |
|
|
6999 |
|
(defvar gnus-mime-security-show-details-inline t |
7000 |
|
"If non-nil, show details in the article buffer.") |
7001 |
|
|
7002 |
|
(defun gnus-mime-security-verify-or-decrypt (handle) |
7003 |
|
(mm-remove-parts (cdr handle)) |
7004 |
|
(let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) |
7005 |
|
point (inhibit-read-only t)) |
7006 |
|
(if region |
7007 |
|
(goto-char (car region))) |
7008 |
|
(save-restriction |
7009 |
|
(narrow-to-region (point) (point)) |
7010 |
|
(with-current-buffer (mm-handle-multipart-original-buffer handle) |
7011 |
|
(let* ((mm-verify-option 'known) |
7012 |
|
(mm-decrypt-option 'known) |
7013 |
|
(nparts (mm-possibly-verify-or-decrypt (cdr handle) handle))) |
7014 |
|
(unless (eq nparts (cdr handle)) |
7015 |
|
(mm-destroy-parts (cdr handle)) |
7016 |
|
(setcdr handle nparts)))) |
7017 |
|
(setq point (point)) |
7018 |
|
(gnus-mime-display-security handle) |
7019 |
|
(goto-char (point-max))) |
7020 |
|
(when region |
7021 |
|
(delete-region (point) (cdr region)) |
7022 |
|
(set-marker (car region) nil) |
7023 |
|
(set-marker (cdr region) nil)) |
7024 |
|
(goto-char point))) |
7025 |
|
|
7026 |
|
(defun gnus-mime-security-show-details (handle) |
7027 |
|
(let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) |
7028 |
|
(if (not details) |
7029 |
|
(gnus-message 5 "No details.") |
7030 |
|
(if gnus-mime-security-show-details-inline |
7031 |
|
(let ((gnus-mime-security-button-pressed |
7032 |
|
(not (get-text-property (point) 'gnus-mime-details))) |
7033 |
|
(gnus-mime-security-button-line-format |
7034 |
|
(get-text-property (point) 'gnus-line-format)) |
7035 |
|
(inhibit-read-only t)) |
7036 |
|
(forward-char -1) |
7037 |
|
(while (eq (get-text-property (point) 'gnus-line-format) |
7038 |
|
gnus-mime-security-button-line-format) |
7039 |
|
(forward-char -1)) |
7040 |
|
(forward-char) |
7041 |
|
(save-restriction |
7042 |
|
(narrow-to-region (point) (point)) |
7043 |
|
(gnus-insert-mime-security-button handle)) |
7044 |
|
(delete-region (point) |
7045 |
|
(or (text-property-not-all |
7046 |
|
(point) (point-max) |
7047 |
|
'gnus-line-format |
7048 |
|
gnus-mime-security-button-line-format) |
7049 |
|
(point-max)))) |
7050 |
|
;; Not inlined. |
7051 |
|
(if (gnus-buffer-live-p gnus-mime-security-details-buffer) |
7052 |
|
(with-current-buffer gnus-mime-security-details-buffer |
7053 |
|
(erase-buffer) |
7054 |
|
t) |
7055 |
|
(setq gnus-mime-security-details-buffer |
7056 |
|
(gnus-get-buffer-create "*MIME Security Details*"))) |
7057 |
|
(with-current-buffer gnus-mime-security-details-buffer |
7058 |
|
(insert details) |
7059 |
|
(goto-char (point-min))) |
7060 |
|
(pop-to-buffer gnus-mime-security-details-buffer))))) |
7061 |
|
|
7062 |
|
(defun gnus-mime-security-press-button (handle) |
7063 |
|
(save-excursion |
7064 |
|
(if (mm-handle-multipart-ctl-parameter handle 'gnus-info) |
7065 |
|
(gnus-mime-security-show-details handle) |
7066 |
|
(gnus-mime-security-verify-or-decrypt handle)))) |
7067 |
|
|
7068 |
|
(defun gnus-insert-mime-security-button (handle &optional displayed) |
7069 |
|
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) |
7070 |
|
(gnus-tmp-type |
7071 |
|
(concat |
7072 |
|
(or (nth 2 (assoc protocol mm-verify-function-alist)) |
7073 |
|
(nth 2 (assoc protocol mm-decrypt-function-alist)) |
7074 |
|
"Unknown") |
7075 |
|
(if (equal (car handle) "multipart/signed") |
7076 |
|
" Signed" " Encrypted") |
7077 |
|
" Part")) |
7078 |
|
(gnus-tmp-info |
7079 |
|
(or (mm-handle-multipart-ctl-parameter handle 'gnus-info) |
7080 |
|
"Undecided")) |
7081 |
|
(gnus-tmp-details |
7082 |
|
(mm-handle-multipart-ctl-parameter handle 'gnus-details)) |
7083 |
|
gnus-tmp-pressed-details |
7084 |
|
b e) |
7085 |
|
(setq gnus-tmp-details |
7086 |
|
(if gnus-tmp-details |
7087 |
|
(concat "\n" gnus-tmp-details) |
7088 |
|
"")) |
7089 |
|
(setq gnus-tmp-pressed-details |
7090 |
|
(if gnus-mime-security-button-pressed gnus-tmp-details "")) |
7091 |
|
(unless (bolp) |
7092 |
|
(insert "\n")) |
7093 |
|
(setq b (point)) |
7094 |
|
(gnus-eval-format |
7095 |
|
gnus-mime-security-button-line-format |
7096 |
|
gnus-mime-security-button-line-format-alist |
7097 |
|
`(,@(gnus-local-map-property gnus-mime-security-button-map) |
7098 |
|
gnus-callback gnus-mime-security-press-button |
7099 |
|
gnus-line-format ,gnus-mime-security-button-line-format |
7100 |
|
gnus-mime-details ,gnus-mime-security-button-pressed |
7101 |
|
article-type annotation |
7102 |
|
gnus-data ,handle)) |
7103 |
|
(setq e (if (bolp) |
7104 |
|
;; Exclude a newline. |
7105 |
|
(1- (point)) |
7106 |
|
(point))) |
7107 |
|
(widget-convert-button |
7108 |
|
'link b e |
7109 |
|
:mime-handle handle |
7110 |
|
:action 'gnus-widget-press-button |
7111 |
|
:button-keymap gnus-mime-security-button-map |
7112 |
|
:help-echo |
7113 |
|
(lambda (widget/window &optional overlay pos) |
7114 |
|
;; Needed to properly clear the message due to a bug in |
7115 |
|
;; wid-edit (XEmacs only). |
7116 |
|
(when (boundp 'help-echo-owns-message) |
7117 |
|
(setq help-echo-owns-message t)) |
7118 |
|
(format |
7119 |
|
"%S: show detail" |
7120 |
|
(aref gnus-mouse-2 0)))))) |
7121 |
|
|
7122 |
|
(defun gnus-mime-display-security (handle) |
7123 |
|
(save-restriction |
7124 |
|
(narrow-to-region (point) (point)) |
7125 |
|
(unless (gnus-unbuttonized-mime-type-p (car handle)) |
7126 |
|
(gnus-insert-mime-security-button handle)) |
7127 |
|
(gnus-mime-display-mixed (cdr handle)) |
7128 |
|
(unless (bolp) |
7129 |
|
(insert "\n")) |
7130 |
|
(unless (gnus-unbuttonized-mime-type-p (car handle)) |
7131 |
|
(let ((gnus-mime-security-button-line-format |
7132 |
|
gnus-mime-security-button-end-line-format)) |
7133 |
|
(gnus-insert-mime-security-button handle))) |
7134 |
|
(mm-set-handle-multipart-parameter |
7135 |
|
handle 'gnus-region |
7136 |
|
(cons (set-marker (make-marker) (point-min)) |
7137 |
|
(set-marker (make-marker) (point-max)))))) |
7138 |
|
|
7139 |
(gnus-ems-redefine) |
(gnus-ems-redefine) |
7140 |
|
|
7141 |
(provide 'gnus-art) |
(provide 'gnus-art) |