Mercurial > emacs
annotate lisp/gnus/gnus-util.el @ 50772:4de456f5faa3
More excluded charsets for Unicode support.
author | Kai Großjohann <kgrossjo@eu.uu.net> |
---|---|
date | Thu, 01 May 2003 12:17:54 +0000 |
parents | 52d99cc2e9e3 |
children | 695cf19ef79e d7ddb3e565de |
rev | line source |
---|---|
17493 | 1 ;;; gnus-util.el --- utility functions for Gnus |
48588 | 2 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2002 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
3 ;; Free Software Foundation, Inc. |
17493 | 4 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 6 ;; Keywords: news |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; Nothing in this file depends on any other parts of Gnus -- all | |
28 ;; functions and macros in this file are utility functions that are | |
29 ;; used by Gnus and may be used by any other package without loading | |
30 ;; Gnus first. | |
31 | |
32 ;;; Code: | |
33 | |
34 (require 'custom) | |
35051
d80c28ab0b86
(nnmail-pathname-coding-system): Defvar when
Dave Love <fx@gnu.org>
parents:
34833
diff
changeset
|
35 (eval-when-compile |
d80c28ab0b86
(nnmail-pathname-coding-system): Defvar when
Dave Love <fx@gnu.org>
parents:
34833
diff
changeset
|
36 (require 'cl) |
d80c28ab0b86
(nnmail-pathname-coding-system): Defvar when
Dave Love <fx@gnu.org>
parents:
34833
diff
changeset
|
37 ;; Fixme: this should be a gnus variable, not nnmail-. |
d80c28ab0b86
(nnmail-pathname-coding-system): Defvar when
Dave Love <fx@gnu.org>
parents:
34833
diff
changeset
|
38 (defvar nnmail-pathname-coding-system)) |
17493 | 39 (require 'nnheader) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
40 (require 'time-date) |
17493 | 41 |
42 (eval-and-compile | |
33287
83a1db714361
(nnheader): Don't require message (recursive
Dave Love <fx@gnu.org>
parents:
33267
diff
changeset
|
43 (autoload 'message-fetch-field "message") |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
44 (autoload 'rmail-insert-rmail-file-header "rmail") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
45 (autoload 'rmail-count-new-messages "rmail") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
46 (autoload 'rmail-show-message "rmail")) |
17493 | 47 |
48 (defun gnus-boundp (variable) | |
49 "Return non-nil if VARIABLE is bound and non-nil." | |
50 (and (boundp variable) | |
51 (symbol-value variable))) | |
52 | |
53 (defmacro gnus-eval-in-buffer-window (buffer &rest forms) | |
54 "Pop to BUFFER, evaluate FORMS, and then return to the original window." | |
55 (let ((tempvar (make-symbol "GnusStartBufferWindow")) | |
56 (w (make-symbol "w")) | |
57 (buf (make-symbol "buf"))) | |
58 `(let* ((,tempvar (selected-window)) | |
59 (,buf ,buffer) | |
60 (,w (get-buffer-window ,buf 'visible))) | |
61 (unwind-protect | |
62 (progn | |
63 (if ,w | |
64 (progn | |
65 (select-window ,w) | |
66 (set-buffer (window-buffer ,w))) | |
67 (pop-to-buffer ,buf)) | |
68 ,@forms) | |
69 (select-window ,tempvar))))) | |
70 | |
71 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) | |
72 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) | |
73 | |
74 (defmacro gnus-intern-safe (string hashtable) | |
75 "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." | |
76 `(let ((symbol (intern ,string ,hashtable))) | |
77 (or (boundp symbol) | |
78 (set symbol nil)) | |
79 symbol)) | |
80 | |
81 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way | |
82 ;; to limit the length of a string. This function is necessary since | |
83 ;; `(substr "abc" 0 30)' pukes with "Args out of range". | |
84 (defsubst gnus-limit-string (str width) | |
85 (if (> (length str) width) | |
86 (substring str 0 width) | |
87 str)) | |
88 | |
89 (defsubst gnus-functionp (form) | |
90 "Return non-nil if FORM is funcallable." | |
91 (or (and (symbolp form) (fboundp form)) | |
92 (and (listp form) (eq (car form) 'lambda)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
93 (byte-code-function-p form))) |
17493 | 94 |
95 (defsubst gnus-goto-char (point) | |
96 (and point (goto-char point))) | |
97 | |
98 (defmacro gnus-buffer-exists-p (buffer) | |
99 `(let ((buffer ,buffer)) | |
100 (when buffer | |
101 (funcall (if (stringp buffer) 'get-buffer 'buffer-name) | |
102 buffer)))) | |
103 | |
104 (defmacro gnus-kill-buffer (buffer) | |
105 `(let ((buf ,buffer)) | |
106 (when (gnus-buffer-exists-p buf) | |
107 (kill-buffer buf)))) | |
108 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
109 (defalias 'gnus-point-at-bol |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
110 (if (fboundp 'point-at-bol) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
111 'point-at-bol |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
112 'line-beginning-position)) |
17493 | 113 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
114 (defalias 'gnus-point-at-eol |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
115 (if (fboundp 'point-at-eol) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
116 'point-at-eol |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
117 'line-end-position)) |
17493 | 118 |
119 (defun gnus-delete-first (elt list) | |
120 "Delete by side effect the first occurrence of ELT as a member of LIST." | |
121 (if (equal (car list) elt) | |
122 (cdr list) | |
123 (let ((total list)) | |
124 (while (and (cdr list) | |
125 (not (equal (cadr list) elt))) | |
126 (setq list (cdr list))) | |
127 (when (cdr list) | |
128 (setcdr list (cddr list))) | |
129 total))) | |
130 | |
131 ;; Delete the current line (and the next N lines). | |
132 (defmacro gnus-delete-line (&optional n) | |
133 `(delete-region (progn (beginning-of-line) (point)) | |
134 (progn (forward-line ,(or n 1)) (point)))) | |
135 | |
136 (defun gnus-byte-code (func) | |
137 "Return a form that can be `eval'ed based on FUNC." | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
138 (let ((fval (indirect-function func))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
139 (if (byte-code-function-p fval) |
17493 | 140 (let ((flist (append fval nil))) |
141 (setcar flist 'byte-code) | |
142 flist) | |
143 (cons 'progn (cddr fval))))) | |
144 | |
145 (defun gnus-extract-address-components (from) | |
146 (let (name address) | |
147 ;; First find the address - the thing with the @ in it. This may | |
148 ;; not be accurate in mail addresses, but does the trick most of | |
149 ;; the time in news messages. | |
150 (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) | |
151 (setq address (substring from (match-beginning 0) (match-end 0)))) | |
152 ;; Then we check whether the "name <address>" format is used. | |
153 (and address | |
154 ;; Linear white space is not required. | |
155 (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) | |
156 (and (setq name (substring from 0 (match-beginning 0))) | |
157 ;; Strip any quotes from the name. | |
158 (string-match "\".*\"" name) | |
159 (setq name (substring name 1 (1- (match-end 0)))))) | |
160 ;; If not, then "address (name)" is used. | |
161 (or name | |
162 (and (string-match "(.+)" from) | |
163 (setq name (substring from (1+ (match-beginning 0)) | |
164 (1- (match-end 0))))) | |
165 (and (string-match "()" from) | |
166 (setq name address)) | |
167 ;; XOVER might not support folded From headers. | |
168 (and (string-match "(.*" from) | |
169 (setq name (substring from (1+ (match-beginning 0)) | |
170 (match-end 0))))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
171 (list (if (string= name "") nil name) (or address from)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
172 |
17493 | 173 |
174 (defun gnus-fetch-field (field) | |
175 "Return the value of the header FIELD of current article." | |
176 (save-excursion | |
177 (save-restriction | |
178 (let ((case-fold-search t) | |
179 (inhibit-point-motion-hooks t)) | |
180 (nnheader-narrow-to-headers) | |
181 (message-fetch-field field))))) | |
182 | |
183 (defun gnus-goto-colon () | |
184 (beginning-of-line) | |
185 (search-forward ":" (gnus-point-at-eol) t)) | |
186 | |
187 (defun gnus-remove-text-with-property (prop) | |
188 "Delete all text in the current buffer with text property PROP." | |
189 (save-excursion | |
190 (goto-char (point-min)) | |
191 (while (not (eobp)) | |
192 (while (get-text-property (point) prop) | |
193 (delete-char 1)) | |
194 (goto-char (next-single-property-change (point) prop nil (point-max)))))) | |
195 | |
196 (defun gnus-newsgroup-directory-form (newsgroup) | |
197 "Make hierarchical directory name from NEWSGROUP name." | |
198 (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) | |
199 (len (length newsgroup)) | |
200 idx) | |
201 ;; If this is a foreign group, we don't want to translate the | |
202 ;; entire name. | |
203 (if (setq idx (string-match ":" newsgroup)) | |
204 (aset newsgroup idx ?/) | |
205 (setq idx 0)) | |
206 ;; Replace all occurrences of `.' with `/'. | |
207 (while (< idx len) | |
208 (when (= (aref newsgroup idx) ?.) | |
209 (aset newsgroup idx ?/)) | |
210 (setq idx (1+ idx))) | |
211 newsgroup)) | |
212 | |
213 (defun gnus-newsgroup-savable-name (group) | |
214 ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) | |
215 ;; with dots. | |
216 (nnheader-replace-chars-in-string group ?/ ?.)) | |
217 | |
218 (defun gnus-string> (s1 s2) | |
219 (not (or (string< s1 s2) | |
220 (string= s1 s2)))) | |
221 | |
222 ;;; Time functions. | |
223 | |
224 (defun gnus-file-newer-than (file date) | |
225 (let ((fdate (nth 5 (file-attributes file)))) | |
226 (or (> (car fdate) (car date)) | |
227 (and (= (car fdate) (car date)) | |
228 (> (nth 1 fdate) (nth 1 date)))))) | |
229 | |
230 ;;; Keymap macros. | |
231 | |
232 (defmacro gnus-local-set-keys (&rest plist) | |
233 "Set the keys in PLIST in the current keymap." | |
234 `(gnus-define-keys-1 (current-local-map) ',plist)) | |
235 | |
236 (defmacro gnus-define-keys (keymap &rest plist) | |
237 "Define all keys in PLIST in KEYMAP." | |
238 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) | |
239 | |
240 (defmacro gnus-define-keys-safe (keymap &rest plist) | |
241 "Define all keys in PLIST in KEYMAP without overwriting previous definitions." | |
242 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) | |
243 | |
244 (put 'gnus-define-keys 'lisp-indent-function 1) | |
245 (put 'gnus-define-keys-safe 'lisp-indent-function 1) | |
246 (put 'gnus-local-set-keys 'lisp-indent-function 1) | |
247 | |
248 (defmacro gnus-define-keymap (keymap &rest plist) | |
249 "Define all keys in PLIST in KEYMAP." | |
250 `(gnus-define-keys-1 ,keymap (quote ,plist))) | |
251 | |
252 (put 'gnus-define-keymap 'lisp-indent-function 1) | |
253 | |
254 (defun gnus-define-keys-1 (keymap plist &optional safe) | |
255 (when (null keymap) | |
256 (error "Can't set keys in a null keymap")) | |
257 (cond ((symbolp keymap) | |
258 (setq keymap (symbol-value keymap))) | |
259 ((keymapp keymap)) | |
260 ((listp keymap) | |
261 (set (car keymap) nil) | |
262 (define-prefix-command (car keymap)) | |
263 (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) | |
264 (setq keymap (symbol-value (car keymap))))) | |
265 (let (key) | |
266 (while plist | |
267 (when (symbolp (setq key (pop plist))) | |
268 (setq key (symbol-value key))) | |
269 (if (or (not safe) | |
270 (eq (lookup-key keymap key) 'undefined)) | |
271 (define-key keymap key (pop plist)) | |
272 (pop plist))))) | |
273 | |
274 (defun gnus-completing-read (default prompt &rest args) | |
275 ;; Like `completing-read', except that DEFAULT is the default argument. | |
276 (let* ((prompt (if default | |
277 (concat prompt " (default " default ") ") | |
278 (concat prompt " "))) | |
279 (answer (apply 'completing-read prompt args))) | |
280 (if (or (null answer) (zerop (length answer))) | |
281 default | |
282 answer))) | |
283 | |
284 ;; Two silly functions to ensure that all `y-or-n-p' questions clear | |
285 ;; the echo area. | |
286 (defun gnus-y-or-n-p (prompt) | |
287 (prog1 | |
288 (y-or-n-p prompt) | |
289 (message ""))) | |
290 | |
291 (defun gnus-yes-or-no-p (prompt) | |
292 (prog1 | |
293 (yes-or-no-p prompt) | |
294 (message ""))) | |
295 | |
296 (defun gnus-dd-mmm (messy-date) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
297 "Return a string like DD-MMM from a big messy string." |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
298 (condition-case () |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
299 (format-time-string "%d-%b" (safe-date-to-time messy-date)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
300 (error " - "))) |
17493 | 301 |
302 (defmacro gnus-date-get-time (date) | |
303 "Convert DATE string to Emacs time. | |
304 Cache the result as a text property stored in DATE." | |
305 ;; Either return the cached value... | |
306 `(let ((d ,date)) | |
307 (if (equal "" d) | |
308 '(0 0) | |
309 (or (get-text-property 0 'gnus-time d) | |
310 ;; or compute the value... | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
311 (let ((time (safe-date-to-time d))) |
17493 | 312 ;; and store it back in the string. |
313 (put-text-property 0 1 'gnus-time time d) | |
314 time))))) | |
315 | |
316 (defsubst gnus-time-iso8601 (time) | |
31785 | 317 "Return a string of TIME in YYYYMMDDTHHMMSS format." |
17493 | 318 (format-time-string "%Y%m%dT%H%M%S" time)) |
319 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
320 (defun gnus-date-iso8601 (date) |
31785 | 321 "Convert the DATE to YYYYMMDDTHHMMSS." |
17493 | 322 (condition-case () |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
323 (gnus-time-iso8601 (gnus-date-get-time date)) |
17493 | 324 (error ""))) |
325 | |
326 (defun gnus-mode-string-quote (string) | |
327 "Quote all \"%\"'s in STRING." | |
328 (save-excursion | |
329 (gnus-set-work-buffer) | |
330 (insert string) | |
331 (goto-char (point-min)) | |
332 (while (search-forward "%" nil t) | |
333 (insert "%")) | |
334 (buffer-string))) | |
335 | |
336 ;; Make a hash table (default and minimum size is 256). | |
337 ;; Optional argument HASHSIZE specifies the table size. | |
338 (defun gnus-make-hashtable (&optional hashsize) | |
339 (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0)) | |
340 | |
341 ;; Make a number that is suitable for hashing; bigger than MIN and | |
342 ;; equal to some 2^x. Many machines (such as sparcs) do not have a | |
343 ;; hardware modulo operation, so they implement it in software. On | |
344 ;; many sparcs over 50% of the time to intern is spent in the modulo. | |
345 ;; Yes, it's slower than actually computing the hash from the string! | |
346 ;; So we use powers of 2 so people can optimize the modulo to a mask. | |
347 (defun gnus-create-hash-size (min) | |
348 (let ((i 1)) | |
349 (while (< i min) | |
350 (setq i (* 2 i))) | |
351 i)) | |
352 | |
353 (defcustom gnus-verbose 7 | |
354 "*Integer that says how verbose Gnus should be. | |
355 The higher the number, the more messages Gnus will flash to say what | |
356 it's doing. At zero, Gnus will be totally mute; at five, Gnus will | |
357 display most important messages; and at ten, Gnus will keep on | |
358 jabbering all the time." | |
359 :group 'gnus-start | |
360 :type 'integer) | |
361 | |
362 ;; Show message if message has a lower level than `gnus-verbose'. | |
363 ;; Guideline for numbers: | |
364 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages | |
365 ;; for things that take a long time, 7 - not very important messages | |
366 ;; on stuff, 9 - messages inside loops. | |
367 (defun gnus-message (level &rest args) | |
368 (if (<= level gnus-verbose) | |
369 (apply 'message args) | |
370 ;; We have to do this format thingy here even if the result isn't | |
371 ;; shown - the return value has to be the same as the return value | |
372 ;; from `message'. | |
373 (apply 'format args))) | |
374 | |
375 (defun gnus-error (level &rest args) | |
376 "Beep an error if LEVEL is equal to or less than `gnus-verbose'." | |
377 (when (<= (floor level) gnus-verbose) | |
378 (apply 'message args) | |
379 (ding) | |
380 (let (duration) | |
381 (when (and (floatp level) | |
382 (not (zerop (setq duration (* 10 (- level (floor level))))))) | |
383 (sit-for duration)))) | |
384 nil) | |
385 | |
386 (defun gnus-split-references (references) | |
387 "Return a list of Message-IDs in REFERENCES." | |
388 (let ((beg 0) | |
389 ids) | |
390 (while (string-match "<[^>]+>" references beg) | |
391 (push (substring references (match-beginning 0) (setq beg (match-end 0))) | |
392 ids)) | |
393 (nreverse ids))) | |
394 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
395 (defsubst gnus-parent-id (references &optional n) |
17493 | 396 "Return the last Message-ID in REFERENCES. |
397 If N, return the Nth ancestor instead." | |
398 (when references | |
399 (let ((ids (inline (gnus-split-references references)))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
400 (while (nthcdr (or n 1) ids) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
401 (setq ids (cdr ids))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
402 (car ids)))) |
17493 | 403 |
404 (defsubst gnus-buffer-live-p (buffer) | |
405 "Say whether BUFFER is alive or not." | |
406 (and buffer | |
407 (get-buffer buffer) | |
408 (buffer-name (get-buffer buffer)))) | |
409 | |
410 (defun gnus-horizontal-recenter () | |
411 "Recenter the current buffer horizontally." | |
412 (if (< (current-column) (/ (window-width) 2)) | |
413 (set-window-hscroll (get-buffer-window (current-buffer) t) 0) | |
414 (let* ((orig (point)) | |
415 (end (window-end (get-buffer-window (current-buffer) t))) | |
416 (max 0)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
417 (when end |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
418 ;; Find the longest line currently displayed in the window. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
419 (goto-char (window-start)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
420 (while (and (not (eobp)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
421 (< (point) end)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
422 (end-of-line) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
423 (setq max (max max (current-column))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
424 (forward-line 1)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
425 (goto-char orig) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
426 ;; Scroll horizontally to center (sort of) the point. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
427 (if (> max (window-width)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
428 (set-window-hscroll |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
429 (get-buffer-window (current-buffer) t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
430 (min (- (current-column) (/ (window-width) 3)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
431 (+ 2 (- max (window-width))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
432 (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
433 max)))) |
17493 | 434 |
435 (defun gnus-read-event-char () | |
436 "Get the next event." | |
437 (let ((event (read-event))) | |
438 ;; should be gnus-characterp, but this can't be called in XEmacs anyway | |
439 (cons (and (numberp event) event) event))) | |
440 | |
441 (defun gnus-sortable-date (date) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
442 "Make string suitable for sorting from DATE." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
443 (gnus-time-iso8601 (date-to-time date))) |
17493 | 444 |
445 (defun gnus-copy-file (file &optional to) | |
446 "Copy FILE to TO." | |
447 (interactive | |
448 (list (read-file-name "Copy file: " default-directory) | |
449 (read-file-name "Copy file to: " default-directory))) | |
450 (unless to | |
451 (setq to (read-file-name "Copy file to: " default-directory))) | |
452 (when (file-directory-p to) | |
453 (setq to (concat (file-name-as-directory to) | |
454 (file-name-nondirectory file)))) | |
455 (copy-file file to)) | |
456 | |
457 (defvar gnus-work-buffer " *gnus work*") | |
458 | |
459 (defun gnus-set-work-buffer () | |
460 "Put point in the empty Gnus work buffer." | |
461 (if (get-buffer gnus-work-buffer) | |
462 (progn | |
463 (set-buffer gnus-work-buffer) | |
464 (erase-buffer)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
465 (set-buffer (gnus-get-buffer-create gnus-work-buffer)) |
17493 | 466 (kill-all-local-variables) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
467 (mm-enable-multibyte))) |
17493 | 468 |
469 (defmacro gnus-group-real-name (group) | |
470 "Find the real name of a foreign newsgroup." | |
471 `(let ((gname ,group)) | |
472 (if (string-match "^[^:]+:" gname) | |
473 (substring gname (match-end 0)) | |
474 gname))) | |
475 | |
476 (defun gnus-make-sort-function (funs) | |
477 "Return a composite sort condition based on the functions in FUNC." | |
478 (cond | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
479 ;; Just a simple function. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
480 ((gnus-functionp funs) funs) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
481 ;; No functions at all. |
17493 | 482 ((null funs) funs) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
483 ;; A list of functions. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
484 ((or (cdr funs) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
485 (listp (car funs))) |
17493 | 486 `(lambda (t1 t2) |
487 ,(gnus-make-sort-function-1 (reverse funs)))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
488 ;; A list containing just one function. |
17493 | 489 (t |
490 (car funs)))) | |
491 | |
492 (defun gnus-make-sort-function-1 (funs) | |
493 "Return a composite sort condition based on the functions in FUNC." | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
494 (let ((function (car funs)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
495 (first 't1) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
496 (last 't2)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
497 (when (consp function) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
498 (cond |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
499 ;; Reversed spec. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
500 ((eq (car function) 'not) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
501 (setq function (cadr function) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
502 first 't2 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
503 last 't1)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
504 ((gnus-functionp function) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
505 ;; Do nothing. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
506 ) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
507 (t |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
508 (error "Invalid sort spec: %s" function)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
509 (if (cdr funs) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
510 `(or (,function ,first ,last) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
511 (and (not (,function ,last ,first)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
512 ,(gnus-make-sort-function-1 (cdr funs)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
513 `(,function ,first ,last)))) |
17493 | 514 |
515 (defun gnus-turn-off-edit-menu (type) | |
516 "Turn off edit menu in `gnus-TYPE-mode-map'." | |
517 (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) | |
518 [menu-bar edit] 'undefined)) | |
519 | |
520 (defun gnus-prin1 (form) | |
521 "Use `prin1' on FORM in the current buffer. | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
522 Bind `print-quoted' and `print-readably' to t while printing." |
17493 | 523 (let ((print-quoted t) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
524 (print-readably t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
525 (print-escape-multibyte nil) |
17493 | 526 print-level print-length) |
527 (prin1 form (current-buffer)))) | |
528 | |
529 (defun gnus-prin1-to-string (form) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
530 "The same as `prin1', but bind `print-quoted' and `print-readably' to t." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
531 (let ((print-quoted t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
532 (print-readably t)) |
17493 | 533 (prin1-to-string form))) |
534 | |
535 (defun gnus-make-directory (directory) | |
536 "Make DIRECTORY (and all its parents) if it doesn't exist." | |
35051
d80c28ab0b86
(nnmail-pathname-coding-system): Defvar when
Dave Love <fx@gnu.org>
parents:
34833
diff
changeset
|
537 (require 'nnmail) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
538 (let ((file-name-coding-system nnmail-pathname-coding-system)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
539 (when (and directory |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
540 (not (file-exists-p directory))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
541 (make-directory directory t))) |
17493 | 542 t) |
543 | |
544 (defun gnus-write-buffer (file) | |
545 "Write the current buffer's contents to FILE." | |
546 ;; Make sure the directory exists. | |
547 (gnus-make-directory (file-name-directory file)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
548 (let ((file-name-coding-system nnmail-pathname-coding-system)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
549 ;; Write the buffer. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
550 (write-region (point-min) (point-max) file nil 'quietly))) |
17493 | 551 |
552 (defun gnus-delete-file (file) | |
553 "Delete FILE if it exists." | |
554 (when (file-exists-p file) | |
555 (delete-file file))) | |
556 | |
557 (defun gnus-strip-whitespace (string) | |
558 "Return STRING stripped of all whitespace." | |
559 (while (string-match "[\r\n\t ]+" string) | |
560 (setq string (replace-match "" t t string))) | |
561 string) | |
562 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
563 (defsubst gnus-put-text-property-excluding-newlines (beg end prop val) |
17493 | 564 "The same as `put-text-property', but don't put this prop on any newlines in the region." |
565 (save-match-data | |
566 (save-excursion | |
567 (save-restriction | |
568 (goto-char beg) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
569 (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
570 (gnus-put-text-property beg (match-beginning 0) prop val) |
17493 | 571 (setq beg (point))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
572 (gnus-put-text-property beg (point) prop val))))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
573 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
574 (defun gnus-put-text-property-excluding-characters-with-faces (beg end |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
575 prop val) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
576 "The same as `put-text-property', but don't put props on characters with the `gnus-face' property." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
577 (let ((b beg)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
578 (while (/= b end) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
579 (when (get-text-property b 'gnus-face) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
580 (setq b (next-single-property-change b 'gnus-face nil end))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
581 (when (/= b end) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
582 (gnus-put-text-property |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
583 b (setq b (next-single-property-change b 'gnus-face nil end)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
584 prop val))))) |
17493 | 585 |
586 ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 | |
587 ;;; The primary idea here is to try to protect internal datastructures | |
588 ;;; from becoming corrupted when the user hits C-g, or if a hook or | |
589 ;;; similar blows up. Often in Gnus multiple tables/lists need to be | |
590 ;;; updated at the same time, or information can be lost. | |
591 | |
592 (defvar gnus-atomic-be-safe t | |
593 "If t, certain operations will be protected from interruption by C-g.") | |
594 | |
595 (defmacro gnus-atomic-progn (&rest forms) | |
596 "Evaluate FORMS atomically, which means to protect the evaluation | |
597 from being interrupted by the user. An error from the forms themselves | |
598 will return without finishing the operation. Since interrupts from | |
599 the user are disabled, it is recommended that only the most minimal | |
600 operations are performed by FORMS. If you wish to assign many | |
601 complicated values atomically, compute the results into temporary | |
602 variables and then do only the assignment atomically." | |
603 `(let ((inhibit-quit gnus-atomic-be-safe)) | |
604 ,@forms)) | |
605 | |
606 (put 'gnus-atomic-progn 'lisp-indent-function 0) | |
607 | |
608 (defmacro gnus-atomic-progn-assign (protect &rest forms) | |
609 "Evaluate FORMS, but insure that the variables listed in PROTECT | |
610 are not changed if anything in FORMS signals an error or otherwise | |
611 non-locally exits. The variables listed in PROTECT are updated atomically. | |
612 It is safe to use gnus-atomic-progn-assign with long computations. | |
613 | |
614 Note that if any of the symbols in PROTECT were unbound, they will be | |
48588 | 615 set to nil on a successful assignment. In case of an error or other |
17493 | 616 non-local exit, it will still be unbound." |
617 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol | |
618 (concat (symbol-name x) | |
619 "-tmp")) | |
620 x)) | |
621 protect)) | |
622 (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x))) | |
623 temp-sym-map)) | |
624 (temp-sym-let (mapcar (lambda (x) (list (car x) | |
625 `(and (boundp ',(cadr x)) | |
626 ,(cadr x)))) | |
627 temp-sym-map)) | |
628 (sym-temp-let sym-temp-map) | |
629 (temp-sym-assign (apply 'append temp-sym-map)) | |
630 (sym-temp-assign (apply 'append sym-temp-map)) | |
631 (result (make-symbol "result-tmp"))) | |
632 `(let (,@temp-sym-let | |
633 ,result) | |
634 (let ,sym-temp-let | |
635 (setq ,result (progn ,@forms)) | |
636 (setq ,@temp-sym-assign)) | |
637 (let ((inhibit-quit gnus-atomic-be-safe)) | |
638 (setq ,@sym-temp-assign)) | |
639 ,result))) | |
640 | |
641 (put 'gnus-atomic-progn-assign 'lisp-indent-function 1) | |
642 ;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) | |
643 | |
644 (defmacro gnus-atomic-setq (&rest pairs) | |
645 "Similar to setq, except that the real symbols are only assigned when | |
646 there are no errors. And when the real symbols are assigned, they are | |
647 done so atomically. If other variables might be changed via side-effect, | |
648 see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq | |
649 with potentially long computations." | |
650 (let ((tpairs pairs) | |
651 syms) | |
652 (while tpairs | |
653 (push (car tpairs) syms) | |
654 (setq tpairs (cddr tpairs))) | |
655 `(gnus-atomic-progn-assign ,syms | |
656 (setq ,@pairs)))) | |
657 | |
658 ;(put 'gnus-atomic-setq 'edebug-form-spec '(body)) | |
659 | |
660 | |
661 ;;; Functions for saving to babyl/mail files. | |
662 | |
663 (defvar rmail-default-rmail-file) | |
664 (defun gnus-output-to-rmail (filename &optional ask) | |
665 "Append the current article to an Rmail file named FILENAME." | |
666 (require 'rmail) | |
667 ;; Most of these codes are borrowed from rmailout.el. | |
668 (setq filename (expand-file-name filename)) | |
669 (setq rmail-default-rmail-file filename) | |
670 (let ((artbuf (current-buffer)) | |
671 (tmpbuf (get-buffer-create " *Gnus-output*"))) | |
672 (save-excursion | |
673 (or (get-file-buffer filename) | |
674 (file-exists-p filename) | |
675 (if (or (not ask) | |
676 (gnus-yes-or-no-p | |
677 (concat "\"" filename "\" does not exist, create it? "))) | |
678 (let ((file-buffer (create-file-buffer filename))) | |
679 (save-excursion | |
680 (set-buffer file-buffer) | |
681 (rmail-insert-rmail-file-header) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
682 (let ((require-final-newline nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
683 (coding-system-for-write mm-text-coding-system)) |
17493 | 684 (gnus-write-buffer filename))) |
685 (kill-buffer file-buffer)) | |
686 (error "Output file does not exist"))) | |
687 (set-buffer tmpbuf) | |
688 (erase-buffer) | |
689 (insert-buffer-substring artbuf) | |
690 (gnus-convert-article-to-rmail) | |
691 ;; Decide whether to append to a file or to an Emacs buffer. | |
692 (let ((outbuf (get-file-buffer filename))) | |
693 (if (not outbuf) | |
38861
f8833aa83b5e
* gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35051
diff
changeset
|
694 (let ((file-name-coding-system nnmail-pathname-coding-system)) |
f8833aa83b5e
* gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35051
diff
changeset
|
695 (mm-append-to-file (point-min) (point-max) filename)) |
17493 | 696 ;; File has been visited, in buffer OUTBUF. |
697 (set-buffer outbuf) | |
698 (let ((buffer-read-only nil) | |
699 (msg (and (boundp 'rmail-current-message) | |
700 (symbol-value 'rmail-current-message)))) | |
701 ;; If MSG is non-nil, buffer is in RMAIL mode. | |
702 (when msg | |
703 (widen) | |
704 (narrow-to-region (point-max) (point-max))) | |
705 (insert-buffer-substring tmpbuf) | |
706 (when msg | |
707 (goto-char (point-min)) | |
708 (widen) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
709 (search-backward "\n\^_") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
710 (narrow-to-region (point) (point-max)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
711 (rmail-count-new-messages t) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
712 (when (rmail-summary-exists) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
713 (rmail-select-summary |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
714 (rmail-update-summary))) |
17493 | 715 (rmail-count-new-messages t) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
716 (rmail-show-message msg)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
717 (save-buffer))))) |
17493 | 718 (kill-buffer tmpbuf))) |
719 | |
720 (defun gnus-output-to-mail (filename &optional ask) | |
721 "Append the current article to a mail file named FILENAME." | |
722 (setq filename (expand-file-name filename)) | |
723 (let ((artbuf (current-buffer)) | |
724 (tmpbuf (get-buffer-create " *Gnus-output*"))) | |
725 (save-excursion | |
726 ;; Create the file, if it doesn't exist. | |
727 (when (and (not (get-file-buffer filename)) | |
728 (not (file-exists-p filename))) | |
729 (if (or (not ask) | |
730 (gnus-y-or-n-p | |
731 (concat "\"" filename "\" does not exist, create it? "))) | |
732 (let ((file-buffer (create-file-buffer filename))) | |
733 (save-excursion | |
734 (set-buffer file-buffer) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
735 (let ((require-final-newline nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
736 (coding-system-for-write mm-text-coding-system)) |
17493 | 737 (gnus-write-buffer filename))) |
738 (kill-buffer file-buffer)) | |
739 (error "Output file does not exist"))) | |
740 (set-buffer tmpbuf) | |
741 (erase-buffer) | |
742 (insert-buffer-substring artbuf) | |
743 (goto-char (point-min)) | |
744 (if (looking-at "From ") | |
745 (forward-line 1) | |
746 (insert "From nobody " (current-time-string) "\n")) | |
747 (let (case-fold-search) | |
748 (while (re-search-forward "^From " nil t) | |
749 (beginning-of-line) | |
750 (insert ">"))) | |
751 ;; Decide whether to append to a file or to an Emacs buffer. | |
752 (let ((outbuf (get-file-buffer filename))) | |
753 (if (not outbuf) | |
754 (let ((buffer-read-only nil)) | |
755 (save-excursion | |
756 (goto-char (point-max)) | |
757 (forward-char -2) | |
758 (unless (looking-at "\n\n") | |
759 (goto-char (point-max)) | |
760 (unless (bolp) | |
761 (insert "\n")) | |
762 (insert "\n")) | |
763 (goto-char (point-max)) | |
38861
f8833aa83b5e
* gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35051
diff
changeset
|
764 (let ((file-name-coding-system nnmail-pathname-coding-system)) |
f8833aa83b5e
* gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
35051
diff
changeset
|
765 (mm-append-to-file (point-min) (point-max) filename)))) |
17493 | 766 ;; File has been visited, in buffer OUTBUF. |
767 (set-buffer outbuf) | |
768 (let ((buffer-read-only nil)) | |
769 (goto-char (point-max)) | |
770 (unless (eobp) | |
771 (insert "\n")) | |
772 (insert "\n") | |
773 (insert-buffer-substring tmpbuf))))) | |
774 (kill-buffer tmpbuf))) | |
775 | |
776 (defun gnus-convert-article-to-rmail () | |
777 "Convert article in current buffer to Rmail message format." | |
778 (let ((buffer-read-only nil)) | |
779 ;; Convert article directly into Babyl format. | |
780 (goto-char (point-min)) | |
781 (insert "\^L\n0, unseen,,\n*** EOOH ***\n") | |
782 (while (search-forward "\n\^_" nil t) ;single char | |
783 (replace-match "\n^_" t t)) ;2 chars: "^" and "_" | |
784 (goto-char (point-max)) | |
785 (insert "\^_"))) | |
786 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
787 (defun gnus-map-function (funs arg) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
788 "Applies the result of the first function in FUNS to the second, and so on. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
789 ARG is passed to the first function." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
790 (let ((myfuns funs)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
791 (while myfuns |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
792 (setq arg (funcall (pop myfuns) arg))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
793 arg)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
794 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
795 (defun gnus-run-hooks (&rest funcs) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
796 "Does the same as `run-hooks', but saves excursion." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
797 (let ((buf (current-buffer))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
798 (unwind-protect |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
799 (apply 'run-hooks funcs) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
800 (set-buffer buf)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
801 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
802 ;;; |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
803 ;;; .netrc and .authinforc parsing |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
804 ;;; |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
805 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
806 (defun gnus-parse-netrc (file) |
47938
65eaf21a0a44
(gnus-parse-netrc): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
41494
diff
changeset
|
807 "Parse FILE and return a list of all entries in the file." |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
808 (when (file-exists-p file) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
809 (with-temp-buffer |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
810 (let ((tokens '("machine" "default" "login" |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
811 "password" "account" "macdef" "force" |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
812 "port")) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
813 alist elem result pair) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
814 (insert-file-contents file) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
815 (goto-char (point-min)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
816 ;; Go through the file, line by line. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
817 (while (not (eobp)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
818 (narrow-to-region (point) (gnus-point-at-eol)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
819 ;; For each line, get the tokens and values. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
820 (while (not (eobp)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
821 (skip-chars-forward "\t ") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
822 ;; Skip lines that begin with a "#". |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
823 (if (eq (char-after) ?#) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
824 (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
825 (unless (eobp) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
826 (setq elem |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
827 (if (= (following-char) ?\") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
828 (read (current-buffer)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
829 (buffer-substring |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
830 (point) (progn (skip-chars-forward "^\t ") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
831 (point))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
832 (cond |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
833 ((equal elem "macdef") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
834 ;; We skip past the macro definition. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
835 (widen) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
836 (while (and (zerop (forward-line 1)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
837 (looking-at "$"))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
838 (narrow-to-region (point) (point))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
839 ((member elem tokens) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
840 ;; Tokens that don't have a following value are ignored, |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
841 ;; except "default". |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
842 (when (and pair (or (cdr pair) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
843 (equal (car pair) "default"))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
844 (push pair alist)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
845 (setq pair (list elem))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
846 (t |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
847 ;; Values that haven't got a preceding token are ignored. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
848 (when pair |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
849 (setcdr pair elem) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
850 (push pair alist) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
851 (setq pair nil))))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
852 (when alist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
853 (push (nreverse alist) result)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
854 (setq alist nil |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
855 pair nil) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
856 (widen) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
857 (forward-line 1)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
858 (nreverse result))))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
859 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
860 (defun gnus-netrc-machine (list machine &optional port defaultport) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
861 "Return the netrc values from LIST for MACHINE or for the default entry. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
862 If PORT specified, only return entries with matching port tokens. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
863 Entries without port tokens default to DEFAULTPORT." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
864 (let ((rest list) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
865 result) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
866 (while list |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
867 (when (equal (cdr (assoc "machine" (car list))) machine) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
868 (push (car list) result)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
869 (pop list)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
870 (unless result |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
871 ;; No machine name matches, so we look for default entries. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
872 (while rest |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
873 (when (assoc "default" (car rest)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
874 (push (car rest) result)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
875 (pop rest))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
876 (when result |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
877 (setq result (nreverse result)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
878 (while (and result |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
879 (not (equal (or port defaultport "nntp") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
880 (or (gnus-netrc-get (car result) "port") |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
881 defaultport "nntp")))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
882 (pop result)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
883 (car result)))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
884 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
885 (defun gnus-netrc-get (alist type) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
886 "Return the value of token TYPE from ALIST." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
887 (cdr (assoc type alist))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
888 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
889 ;;; Various |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
890 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
891 (defvar gnus-group-buffer) ; Compiler directive |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
892 (defun gnus-alive-p () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
893 "Say whether Gnus is running or not." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
894 (and (boundp 'gnus-group-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
895 (get-buffer gnus-group-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
896 (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
897 (set-buffer gnus-group-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
898 (eq major-mode 'gnus-group-mode)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
899 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
900 (defun gnus-remove-duplicates (list) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
901 (let (new (tail list)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
902 (while tail |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
903 (or (member (car tail) new) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
904 (setq new (cons (car tail) new))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
905 (setq tail (cdr tail))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
906 (nreverse new))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
907 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
908 (defun gnus-delete-if (predicate list) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
909 "Delete elements from LIST that satisfy PREDICATE." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
910 (let (out) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
911 (while list |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
912 (unless (funcall predicate (car list)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
913 (push (car list) out)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
914 (pop list)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
915 (nreverse out))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
916 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
917 (defun gnus-delete-alist (key alist) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
918 "Delete all entries in ALIST that have a key eq to KEY." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
919 (let (entry) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
920 (while (setq entry (assq key alist)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
921 (setq alist (delq entry alist))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
922 alist)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
923 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
924 (defmacro gnus-pull (key alist &optional assoc-p) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
925 "Modify ALIST to be without KEY." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
926 (unless (symbolp alist) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
927 (error "Not a symbol: %s" alist)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
928 (let ((fun (if assoc-p 'assoc 'assq))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
929 `(setq ,alist (delq (,fun ,key ,alist) ,alist)))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
930 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
931 (defun gnus-globalify-regexp (re) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
932 "Returns a regexp that matches a whole line, iff RE matches a part of it." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
933 (concat (unless (string-match "^\\^" re) "^.*") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
934 re |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
935 (unless (string-match "\\$$" re) ".*$"))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
936 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
937 (defun gnus-set-window-start (&optional point) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
938 "Set the window start to POINT, or (point) if nil." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
939 (let ((win (get-buffer-window (current-buffer) t))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
940 (when win |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
941 (set-window-start win (or point (point)))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
942 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
943 (defun gnus-annotation-in-region-p (b e) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
944 (if (= b e) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
945 (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
946 (text-property-any b e 'gnus-undeletable t))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
947 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
948 (defun gnus-or (&rest elems) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
949 "Return non-nil if any of the elements are non-nil." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
950 (catch 'found |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
951 (while elems |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
952 (when (pop elems) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
953 (throw 'found t))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
954 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
955 (defun gnus-and (&rest elems) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
956 "Return non-nil if all of the elements are non-nil." |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
957 (catch 'found |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
958 (while elems |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
959 (unless (pop elems) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
960 (throw 'found nil))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
961 t)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
962 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
963 (defun gnus-write-active-file (file hashtb &optional full-names) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
964 (let ((coding-system-for-write nnmail-active-file-coding-system)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
965 (with-temp-file file |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
966 (mapatoms |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
967 (lambda (sym) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
968 (when (and sym |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
969 (boundp sym) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
970 (symbol-value sym)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
971 (insert (format "%S %d %d y\n" |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
972 (if full-names |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
973 sym |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
974 (intern (gnus-group-real-name (symbol-name sym)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
975 (or (cdr (symbol-value sym)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
976 (car (symbol-value sym))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
977 (car (symbol-value sym)))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
978 hashtb) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
979 (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
980 (while (search-backward "\\." nil t) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
981 (delete-char 1))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
982 |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
983 (defun gnus-add-text-properties-when |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
984 (property value start end properties &optional object) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
985 "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE." |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
986 (let (point) |
47938
65eaf21a0a44
(gnus-parse-netrc): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
41494
diff
changeset
|
987 (while (and start |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
988 (setq point (text-property-not-all start end property value))) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
989 (gnus-add-text-properties start point properties object) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
990 (setq start (text-property-any point end property value))) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
991 (if start |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
992 (gnus-add-text-properties start end properties object)))) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
993 |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
994 (defun gnus-remove-text-properties-when |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
995 (property value start end properties &optional object) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
996 "Like `remove-text-properties', only applied on where PROPERTY is VALUE." |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
997 (let (point) |
47938
65eaf21a0a44
(gnus-parse-netrc): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
41494
diff
changeset
|
998 (while (and start |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
999 (setq point (text-property-not-all start end property value))) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1000 (remove-text-properties start point properties object) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1001 (setq start (text-property-any point end property value))) |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1002 (if start |
34833
aaf69bc74739
* gnus-art.el (gnus-article-check-hidden-text): Return t.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34727
diff
changeset
|
1003 (remove-text-properties start end properties object)) |
aaf69bc74739
* gnus-art.el (gnus-article-check-hidden-text): Return t.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34727
diff
changeset
|
1004 t)) |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1005 |
41494
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1006 (defvar gnus-directory-sep-char-regexp "/" |
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1007 "The regexp of directory separator character. |
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1008 If you find some problem with the directory separator character, try |
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1009 \"[/\\\\\]\" for some systems.") |
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1010 |
17493 | 1011 (provide 'gnus-util) |
1012 | |
1013 ;;; gnus-util.el ends here |