Mercurial > emacs
annotate lisp/gnus/gnus-util.el @ 104806:409fc58fd03d
Pass no argument to gnus-float-time rather than current-time.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 02 Sep 2009 06:38:07 +0000 |
parents | 6a1f7b318ddf |
children | 18c2aea5083c |
rev | line source |
---|---|
17493 | 1 ;;; gnus-util.el --- utility functions for Gnus |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64631
diff
changeset
|
2 |
68633
1077b8039c32
Update copyright notices of all files in the gnus directory.
Romain Francoise <romain@orebokech.com>
parents:
68606
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
100908 | 4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
17493 | 7 ;; Keywords: news |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17493 | 12 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
17493 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
17493 | 19 ;; GNU General Public License for more details. |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17493 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;; Nothing in this file depends on any other parts of Gnus -- all | |
27 ;; functions and macros in this file are utility functions that are | |
28 ;; used by Gnus and may be used by any other package without loading | |
29 ;; Gnus first. | |
30 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
31 ;; [Unfortunately, it does depend on other parts of Gnus, e.g. the |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
32 ;; autoloads and defvars below...] |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
33 |
17493 | 34 ;;; Code: |
35 | |
87190
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
36 ;; For Emacs < 22.2. |
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
37 (eval-and-compile |
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
38 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) |
35051
d80c28ab0b86
(nnmail-pathname-coding-system): Defvar when
Dave Love <fx@gnu.org>
parents:
34833
diff
changeset
|
39 (eval-when-compile |
86154 | 40 (require 'cl)) |
41 ;; Fixme: this should be a gnus variable, not nnmail-. | |
42 (defvar nnmail-pathname-coding-system) | |
43 (defvar nnmail-active-file-coding-system) | |
57617
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
44 |
86154 | 45 ;; Inappropriate references to other parts of Gnus. |
46 (defvar gnus-emphasize-whitespace-regexp) | |
47 (defvar gnus-original-article-buffer) | |
48 (defvar gnus-user-agent) | |
49 | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
50 (require 'time-date) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
51 (require 'netrc) |
17493 | 52 |
95812 | 53 (autoload 'message-fetch-field "message") |
54 (autoload 'gnus-get-buffer-window "gnus-win") | |
55 (autoload 'nnheader-narrow-to-headers "nnheader") | |
56 (autoload 'nnheader-replace-chars-in-string "nnheader") | |
98376
473a8358e3b6
(mail-header-remove-comments): Autoload it.
Glenn Morris <rgm@gnu.org>
parents:
98366
diff
changeset
|
57 (autoload 'mail-header-remove-comments "mail-parse") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
58 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
59 (eval-and-compile |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
60 (cond |
70146
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
61 ;; Prefer `replace-regexp-in-string' (present in Emacs, XEmacs 21.5, |
95588 | 62 ;; SXEmacs 22.1.4) over `replace-in-string'. The latter leads to inf-loops |
70146
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
63 ;; on empty matches: |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
64 ;; (replace-in-string "foo" "/*$" "/") |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
65 ;; (replace-in-string "xe" "\\(x\\)?" "") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
66 ((fboundp 'replace-regexp-in-string) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
67 (defun gnus-replace-in-string (string regexp newtext &optional literal) |
58835
9bdd97960431
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Miles Bader <miles@gnu.org>
parents:
57617
diff
changeset
|
68 "Replace all matches for REGEXP with NEWTEXT in STRING. |
9bdd97960431
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Miles Bader <miles@gnu.org>
parents:
57617
diff
changeset
|
69 If LITERAL is non-nil, insert NEWTEXT literally. Return a new |
9bdd97960431
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Miles Bader <miles@gnu.org>
parents:
57617
diff
changeset
|
70 string containing the replacements. |
9bdd97960431
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Miles Bader <miles@gnu.org>
parents:
57617
diff
changeset
|
71 |
9bdd97960431
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-716
Miles Bader <miles@gnu.org>
parents:
57617
diff
changeset
|
72 This is a compatibility function for different Emacsen." |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
73 (replace-regexp-in-string regexp newtext string nil literal))) |
70146
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
74 ((fboundp 'replace-in-string) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
75 (defalias 'gnus-replace-in-string 'replace-in-string)))) |
17493 | 76 |
77 (defun gnus-boundp (variable) | |
78 "Return non-nil if VARIABLE is bound and non-nil." | |
79 (and (boundp variable) | |
80 (symbol-value variable))) | |
81 | |
82 (defmacro gnus-eval-in-buffer-window (buffer &rest forms) | |
83 "Pop to BUFFER, evaluate FORMS, and then return to the original window." | |
84 (let ((tempvar (make-symbol "GnusStartBufferWindow")) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
85 (w (make-symbol "w")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
86 (buf (make-symbol "buf"))) |
17493 | 87 `(let* ((,tempvar (selected-window)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
88 (,buf ,buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
89 (,w (gnus-get-buffer-window ,buf 'visible))) |
17493 | 90 (unwind-protect |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
91 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
92 (if ,w |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
93 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
94 (select-window ,w) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
95 (set-buffer (window-buffer ,w))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
96 (pop-to-buffer ,buf)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
97 ,@forms) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
98 (select-window ,tempvar))))) |
17493 | 99 |
100 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) | |
101 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) | |
102 | |
103 (defmacro gnus-intern-safe (string hashtable) | |
76650 | 104 "Get hash value. Arguments are STRING and HASHTABLE." |
17493 | 105 `(let ((symbol (intern ,string ,hashtable))) |
106 (or (boundp symbol) | |
107 (set symbol nil)) | |
108 symbol)) | |
109 | |
110 (defsubst gnus-goto-char (point) | |
111 (and point (goto-char point))) | |
112 | |
113 (defmacro gnus-buffer-exists-p (buffer) | |
114 `(let ((buffer ,buffer)) | |
115 (when buffer | |
116 (funcall (if (stringp buffer) 'get-buffer 'buffer-name) | |
117 buffer)))) | |
118 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
119 ;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
120 ;; XEmacs. In Emacs we don't need to call `make-local-hook' first. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
121 ;; It's harmless, though, so the main purpose of this alias is to shut |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
122 ;; up the byte compiler. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
123 (defalias 'gnus-make-local-hook |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
124 (if (eq (get 'make-local-hook 'byte-compile) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
125 'byte-compile-obsolete) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
126 'ignore ; Emacs |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
127 'make-local-hook)) ; XEmacs |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
128 |
17493 | 129 (defun gnus-delete-first (elt list) |
130 "Delete by side effect the first occurrence of ELT as a member of LIST." | |
131 (if (equal (car list) elt) | |
132 (cdr list) | |
133 (let ((total list)) | |
134 (while (and (cdr list) | |
135 (not (equal (cadr list) elt))) | |
136 (setq list (cdr list))) | |
137 (when (cdr list) | |
138 (setcdr list (cddr list))) | |
139 total))) | |
140 | |
141 ;; Delete the current line (and the next N lines). | |
142 (defmacro gnus-delete-line (&optional n) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
143 `(delete-region (point-at-bol) |
17493 | 144 (progn (forward-line ,(or n 1)) (point)))) |
145 | |
146 (defun gnus-byte-code (func) | |
147 "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
|
148 (let ((fval (indirect-function func))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
149 (if (byte-code-function-p fval) |
17493 | 150 (let ((flist (append fval nil))) |
151 (setcar flist 'byte-code) | |
152 flist) | |
153 (cons 'progn (cddr fval))))) | |
154 | |
155 (defun gnus-extract-address-components (from) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
156 "Extract address components from a From header. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
157 Given an RFC-822 address FROM, extract full name and canonical address. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
158 Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
159 solution than `mail-extract-address-components', which works much better, but |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
160 is slower." |
17493 | 161 (let (name address) |
162 ;; First find the address - the thing with the @ in it. This may | |
163 ;; not be accurate in mail addresses, but does the trick most of | |
164 ;; the time in news messages. | |
74021 | 165 (cond (;; Check ``<foo@bar>'' first in order to handle the quite common |
166 ;; form ``"abc@xyz" <foo@bar>'' (i.e. ``@'' as part of a comment) | |
167 ;; correctly. | |
168 (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from) | |
169 (setq address (substring from (match-beginning 1) (match-end 1)))) | |
170 ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) | |
171 (setq address (substring from (match-beginning 0) (match-end 0))))) | |
17493 | 172 ;; Then we check whether the "name <address>" format is used. |
173 (and address | |
174 ;; Linear white space is not required. | |
175 (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) | |
176 (and (setq name (substring from 0 (match-beginning 0))) | |
177 ;; Strip any quotes from the name. | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
178 (string-match "^\".*\"$" name) |
17493 | 179 (setq name (substring name 1 (1- (match-end 0)))))) |
180 ;; If not, then "address (name)" is used. | |
181 (or name | |
182 (and (string-match "(.+)" from) | |
183 (setq name (substring from (1+ (match-beginning 0)) | |
184 (1- (match-end 0))))) | |
185 (and (string-match "()" from) | |
186 (setq name address)) | |
187 ;; XOVER might not support folded From headers. | |
188 (and (string-match "(.*" from) | |
189 (setq name (substring from (1+ (match-beginning 0)) | |
190 (match-end 0))))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
191 (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
|
192 |
94748 | 193 (defun gnus-extract-address-component-name (from) |
194 "Extract name from a From header. | |
195 Uses `gnus-extract-address-components'." | |
196 (nth 0 (gnus-extract-address-components from))) | |
197 | |
198 (defun gnus-extract-address-component-email (from) | |
199 "Extract e-mail address from a From header. | |
200 Uses `gnus-extract-address-components'." | |
201 (nth 1 (gnus-extract-address-components from))) | |
17493 | 202 |
203 (defun gnus-fetch-field (field) | |
204 "Return the value of the header FIELD of current article." | |
205 (save-excursion | |
206 (save-restriction | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
207 (let ((inhibit-point-motion-hooks t)) |
17493 | 208 (nnheader-narrow-to-headers) |
209 (message-fetch-field field))))) | |
210 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
211 (defun gnus-fetch-original-field (field) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
212 "Fetch FIELD from the original version of the current article." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
213 (with-current-buffer gnus-original-article-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
214 (gnus-fetch-field field))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
215 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
216 |
17493 | 217 (defun gnus-goto-colon () |
218 (beginning-of-line) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
219 (let ((eol (point-at-eol))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
220 (goto-char (or (text-property-any (point) eol 'gnus-position t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
221 (search-forward ":" eol t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
222 (point))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
223 |
87263
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
224 (declare-function gnus-find-method-for-group "gnus" (group &optional info)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
225 (autoload 'gnus-group-name-decode "gnus-group") |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
226 (declare-function gnus-group-name-charset "gnus-group" (method group)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
227 ;; gnus-group requires gnus-int which requires message. |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
228 (declare-function message-tokenize-header "message" |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
229 (header &optional separator)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
230 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
231 (defun gnus-decode-newsgroups (newsgroups group &optional method) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
232 (let ((method (or method (gnus-find-method-for-group group)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
233 (mapconcat (lambda (group) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
234 (gnus-group-name-decode group (gnus-group-name-charset |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
235 method group))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
236 (message-tokenize-header newsgroups) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
237 ","))) |
17493 | 238 |
239 (defun gnus-remove-text-with-property (prop) | |
240 "Delete all text in the current buffer with text property PROP." | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
241 (let ((start (point-min)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
242 end) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
243 (unless (get-text-property start prop) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
244 (setq start (next-single-property-change start prop))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
245 (while start |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
246 (setq end (text-property-any start (point-max) prop nil)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
247 (delete-region start (or end (point-max))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
248 (setq start (when end |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
249 (next-single-property-change start prop)))))) |
17493 | 250 |
251 (defun gnus-newsgroup-directory-form (newsgroup) | |
252 "Make hierarchical directory name from NEWSGROUP name." | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
253 (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
254 (idx (string-match ":" newsgroup))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
255 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
256 (if idx (substring newsgroup 0 idx)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
257 (if idx "/") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
258 (nnheader-replace-chars-in-string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
259 (if idx (substring newsgroup (1+ idx)) newsgroup) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
260 ?. ?/)))) |
17493 | 261 |
262 (defun gnus-newsgroup-savable-name (group) | |
263 ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) | |
264 ;; with dots. | |
265 (nnheader-replace-chars-in-string group ?/ ?.)) | |
266 | |
267 (defun gnus-string> (s1 s2) | |
268 (not (or (string< s1 s2) | |
269 (string= s1 s2)))) | |
270 | |
79143 | 271 (defun gnus-string< (s1 s2) |
272 "Return t if first arg string is less than second in lexicographic order. | |
273 Case is significant if and only if `case-fold-search' is nil. | |
274 Symbols are also allowed; their print names are used instead." | |
275 (if case-fold-search | |
276 (string-lessp (downcase (if (symbolp s1) (symbol-name s1) s1)) | |
277 (downcase (if (symbolp s2) (symbol-name s2) s2))) | |
278 (string-lessp s1 s2))) | |
279 | |
17493 | 280 ;;; Time functions. |
281 | |
282 (defun gnus-file-newer-than (file date) | |
283 (let ((fdate (nth 5 (file-attributes file)))) | |
284 (or (> (car fdate) (car date)) | |
285 (and (= (car fdate) (car date)) | |
286 (> (nth 1 fdate) (nth 1 date)))))) | |
287 | |
104804
6a1f7b318ddf
(gnus-float-time): Make TIME optional, defaulting to current-time.
Glenn Morris <rgm@gnu.org>
parents:
104802
diff
changeset
|
288 (defun gnus-float-time (&optional time) |
6a1f7b318ddf
(gnus-float-time): Make TIME optional, defaulting to current-time.
Glenn Morris <rgm@gnu.org>
parents:
104802
diff
changeset
|
289 "Convert time value TIME to a floating point number. |
6a1f7b318ddf
(gnus-float-time): Make TIME optional, defaulting to current-time.
Glenn Morris <rgm@gnu.org>
parents:
104802
diff
changeset
|
290 TIME defaults to the current time." |
104802
0b94fa0fdedb
(gnus-float-time): New function.
Glenn Morris <rgm@gnu.org>
parents:
102044
diff
changeset
|
291 (if (featurep 'xemacs) |
104804
6a1f7b318ddf
(gnus-float-time): Make TIME optional, defaulting to current-time.
Glenn Morris <rgm@gnu.org>
parents:
104802
diff
changeset
|
292 (time-to-seconds (or time (current-time))) |
104802
0b94fa0fdedb
(gnus-float-time): New function.
Glenn Morris <rgm@gnu.org>
parents:
102044
diff
changeset
|
293 (float-time time))) |
0b94fa0fdedb
(gnus-float-time): New function.
Glenn Morris <rgm@gnu.org>
parents:
102044
diff
changeset
|
294 |
17493 | 295 ;;; Keymap macros. |
296 | |
297 (defmacro gnus-local-set-keys (&rest plist) | |
298 "Set the keys in PLIST in the current keymap." | |
299 `(gnus-define-keys-1 (current-local-map) ',plist)) | |
300 | |
301 (defmacro gnus-define-keys (keymap &rest plist) | |
302 "Define all keys in PLIST in KEYMAP." | |
303 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) | |
304 | |
305 (defmacro gnus-define-keys-safe (keymap &rest plist) | |
306 "Define all keys in PLIST in KEYMAP without overwriting previous definitions." | |
307 `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) | |
308 | |
309 (put 'gnus-define-keys 'lisp-indent-function 1) | |
310 (put 'gnus-define-keys-safe 'lisp-indent-function 1) | |
311 (put 'gnus-local-set-keys 'lisp-indent-function 1) | |
312 | |
313 (defmacro gnus-define-keymap (keymap &rest plist) | |
314 "Define all keys in PLIST in KEYMAP." | |
315 `(gnus-define-keys-1 ,keymap (quote ,plist))) | |
316 | |
317 (put 'gnus-define-keymap 'lisp-indent-function 1) | |
318 | |
319 (defun gnus-define-keys-1 (keymap plist &optional safe) | |
320 (when (null keymap) | |
321 (error "Can't set keys in a null keymap")) | |
322 (cond ((symbolp keymap) | |
323 (setq keymap (symbol-value keymap))) | |
324 ((keymapp keymap)) | |
325 ((listp keymap) | |
326 (set (car keymap) nil) | |
327 (define-prefix-command (car keymap)) | |
328 (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) | |
329 (setq keymap (symbol-value (car keymap))))) | |
330 (let (key) | |
331 (while plist | |
332 (when (symbolp (setq key (pop plist))) | |
333 (setq key (symbol-value key))) | |
334 (if (or (not safe) | |
335 (eq (lookup-key keymap key) 'undefined)) | |
336 (define-key keymap key (pop plist)) | |
337 (pop plist))))) | |
338 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
339 (defun gnus-completing-read-with-default (default prompt &rest args) |
17493 | 340 ;; Like `completing-read', except that DEFAULT is the default argument. |
341 (let* ((prompt (if default | |
65682
c16795de963a
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
65342
diff
changeset
|
342 (concat prompt " (default " default "): ") |
c16795de963a
2005-09-24 Emilio C. Lopes <eclig@gmx.net>
Romain Francoise <romain@orebokech.com>
parents:
65342
diff
changeset
|
343 (concat prompt ": "))) |
17493 | 344 (answer (apply 'completing-read prompt args))) |
345 (if (or (null answer) (zerop (length answer))) | |
346 default | |
347 answer))) | |
348 | |
349 ;; Two silly functions to ensure that all `y-or-n-p' questions clear | |
350 ;; the echo area. | |
87300 | 351 ;; |
92147 | 352 ;; Do we really need these functions? Workarounds for bugs in the corresponding |
353 ;; Emacs functions? Maybe these bugs are no longer present in any supported | |
87300 | 354 ;; (X)Emacs version? Alias them to the original functions and see if anyone |
92147 | 355 ;; reports a problem. If not, replace with original functions. --rsteib, |
356 ;; 2007-12-14 | |
357 ;; | |
358 ;; All supported Emacsen clear the echo area after `yes-or-no-p', so we can | |
359 ;; remove `yes-or-no-p'. RMS says that not clearing after `y-or-n-p' is | |
360 ;; intentional (see below), so we could remove `gnus-y-or-n-p' too. | |
361 ;; Objections? --rsteib, 2008-02-16 | |
87300 | 362 ;; |
92147 | 363 ;; ,----[ http://thread.gmane.org/gmane.emacs.gnus.general/65099/focus=66070 ] |
364 ;; | From: Richard Stallman | |
365 ;; | Subject: Re: Do we need gnus-yes-or-no-p and gnus-y-or-n-p? | |
366 ;; | To: Katsumi Yamaoka [...] | |
367 ;; | Cc: emacs-devel@[...], xemacs-beta@[...], ding@[...] | |
368 ;; | Date: Mon, 07 Jan 2008 12:16:05 -0500 | |
369 ;; | Message-ID: <E1JBva1-000528-VY@fencepost.gnu.org> | |
370 ;; | | |
371 ;; | The behavior of `y-or-n-p' that it doesn't clear the question | |
372 ;; | and the answer is not serious of course, but I feel it is not | |
373 ;; | cool. | |
374 ;; | | |
375 ;; | It is intentional. | |
376 ;; | | |
377 ;; | Currently, it is commented out in the trunk by Reiner Steib. He | |
378 ;; | also wrote the benefit of leaving the question and the answer in | |
379 ;; | the echo area as follows: | |
380 ;; | | |
381 ;; | (http://article.gmane.org/gmane.emacs.gnus.general/66061) | |
382 ;; | > In contrast to yes-or-no-p it is much easier to type y, n, | |
383 ;; | > SPC, DEL, etc accidentally, so it might be useful for the user | |
384 ;; | > to see what he has typed. | |
385 ;; | | |
386 ;; | Yes, that is the reason. | |
387 ;; `---- | |
388 | |
87300 | 389 ;; (defun gnus-y-or-n-p (prompt) |
390 ;; (prog1 | |
391 ;; (y-or-n-p prompt) | |
392 ;; (message ""))) | |
393 ;; (defun gnus-yes-or-no-p (prompt) | |
394 ;; (prog1 | |
395 ;; (yes-or-no-p prompt) | |
396 ;; (message ""))) | |
17493 | 397 |
87300 | 398 (defalias 'gnus-y-or-n-p 'y-or-n-p) |
399 (defalias 'gnus-yes-or-no-p 'yes-or-no-p) | |
17493 | 400 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
401 ;; By Frank Schmitt <ich@Frank-Schmitt.net>. Allows to have |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
402 ;; age-depending date representations. (e.g. just the time if it's |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
403 ;; from today, the day of the week if it's within the last 7 days and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
404 ;; the full date if it's older) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
405 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
406 (defun gnus-seconds-today () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
407 "Return the number of seconds passed today." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
408 (let ((now (decode-time (current-time)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
409 (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
410 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
411 (defun gnus-seconds-month () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
412 "Return the number of seconds passed this month." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
413 (let ((now (decode-time (current-time)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
414 (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
415 (* (- (car (nthcdr 3 now)) 1) 3600 24)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
416 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
417 (defun gnus-seconds-year () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
418 "Return the number of seconds passed this year." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
419 (let ((now (decode-time (current-time))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
420 (days (format-time-string "%j" (current-time)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
421 (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
422 (* (- (string-to-number days) 1) 3600 24)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
423 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
424 (defvar gnus-user-date-format-alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
425 '(((gnus-seconds-today) . "%k:%M") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
426 (604800 . "%a %k:%M") ;;that's one week |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
427 ((gnus-seconds-month) . "%a %d") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
428 ((gnus-seconds-year) . "%b %d") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
429 (t . "%b %d '%y")) ;;this one is used when no |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
430 ;;other does match |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
431 "Specifies date format depending on age of article. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
432 This is an alist of items (AGE . FORMAT). AGE can be a number (of |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
433 seconds) or a Lisp expression evaluating to a number. When the age of |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
434 the article is less than this number, then use `format-time-string' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
435 with the corresponding FORMAT for displaying the date of the article. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
436 If AGE is not a number or a Lisp expression evaluating to a |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
437 non-number, then the corresponding FORMAT is used as a default value. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
438 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
439 Note that the list is processed from the beginning, so it should be |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
440 sorted by ascending AGE. Also note that items following the first |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
441 non-number AGE will be ignored. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
442 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
443 You can use the functions `gnus-seconds-today', `gnus-seconds-month' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
444 and `gnus-seconds-year' in the AGE spec. They return the number of |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
445 seconds passed since the start of today, of this month, of this year, |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
446 respectively.") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
447 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
448 (defun gnus-user-date (messy-date) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
449 "Format the messy-date according to gnus-user-date-format-alist. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
450 Returns \" ? \" if there's bad input or if an other error occurs. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
451 Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
452 (condition-case () |
104802
0b94fa0fdedb
(gnus-float-time): New function.
Glenn Morris <rgm@gnu.org>
parents:
102044
diff
changeset
|
453 (let* ((messy-date (gnus-float-time (safe-date-to-time messy-date))) |
104806
409fc58fd03d
Pass no argument to gnus-float-time rather than current-time.
Glenn Morris <rgm@gnu.org>
parents:
104804
diff
changeset
|
454 (now (gnus-float-time)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
455 ;;If we don't find something suitable we'll use this one |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
456 (my-format "%b %d '%y")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
457 (let* ((difference (- now messy-date)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
458 (templist gnus-user-date-format-alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
459 (top (eval (caar templist)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
460 (while (if (numberp top) (< top difference) (not top)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
461 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
462 (setq templist (cdr templist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
463 (setq top (eval (caar templist))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
464 (if (stringp (cdr (car templist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
465 (setq my-format (cdr (car templist))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
466 (format-time-string (eval my-format) (seconds-to-time messy-date))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
467 (error " ? "))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
468 |
17493 | 469 (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
|
470 "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
|
471 (condition-case () |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
472 (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
|
473 (error " - "))) |
17493 | 474 |
475 (defmacro gnus-date-get-time (date) | |
476 "Convert DATE string to Emacs time. | |
477 Cache the result as a text property stored in DATE." | |
478 ;; Either return the cached value... | |
479 `(let ((d ,date)) | |
480 (if (equal "" d) | |
481 '(0 0) | |
482 (or (get-text-property 0 'gnus-time d) | |
483 ;; 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
|
484 (let ((time (safe-date-to-time d))) |
17493 | 485 ;; and store it back in the string. |
486 (put-text-property 0 1 'gnus-time time d) | |
487 time))))) | |
488 | |
489 (defsubst gnus-time-iso8601 (time) | |
31785 | 490 "Return a string of TIME in YYYYMMDDTHHMMSS format." |
17493 | 491 (format-time-string "%Y%m%dT%H%M%S" time)) |
492 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
493 (defun gnus-date-iso8601 (date) |
31785 | 494 "Convert the DATE to YYYYMMDDTHHMMSS." |
17493 | 495 (condition-case () |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
496 (gnus-time-iso8601 (gnus-date-get-time date)) |
17493 | 497 (error ""))) |
498 | |
499 (defun gnus-mode-string-quote (string) | |
500 "Quote all \"%\"'s in STRING." | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
501 (gnus-replace-in-string string "%" "%%")) |
17493 | 502 |
503 ;; Make a hash table (default and minimum size is 256). | |
504 ;; Optional argument HASHSIZE specifies the table size. | |
505 (defun gnus-make-hashtable (&optional hashsize) | |
506 (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0)) | |
507 | |
508 ;; Make a number that is suitable for hashing; bigger than MIN and | |
509 ;; equal to some 2^x. Many machines (such as sparcs) do not have a | |
510 ;; hardware modulo operation, so they implement it in software. On | |
511 ;; many sparcs over 50% of the time to intern is spent in the modulo. | |
512 ;; Yes, it's slower than actually computing the hash from the string! | |
513 ;; So we use powers of 2 so people can optimize the modulo to a mask. | |
514 (defun gnus-create-hash-size (min) | |
515 (let ((i 1)) | |
516 (while (< i min) | |
517 (setq i (* 2 i))) | |
518 i)) | |
519 | |
520 (defcustom gnus-verbose 7 | |
521 "*Integer that says how verbose Gnus should be. | |
522 The higher the number, the more messages Gnus will flash to say what | |
523 it's doing. At zero, Gnus will be totally mute; at five, Gnus will | |
524 display most important messages; and at ten, Gnus will keep on | |
525 jabbering all the time." | |
526 :group 'gnus-start | |
527 :type 'integer) | |
528 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
529 (defcustom gnus-add-timestamp-to-message nil |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
530 "Non-nil means add timestamps to messages that Gnus issues. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
531 If it is `log', add timestamps to only the messages that go into the |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
532 \"*Messages*\" buffer (in XEmacs, it is the \" *Message-Log*\" buffer). |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
533 If it is neither nil nor `log', add timestamps not only to log messages |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
534 but also to the ones displayed in the echo area." |
92336
5f827896103e
Change defcustom :version from 23.0 to 23.1.
Glenn Morris <rgm@gnu.org>
parents:
92147
diff
changeset
|
535 :version "23.1" ;; No Gnus |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
536 :group 'gnus-various |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
537 :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
538 (const :tag "Logged messages only" log) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
539 (sexp :tag "All messages" |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
540 :match (lambda (widget value) value) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
541 :value t) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
542 (const :tag "No timestamp" nil))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
543 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
544 (eval-when-compile |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
545 (defmacro gnus-message-with-timestamp-1 (format-string args) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
546 (let ((timestamp '((format-time-string "%Y%m%dT%H%M%S" time) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
547 "." (format "%03d" (/ (nth 2 time) 1000)) "> "))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
548 (if (featurep 'xemacs) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
549 `(let (str time) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
550 (if (or (and (null ,format-string) (null ,args)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
551 (progn |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
552 (setq str (apply 'format ,format-string ,args)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
553 (zerop (length str)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
554 (prog1 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
555 (and ,format-string str) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
556 (clear-message nil)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
557 (cond ((eq gnus-add-timestamp-to-message 'log) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
558 (setq time (current-time)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
559 (display-message 'no-log str) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
560 (log-message 'message (concat ,@timestamp str))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
561 (gnus-add-timestamp-to-message |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
562 (setq time (current-time)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
563 (display-message 'message (concat ,@timestamp str))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
564 (t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
565 (display-message 'message str)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
566 str) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
567 `(let (str time) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
568 (cond ((eq gnus-add-timestamp-to-message 'log) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
569 (setq str (let (message-log-max) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
570 (apply 'message ,format-string ,args))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
571 (when (and message-log-max |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
572 (> message-log-max 0) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
573 (/= (length str) 0)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
574 (setq time (current-time)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
575 (with-current-buffer (get-buffer-create "*Messages*") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
576 (goto-char (point-max)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
577 (insert ,@timestamp str "\n") |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
578 (forward-line (- message-log-max)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
579 (delete-region (point-min) (point)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
580 (goto-char (point-max)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
581 str) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
582 (gnus-add-timestamp-to-message |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
583 (if (or (and (null ,format-string) (null ,args)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
584 (progn |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
585 (setq str (apply 'format ,format-string ,args)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
586 (zerop (length str)))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
587 (prog1 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
588 (and ,format-string str) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
589 (message nil)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
590 (setq time (current-time)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
591 (message "%s" (concat ,@timestamp str)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
592 str)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
593 (t |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
594 (apply 'message ,format-string ,args)))))))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
595 |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
596 (defun gnus-message-with-timestamp (format-string &rest args) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
597 "Display message with timestamp. Arguments are the same as `message'. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
598 The `gnus-add-timestamp-to-message' variable controls how to add |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
599 timestamp to message." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
600 (gnus-message-with-timestamp-1 format-string args)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
601 |
17493 | 602 (defun gnus-message (level &rest args) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
603 "If LEVEL is lower than `gnus-verbose' print ARGS using `message'. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
604 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
605 Guideline for numbers: |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
606 1 - error messages, 3 - non-serious error messages, 5 - messages for things |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
607 that take a long time, 7 - not very important messages on stuff, 9 - messages |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
608 inside loops." |
17493 | 609 (if (<= level gnus-verbose) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
610 (if gnus-add-timestamp-to-message |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
611 (apply 'gnus-message-with-timestamp args) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
612 (apply 'message args)) |
17493 | 613 ;; We have to do this format thingy here even if the result isn't |
614 ;; shown - the return value has to be the same as the return value | |
615 ;; from `message'. | |
616 (apply 'format args))) | |
617 | |
618 (defun gnus-error (level &rest args) | |
68606
5ea0e0a7dd38
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-42
Miles Bader <miles@gnu.org>
parents:
65846
diff
changeset
|
619 "Beep an error if LEVEL is equal to or less than `gnus-verbose'. |
5ea0e0a7dd38
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-42
Miles Bader <miles@gnu.org>
parents:
65846
diff
changeset
|
620 ARGS are passed to `message'." |
17493 | 621 (when (<= (floor level) gnus-verbose) |
622 (apply 'message args) | |
623 (ding) | |
624 (let (duration) | |
625 (when (and (floatp level) | |
626 (not (zerop (setq duration (* 10 (- level (floor level))))))) | |
627 (sit-for duration)))) | |
628 nil) | |
629 | |
630 (defun gnus-split-references (references) | |
631 "Return a list of Message-IDs in REFERENCES." | |
632 (let ((beg 0) | |
98366
ef06f769799e
(gnus-split-references): Strip comments.
Andreas Schwab <schwab@suse.de>
parents:
96867
diff
changeset
|
633 (references (mail-header-remove-comments (or references ""))) |
17493 | 634 ids) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
635 (while (string-match "<[^<]+[^< \t]" references beg) |
17493 | 636 (push (substring references (match-beginning 0) (setq beg (match-end 0))) |
637 ids)) | |
638 (nreverse ids))) | |
639 | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
640 (defun gnus-extract-references (references) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
641 "Return a list of Message-IDs in REFERENCES (in In-Reply-To |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
642 format), trimmed to only contain the Message-IDs." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
643 (let ((ids (gnus-split-references references)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
644 refs) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
645 (dolist (id ids) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
646 (when (string-match "<[^<>]+>" id) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
647 (push (match-string 0 id) refs))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
648 refs)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
649 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
650 (defsubst gnus-parent-id (references &optional n) |
17493 | 651 "Return the last Message-ID in REFERENCES. |
652 If N, return the Nth ancestor instead." | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
653 (when (and references |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
654 (not (zerop (length references)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
655 (if n |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
656 (let ((ids (inline (gnus-split-references references)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
657 (while (nthcdr n ids) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
658 (setq ids (cdr ids))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
659 (car ids)) |
98366
ef06f769799e
(gnus-split-references): Strip comments.
Andreas Schwab <schwab@suse.de>
parents:
96867
diff
changeset
|
660 (let ((references (mail-header-remove-comments references))) |
ef06f769799e
(gnus-split-references): Strip comments.
Andreas Schwab <schwab@suse.de>
parents:
96867
diff
changeset
|
661 (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references) |
ef06f769799e
(gnus-split-references): Strip comments.
Andreas Schwab <schwab@suse.de>
parents:
96867
diff
changeset
|
662 (match-string 1 references)))))) |
17493 | 663 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
664 (defun gnus-buffer-live-p (buffer) |
17493 | 665 "Say whether BUFFER is alive or not." |
666 (and buffer | |
667 (get-buffer buffer) | |
668 (buffer-name (get-buffer buffer)))) | |
669 | |
670 (defun gnus-horizontal-recenter () | |
671 "Recenter the current buffer horizontally." | |
672 (if (< (current-column) (/ (window-width) 2)) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
673 (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0) |
17493 | 674 (let* ((orig (point)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
675 (end (window-end (gnus-get-buffer-window (current-buffer) t))) |
17493 | 676 (max 0)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
677 (when end |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
678 ;; 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
|
679 (goto-char (window-start)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
680 (while (and (not (eobp)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
681 (< (point) end)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
682 (end-of-line) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
683 (setq max (max max (current-column))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
684 (forward-line 1)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
685 (goto-char orig) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
686 ;; 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
|
687 (if (> max (window-width)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
688 (set-window-hscroll |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
689 (gnus-get-buffer-window (current-buffer) t) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
690 (min (- (current-column) (/ (window-width) 3)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
691 (+ 2 (- max (window-width))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
692 (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
693 max)))) |
17493 | 694 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
695 (defun gnus-read-event-char (&optional prompt) |
17493 | 696 "Get the next event." |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
697 (let ((event (read-event prompt))) |
17493 | 698 ;; should be gnus-characterp, but this can't be called in XEmacs anyway |
699 (cons (and (numberp event) event) event))) | |
700 | |
701 (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
|
702 "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
|
703 (gnus-time-iso8601 (date-to-time date))) |
17493 | 704 |
705 (defun gnus-copy-file (file &optional to) | |
706 "Copy FILE to TO." | |
707 (interactive | |
708 (list (read-file-name "Copy file: " default-directory) | |
709 (read-file-name "Copy file to: " default-directory))) | |
710 (unless to | |
711 (setq to (read-file-name "Copy file to: " default-directory))) | |
712 (when (file-directory-p to) | |
713 (setq to (concat (file-name-as-directory to) | |
714 (file-name-nondirectory file)))) | |
715 (copy-file file to)) | |
716 | |
717 (defvar gnus-work-buffer " *gnus work*") | |
718 | |
87263
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
719 (declare-function gnus-get-buffer-create "gnus" (name)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
720 ;; gnus.el requires mm-util. |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
721 (declare-function mm-enable-multibyte "mm-util") |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
722 |
17493 | 723 (defun gnus-set-work-buffer () |
724 "Put point in the empty Gnus work buffer." | |
725 (if (get-buffer gnus-work-buffer) | |
726 (progn | |
727 (set-buffer gnus-work-buffer) | |
728 (erase-buffer)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
729 (set-buffer (gnus-get-buffer-create gnus-work-buffer)) |
17493 | 730 (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
|
731 (mm-enable-multibyte))) |
17493 | 732 |
733 (defmacro gnus-group-real-name (group) | |
734 "Find the real name of a foreign newsgroup." | |
735 `(let ((gname ,group)) | |
736 (if (string-match "^[^:]+:" gname) | |
737 (substring gname (match-end 0)) | |
738 gname))) | |
739 | |
72509 | 740 (defmacro gnus-group-server (group) |
741 "Find the server name of a foreign newsgroup. | |
742 For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would | |
743 yield \"nnimap:yxa\"." | |
744 `(let ((gname ,group)) | |
745 (if (string-match "^\\([^:+]+\\)\\(?:\\+\\([^:]*\\)\\)?:" gname) | |
746 (format "%s:%s" (match-string 1 gname) (or | |
747 (match-string 2 gname) | |
748 "")) | |
749 (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) | |
750 | |
17493 | 751 (defun gnus-make-sort-function (funs) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
752 "Return a composite sort condition based on the functions in FUNS." |
17493 | 753 (cond |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
754 ;; Just a simple function. |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
755 ((functionp funs) funs) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
756 ;; No functions at all. |
17493 | 757 ((null funs) funs) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
758 ;; A list of functions. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
759 ((or (cdr funs) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
760 (listp (car funs))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
761 (gnus-byte-compile |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
762 `(lambda (t1 t2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
763 ,(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
|
764 ;; A list containing just one function. |
17493 | 765 (t |
766 (car funs)))) | |
767 | |
768 (defun gnus-make-sort-function-1 (funs) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
769 "Return a composite sort condition based on the functions in FUNS." |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
770 (let ((function (car funs)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
771 (first 't1) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
772 (last 't2)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
773 (when (consp function) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
774 (cond |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
775 ;; Reversed spec. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
776 ((eq (car function) 'not) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
777 (setq function (cadr function) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
778 first 't2 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
779 last 't1)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
780 ((functionp function) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
781 ;; Do nothing. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
782 ) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
783 (t |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
784 (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
|
785 (if (cdr funs) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
786 `(or (,function ,first ,last) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
787 (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
|
788 ,(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
|
789 `(,function ,first ,last)))) |
17493 | 790 |
791 (defun gnus-turn-off-edit-menu (type) | |
792 "Turn off edit menu in `gnus-TYPE-mode-map'." | |
793 (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) | |
794 [menu-bar edit] 'undefined)) | |
795 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
796 (defmacro gnus-bind-print-variables (&rest forms) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
797 "Bind print-* variables and evaluate FORMS. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
798 This macro is used with `prin1', `pp', etc. in order to ensure printed |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
799 Lisp objects are loadable. Bind `print-quoted' and `print-readably' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
800 to t, and `print-escape-multibyte', `print-escape-newlines', |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
801 `print-escape-nonascii', `print-length', `print-level' and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
802 `print-string-length' to nil." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
803 `(let ((print-quoted t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
804 (print-readably t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
805 ;;print-circle |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
806 ;;print-continuous-numbering |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
807 print-escape-multibyte |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
808 print-escape-newlines |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
809 print-escape-nonascii |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
810 ;;print-gensym |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
811 print-length |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
812 print-level |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
813 print-string-length) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
814 ,@forms)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
815 |
17493 | 816 (defun gnus-prin1 (form) |
817 "Use `prin1' on FORM in the current buffer. | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
818 Bind `print-quoted' and `print-readably' to t, and `print-length' and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
819 `print-level' to nil. See also `gnus-bind-print-variables'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
820 (gnus-bind-print-variables (prin1 form (current-buffer)))) |
17493 | 821 |
822 (defun gnus-prin1-to-string (form) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
823 "The same as `prin1'. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
824 Bind `print-quoted' and `print-readably' to t, and `print-length' and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
825 `print-level' to nil. See also `gnus-bind-print-variables'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
826 (gnus-bind-print-variables (prin1-to-string form))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
827 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
828 (defun gnus-pp (form &optional stream) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
829 "Use `pp' on FORM in the current buffer. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
830 Bind `print-quoted' and `print-readably' to t, and `print-length' and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
831 `print-level' to nil. See also `gnus-bind-print-variables'." |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
832 (gnus-bind-print-variables (pp form (or stream (current-buffer))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
833 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
834 (defun gnus-pp-to-string (form) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
835 "The same as `pp-to-string'. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
836 Bind `print-quoted' and `print-readably' to t, and `print-length' and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
837 `print-level' to nil. See also `gnus-bind-print-variables'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
838 (gnus-bind-print-variables (pp-to-string form))) |
17493 | 839 |
840 (defun gnus-make-directory (directory) | |
841 "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
|
842 (require 'nnmail) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
843 (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
|
844 (when (and directory |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
845 (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
|
846 (make-directory directory t))) |
17493 | 847 t) |
848 | |
849 (defun gnus-write-buffer (file) | |
850 "Write the current buffer's contents to FILE." | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
851 (let ((file-name-coding-system nnmail-pathname-coding-system)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
852 ;; Make sure the directory exists. |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
853 (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
|
854 ;; Write the buffer. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
855 (write-region (point-min) (point-max) file nil 'quietly))) |
17493 | 856 |
857 (defun gnus-delete-file (file) | |
858 "Delete FILE if it exists." | |
859 (when (file-exists-p file) | |
860 (delete-file file))) | |
861 | |
59089
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
862 (defun gnus-delete-directory (directory) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
863 "Delete files in DIRECTORY. Subdirectories remain. |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
864 If there's no subdirectory, delete DIRECTORY as well." |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
865 (when (file-directory-p directory) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
866 (let ((files (directory-files |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
867 directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
868 file dir) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
869 (while files |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
870 (setq file (pop files)) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
871 (if (eq t (car (file-attributes file))) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
872 ;; `file' is a subdirectory. |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
873 (setq dir t) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
874 ;; `file' is a file or a symlink. |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
875 (delete-file file))) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
876 (unless dir |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
877 (delete-directory directory))))) |
22da0004ae3c
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-750
Miles Bader <miles@gnu.org>
parents:
58835
diff
changeset
|
878 |
73269 | 879 ;; The following two functions are used in gnus-registry. |
880 ;; They were contributed by Andreas Fuchs <asf@void.at>. | |
881 (defun gnus-alist-to-hashtable (alist) | |
882 "Build a hashtable from the values in ALIST." | |
883 (let ((ht (make-hash-table | |
884 :size 4096 | |
885 :test 'equal))) | |
886 (mapc | |
887 (lambda (kv-pair) | |
888 (puthash (car kv-pair) (cdr kv-pair) ht)) | |
889 alist) | |
890 ht)) | |
891 | |
892 (defun gnus-hashtable-to-alist (hash) | |
893 "Build an alist from the values in HASH." | |
894 (let ((list nil)) | |
895 (maphash | |
896 (lambda (key value) | |
897 (setq list (cons (cons key value) list))) | |
898 hash) | |
899 list)) | |
900 | |
17493 | 901 (defun gnus-strip-whitespace (string) |
902 "Return STRING stripped of all whitespace." | |
903 (while (string-match "[\r\n\t ]+" string) | |
904 (setq string (replace-match "" t t string))) | |
905 string) | |
906 | |
87263
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
907 (declare-function gnus-put-text-property "gnus" |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
908 (start end property value &optional object)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
909 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
910 (defsubst gnus-put-text-property-excluding-newlines (beg end prop val) |
17493 | 911 "The same as `put-text-property', but don't put this prop on any newlines in the region." |
912 (save-match-data | |
913 (save-excursion | |
914 (save-restriction | |
915 (goto-char beg) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
916 (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
|
917 (gnus-put-text-property beg (match-beginning 0) prop val) |
17493 | 918 (setq beg (point))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
919 (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
|
920 |
87263
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
921 (declare-function gnus-overlay-put "gnus" (overlay prop value)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
922 (declare-function gnus-make-overlay "gnus" |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
923 (beg end &optional buffer front-advance rear-advance)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
924 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
925 (defsubst gnus-put-overlay-excluding-newlines (beg end prop val) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
926 "The same as `put-text-property', but don't put this prop on any newlines in the region." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
927 (save-match-data |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
928 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
929 (save-restriction |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
930 (goto-char beg) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
931 (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
932 (gnus-overlay-put |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
933 (gnus-make-overlay beg (match-beginning 0)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
934 prop val) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
935 (setq beg (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
936 (gnus-overlay-put (gnus-make-overlay beg (point)) prop val))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
937 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
938 (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
|
939 prop val) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
940 "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
|
941 (let ((b beg)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
942 (while (/= b end) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
943 (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
|
944 (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
|
945 (when (/= b end) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
946 (inline |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
947 (gnus-put-text-property |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
948 b (setq b (next-single-property-change b 'gnus-face nil end)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
949 prop val)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
950 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
951 (defmacro gnus-faces-at (position) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
952 "Return a list of faces at POSITION." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
953 (if (featurep 'xemacs) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
954 `(let ((pos ,position)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
955 (mapcar-extents 'extent-face |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
956 nil (current-buffer) pos pos nil 'face)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
957 `(let ((pos ,position)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
958 (delq nil (cons (get-text-property pos 'face) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
959 (mapcar |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
960 (lambda (overlay) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
961 (overlay-get overlay 'face)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
962 (overlays-at pos))))))) |
17493 | 963 |
964 ;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 | |
95586
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
965 ;; The primary idea here is to try to protect internal datastructures |
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
966 ;; from becoming corrupted when the user hits C-g, or if a hook or |
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
967 ;; similar blows up. Often in Gnus multiple tables/lists need to be |
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
968 ;; updated at the same time, or information can be lost. |
17493 | 969 |
970 (defvar gnus-atomic-be-safe t | |
971 "If t, certain operations will be protected from interruption by C-g.") | |
972 | |
973 (defmacro gnus-atomic-progn (&rest forms) | |
974 "Evaluate FORMS atomically, which means to protect the evaluation | |
975 from being interrupted by the user. An error from the forms themselves | |
976 will return without finishing the operation. Since interrupts from | |
977 the user are disabled, it is recommended that only the most minimal | |
978 operations are performed by FORMS. If you wish to assign many | |
979 complicated values atomically, compute the results into temporary | |
980 variables and then do only the assignment atomically." | |
981 `(let ((inhibit-quit gnus-atomic-be-safe)) | |
982 ,@forms)) | |
983 | |
984 (put 'gnus-atomic-progn 'lisp-indent-function 0) | |
985 | |
986 (defmacro gnus-atomic-progn-assign (protect &rest forms) | |
95586
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
987 "Evaluate FORMS, but ensure that the variables listed in PROTECT |
17493 | 988 are not changed if anything in FORMS signals an error or otherwise |
989 non-locally exits. The variables listed in PROTECT are updated atomically. | |
990 It is safe to use gnus-atomic-progn-assign with long computations. | |
991 | |
992 Note that if any of the symbols in PROTECT were unbound, they will be | |
48588 | 993 set to nil on a successful assignment. In case of an error or other |
17493 | 994 non-local exit, it will still be unbound." |
995 (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol | |
996 (concat (symbol-name x) | |
997 "-tmp")) | |
998 x)) | |
999 protect)) | |
1000 (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x))) | |
1001 temp-sym-map)) | |
1002 (temp-sym-let (mapcar (lambda (x) (list (car x) | |
1003 `(and (boundp ',(cadr x)) | |
1004 ,(cadr x)))) | |
1005 temp-sym-map)) | |
1006 (sym-temp-let sym-temp-map) | |
1007 (temp-sym-assign (apply 'append temp-sym-map)) | |
1008 (sym-temp-assign (apply 'append sym-temp-map)) | |
1009 (result (make-symbol "result-tmp"))) | |
1010 `(let (,@temp-sym-let | |
1011 ,result) | |
1012 (let ,sym-temp-let | |
1013 (setq ,result (progn ,@forms)) | |
1014 (setq ,@temp-sym-assign)) | |
1015 (let ((inhibit-quit gnus-atomic-be-safe)) | |
1016 (setq ,@sym-temp-assign)) | |
1017 ,result))) | |
1018 | |
1019 (put 'gnus-atomic-progn-assign 'lisp-indent-function 1) | |
1020 ;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) | |
1021 | |
1022 (defmacro gnus-atomic-setq (&rest pairs) | |
1023 "Similar to setq, except that the real symbols are only assigned when | |
1024 there are no errors. And when the real symbols are assigned, they are | |
1025 done so atomically. If other variables might be changed via side-effect, | |
1026 see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq | |
1027 with potentially long computations." | |
1028 (let ((tpairs pairs) | |
1029 syms) | |
1030 (while tpairs | |
1031 (push (car tpairs) syms) | |
1032 (setq tpairs (cddr tpairs))) | |
1033 `(gnus-atomic-progn-assign ,syms | |
1034 (setq ,@pairs)))) | |
1035 | |
1036 ;(put 'gnus-atomic-setq 'edebug-form-spec '(body)) | |
1037 | |
1038 | |
1039 ;;; Functions for saving to babyl/mail files. | |
1040 | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1041 (eval-when-compile |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1042 (condition-case nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1043 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1044 (require 'rmail) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1045 (autoload 'rmail-update-summary "rmailsum")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1046 (error |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1047 (define-compiler-macro rmail-select-summary (&rest body) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1048 ;; Rmail of the XEmacs version is supplied by the package, and |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1049 ;; requires tm and apel packages. However, there may be those |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1050 ;; who haven't installed those packages. This macro helps such |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1051 ;; people even if they install those packages later. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1052 `(eval '(rmail-select-summary ,@body))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1053 ;; If there's rmail but there's no tm (or there's apel of the |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1054 ;; mainstream, not the XEmacs version), loading rmail of the XEmacs |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1055 ;; version fails halfway, however it provides the rmail-select-summary |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1056 ;; macro which uses the following functions: |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1057 (autoload 'rmail-summary-displayed "rmail") |
86154 | 1058 (autoload 'rmail-maybe-display-summary "rmail")))) |
1059 | |
1060 (defvar mm-text-coding-system) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1061 |
87190
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1062 (declare-function mm-append-to-file "mm-util" |
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1063 (start end filename &optional codesys inhibit)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1064 |
17493 | 1065 (defun gnus-output-to-rmail (filename &optional ask) |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1066 "Append the current article to an Rmail file named FILENAME. |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1067 In Emacs 22 this writes Babyl format; in Emacs 23 it writes mbox unless |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1068 FILENAME exists and is Babyl format." |
17493 | 1069 (require 'rmail) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1070 (require 'mm-util) |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1071 ;; Some of this codes is borrowed from rmailout.el. |
17493 | 1072 (setq filename (expand-file-name filename)) |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1073 ;; FIXME should we really be messing with this defcustom? |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1074 ;; It is not needed for the operation of this function. |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1075 (if (boundp 'rmail-default-rmail-file) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1076 (setq rmail-default-rmail-file filename) ; 22 |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1077 (setq rmail-default-file filename)) ; 23 |
17493 | 1078 (let ((artbuf (current-buffer)) |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1079 (tmpbuf (get-buffer-create " *Gnus-output*")) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1080 ;; Babyl rmail.el defines this, mbox does not. |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1081 (babyl (fboundp 'rmail-insert-rmail-file-header))) |
17493 | 1082 (save-excursion |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1083 ;; Note that we ignore the possibility of visiting a Babyl |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1084 ;; format buffer in Emacs 23, since Rmail no longer supports that. |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1085 (or (get-file-buffer filename) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1086 (progn |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1087 ;; In case someone wants to write to a Babyl file from Emacs 23. |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1088 (when (file-exists-p filename) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1089 (setq babyl (mail-file-babyl-p filename)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1090 t)) |
17493 | 1091 (if (or (not ask) |
1092 (gnus-yes-or-no-p | |
1093 (concat "\"" filename "\" does not exist, create it? "))) | |
1094 (let ((file-buffer (create-file-buffer filename))) | |
1095 (save-excursion | |
1096 (set-buffer file-buffer) | |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1097 (if (fboundp 'rmail-insert-rmail-file-header) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1098 (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
|
1099 (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
|
1100 (coding-system-for-write mm-text-coding-system)) |
17493 | 1101 (gnus-write-buffer filename))) |
1102 (kill-buffer file-buffer)) | |
1103 (error "Output file does not exist"))) | |
1104 (set-buffer tmpbuf) | |
1105 (erase-buffer) | |
1106 (insert-buffer-substring artbuf) | |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1107 (if babyl |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1108 (gnus-convert-article-to-rmail) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1109 ;; Non-Babyl case copied from gnus-output-to-mail. |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1110 (goto-char (point-min)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1111 (if (looking-at "From ") |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1112 (forward-line 1) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1113 (insert "From nobody " (current-time-string) "\n")) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1114 (let (case-fold-search) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1115 (while (re-search-forward "^From " nil t) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1116 (beginning-of-line) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1117 (insert ">")))) |
17493 | 1118 ;; Decide whether to append to a file or to an Emacs buffer. |
1119 (let ((outbuf (get-file-buffer filename))) | |
1120 (if (not outbuf) | |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1121 (progn |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1122 (unless babyl ; from gnus-output-to-mail |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1123 (let ((buffer-read-only nil)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1124 (goto-char (point-max)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1125 (forward-char -2) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1126 (unless (looking-at "\n\n") |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1127 (goto-char (point-max)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1128 (unless (bolp) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1129 (insert "\n")) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1130 (insert "\n")))) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1131 (let ((file-name-coding-system nnmail-pathname-coding-system)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1132 (mm-append-to-file (point-min) (point-max) filename))) |
17493 | 1133 ;; File has been visited, in buffer OUTBUF. |
1134 (set-buffer outbuf) | |
1135 (let ((buffer-read-only nil) | |
1136 (msg (and (boundp 'rmail-current-message) | |
1137 (symbol-value 'rmail-current-message)))) | |
1138 ;; If MSG is non-nil, buffer is in RMAIL mode. | |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1139 ;; Compare this with rmail-output-to-rmail-buffer in Emacs 23. |
17493 | 1140 (when msg |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1141 (unless babyl |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1142 (rmail-swap-buffers-maybe) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1143 (rmail-maybe-set-message-counters)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1144 (widen) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1145 (narrow-to-region (point-max) (point-max))) |
17493 | 1146 (insert-buffer-substring tmpbuf) |
1147 (when msg | |
102044
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1148 (when babyl |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1149 (goto-char (point-min)) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1150 (widen) |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1151 (search-backward "\n\^_") |
8cc6c7d847fe
(rmail-insert-rmail-file-header, rmail-count-new-messages)
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1152 (narrow-to-region (point) (point-max))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1153 (rmail-count-new-messages t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1154 (when (rmail-summary-exists) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1155 (rmail-select-summary |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1156 (rmail-update-summary))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1157 (rmail-show-message msg)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1158 (save-buffer))))) |
17493 | 1159 (kill-buffer tmpbuf))) |
1160 | |
1161 (defun gnus-output-to-mail (filename &optional ask) | |
1162 "Append the current article to a mail file named FILENAME." | |
1163 (setq filename (expand-file-name filename)) | |
1164 (let ((artbuf (current-buffer)) | |
1165 (tmpbuf (get-buffer-create " *Gnus-output*"))) | |
1166 (save-excursion | |
1167 ;; Create the file, if it doesn't exist. | |
1168 (when (and (not (get-file-buffer filename)) | |
1169 (not (file-exists-p filename))) | |
1170 (if (or (not ask) | |
1171 (gnus-y-or-n-p | |
1172 (concat "\"" filename "\" does not exist, create it? "))) | |
1173 (let ((file-buffer (create-file-buffer filename))) | |
1174 (save-excursion | |
1175 (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
|
1176 (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
|
1177 (coding-system-for-write mm-text-coding-system)) |
17493 | 1178 (gnus-write-buffer filename))) |
1179 (kill-buffer file-buffer)) | |
1180 (error "Output file does not exist"))) | |
1181 (set-buffer tmpbuf) | |
1182 (erase-buffer) | |
1183 (insert-buffer-substring artbuf) | |
1184 (goto-char (point-min)) | |
1185 (if (looking-at "From ") | |
1186 (forward-line 1) | |
1187 (insert "From nobody " (current-time-string) "\n")) | |
1188 (let (case-fold-search) | |
1189 (while (re-search-forward "^From " nil t) | |
1190 (beginning-of-line) | |
1191 (insert ">"))) | |
1192 ;; Decide whether to append to a file or to an Emacs buffer. | |
1193 (let ((outbuf (get-file-buffer filename))) | |
1194 (if (not outbuf) | |
1195 (let ((buffer-read-only nil)) | |
1196 (save-excursion | |
1197 (goto-char (point-max)) | |
1198 (forward-char -2) | |
1199 (unless (looking-at "\n\n") | |
1200 (goto-char (point-max)) | |
1201 (unless (bolp) | |
1202 (insert "\n")) | |
1203 (insert "\n")) | |
1204 (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
|
1205 (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
|
1206 (mm-append-to-file (point-min) (point-max) filename)))) |
17493 | 1207 ;; File has been visited, in buffer OUTBUF. |
1208 (set-buffer outbuf) | |
1209 (let ((buffer-read-only nil)) | |
1210 (goto-char (point-max)) | |
1211 (unless (eobp) | |
1212 (insert "\n")) | |
1213 (insert "\n") | |
1214 (insert-buffer-substring tmpbuf))))) | |
1215 (kill-buffer tmpbuf))) | |
1216 | |
1217 (defun gnus-convert-article-to-rmail () | |
1218 "Convert article in current buffer to Rmail message format." | |
1219 (let ((buffer-read-only nil)) | |
1220 ;; Convert article directly into Babyl format. | |
1221 (goto-char (point-min)) | |
1222 (insert "\^L\n0, unseen,,\n*** EOOH ***\n") | |
1223 (while (search-forward "\n\^_" nil t) ;single char | |
1224 (replace-match "\n^_" t t)) ;2 chars: "^" and "_" | |
1225 (goto-char (point-max)) | |
1226 (insert "\^_"))) | |
1227 | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1228 (defun gnus-map-function (funs arg) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1229 "Apply the result of the first function in FUNS to the second, and so on. |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1230 ARG is passed to the first function." |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1231 (while funs |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1232 (setq arg (funcall (pop funs) arg))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1233 arg) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1234 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1235 (defun gnus-run-hooks (&rest funcs) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1236 "Does the same as `run-hooks', but saves the current buffer." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1237 (save-current-buffer |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1238 (apply 'run-hooks funcs))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1239 |
62791
a03b1bd1f66c
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-330
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
1240 (defun gnus-run-mode-hooks (&rest funcs) |
62890
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
62791
diff
changeset
|
1241 "Run `run-mode-hooks' if it is available, otherwise `run-hooks'. |
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
62791
diff
changeset
|
1242 This function saves the current buffer." |
62791
a03b1bd1f66c
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-330
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
1243 (if (fboundp 'run-mode-hooks) |
62890
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
62791
diff
changeset
|
1244 (save-current-buffer (apply 'run-mode-hooks funcs)) |
4b7fa3ee8e9e
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-336
Miles Bader <miles@gnu.org>
parents:
62791
diff
changeset
|
1245 (save-current-buffer (apply 'run-hooks funcs)))) |
62791
a03b1bd1f66c
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-330
Miles Bader <miles@gnu.org>
parents:
59996
diff
changeset
|
1246 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1247 ;;; Various |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1248 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1249 (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
|
1250 (defun gnus-alive-p () |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1251 "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
|
1252 (and (boundp 'gnus-group-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1253 (get-buffer gnus-group-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1254 (save-excursion |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1255 (set-buffer gnus-group-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1256 (eq major-mode 'gnus-group-mode)))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1257 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1258 (defun gnus-remove-if (predicate list) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1259 "Return a copy of LIST with all items satisfying PREDICATE removed." |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1260 (let (out) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1261 (while list |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1262 (unless (funcall predicate (car list)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1263 (push (car list) out)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1264 (setq list (cdr list))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1265 (nreverse out))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1266 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1267 (if (fboundp 'assq-delete-all) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1268 (defalias 'gnus-delete-alist 'assq-delete-all) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1269 (defun gnus-delete-alist (key alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1270 "Delete from ALIST all elements whose car is KEY. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1271 Return the modified alist." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1272 (let (entry) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1273 (while (setq entry (assq key alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1274 (setq alist (delq entry alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1275 alist))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1276 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1277 (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
|
1278 "Modify ALIST to be without KEY." |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1279 (unless (symbolp alist) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1280 (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
|
1281 (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
|
1282 `(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
|
1283 |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1284 (defun gnus-globalify-regexp (re) |
78486
f0a07da7dd45
Replace `iff' in doc-strings and comments.
Glenn Morris <rgm@gnu.org>
parents:
78224
diff
changeset
|
1285 "Return a regexp that matches a whole line, if RE matches a part of it." |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1286 (concat (unless (string-match "^\\^" re) "^.*") |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1287 re |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1288 (unless (string-match "\\$$" re) ".*$"))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
23319
diff
changeset
|
1289 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1290 (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
|
1291 "Set the window start to POINT, or (point) if nil." |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1292 (let ((win (gnus-get-buffer-window (current-buffer) t))) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1293 (when win |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1294 (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
|
1295 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1296 (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
|
1297 (if (= b e) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1298 (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
|
1299 (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
|
1300 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1301 (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
|
1302 "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
|
1303 (catch 'found |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1304 (while elems |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1305 (when (pop elems) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1306 (throw 'found t))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1307 |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1308 (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
|
1309 "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
|
1310 (catch 'found |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1311 (while elems |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1312 (unless (pop elems) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1313 (throw 'found nil))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1314 t)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1315 |
87263
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
1316 ;; gnus.el requires mm-util. |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
1317 (declare-function mm-disable-multibyte "mm-util") |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
1318 |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1319 (defun gnus-write-active-file (file hashtb &optional full-names) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1320 ;; `coding-system-for-write' should be `raw-text' or equivalent. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1321 (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
|
1322 (with-temp-file file |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1323 ;; The buffer should be in the unibyte mode because group names |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1324 ;; are ASCII text or encoded non-ASCII text (i.e., unibyte). |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1325 (mm-disable-multibyte) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1326 (mapatoms |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1327 (lambda (sym) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1328 (when (and sym |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1329 (boundp sym) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1330 (symbol-value sym)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1331 (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
|
1332 (if full-names |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1333 sym |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1334 (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
|
1335 (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
|
1336 (car (symbol-value sym))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1337 (car (symbol-value sym)))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1338 hashtb) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1339 (goto-char (point-max)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1340 (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
|
1341 (delete-char 1))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
1342 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1343 ;; Fixme: Why not use `with-output-to-temp-buffer'? |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1344 (defmacro gnus-with-output-to-file (file &rest body) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1345 (let ((buffer (make-symbol "output-buffer")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1346 (size (make-symbol "output-buffer-size")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1347 (leng (make-symbol "output-buffer-length")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1348 (append (make-symbol "output-buffer-append"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1349 `(let* ((,size 131072) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1350 (,buffer (make-string ,size 0)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1351 (,leng 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1352 (,append nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1353 (standard-output |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1354 (lambda (c) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1355 (aset ,buffer ,leng c) |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59089
diff
changeset
|
1356 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1357 (if (= ,size (setq ,leng (1+ ,leng))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1358 (progn (write-region ,buffer nil ,file ,append 'no-msg) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1359 (setq ,leng 0 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1360 ,append t)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1361 ,@body |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1362 (when (> ,leng 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1363 (let ((coding-system-for-write 'no-conversion)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1364 (write-region (substring ,buffer 0 ,leng) nil ,file |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1365 ,append 'no-msg)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1366 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1367 (put 'gnus-with-output-to-file 'lisp-indent-function 1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1368 (put 'gnus-with-output-to-file 'edebug-form-spec '(form body)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1369 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1370 (if (fboundp 'union) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1371 (defalias 'gnus-union 'union) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1372 (defun gnus-union (l1 l2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1373 "Set union of lists L1 and L2." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1374 (cond ((null l1) l2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1375 ((null l2) l1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1376 ((equal l1 l2) l1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1377 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1378 (or (>= (length l1) (length l2)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1379 (setq l1 (prog1 l2 (setq l2 l1)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1380 (while l2 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1381 (or (member (car l2) l1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1382 (push (car l2) l1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1383 (pop l2)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1384 l1)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1385 |
87263
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
1386 (declare-function gnus-add-text-properties "gnus" |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
1387 (start end properties &optional object)) |
4f3a531fad0a
(gnus-group-name-decode): Autoload.
Glenn Morris <rgm@gnu.org>
parents:
87190
diff
changeset
|
1388 |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1389 (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
|
1390 (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
|
1391 "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
|
1392 (let (point) |
47938
65eaf21a0a44
(gnus-parse-netrc): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
41494
diff
changeset
|
1393 (while (and start |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1394 (< start end) ;; XEmacs will loop for every when start=end. |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1395 (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
|
1396 (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
|
1397 (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
|
1398 (if start |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1399 (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
|
1400 |
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1401 (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
|
1402 (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
|
1403 "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
|
1404 (let (point) |
47938
65eaf21a0a44
(gnus-parse-netrc): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
41494
diff
changeset
|
1405 (while (and start |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1406 (< start end) |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1407 (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
|
1408 (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
|
1409 (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
|
1410 (if start |
34833
aaf69bc74739
* gnus-art.el (gnus-article-check-hidden-text): Return t.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
34727
diff
changeset
|
1411 (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
|
1412 t)) |
34727
4b9a7a10deaa
* gnus-util.el (gnus-add-text-properties-when): New function.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
33342
diff
changeset
|
1413 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1414 (defun gnus-string-remove-all-properties (string) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1415 (condition-case () |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1416 (let ((s string)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1417 (set-text-properties 0 (length string) nil string) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1418 s) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1419 (error string))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1420 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1421 ;; This might use `compare-strings' to reduce consing in the |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1422 ;; case-insensitive case, but it has to cope with null args. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1423 ;; (`string-equal' uses symbol print names.) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1424 (defun gnus-string-equal (x y) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1425 "Like `string-equal', except it compares case-insensitively." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1426 (and (= (length x) (length y)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1427 (or (string-equal x y) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1428 (string-equal (downcase x) (downcase y))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1429 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1430 (defcustom gnus-use-byte-compile t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1431 "If non-nil, byte-compile crucial run-time code. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1432 Setting it to nil has no effect after the first time `gnus-byte-compile' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1433 is run." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1434 :type 'boolean |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59089
diff
changeset
|
1435 :version "22.1" |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1436 :group 'gnus-various) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1437 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1438 (defun gnus-byte-compile (form) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1439 "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1440 (if gnus-use-byte-compile |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1441 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1442 (condition-case nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1443 ;; Work around a bug in XEmacs 21.4 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1444 (require 'byte-optimize) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1445 (error)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1446 (require 'bytecomp) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1447 (defalias 'gnus-byte-compile |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1448 (lambda (form) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1449 (let ((byte-compile-warnings '(unresolved callargs redefine))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1450 (byte-compile form)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1451 (gnus-byte-compile form)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1452 form)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1453 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1454 (defun gnus-remassoc (key alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1455 "Delete by side effect any elements of LIST whose car is `equal' to KEY. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1456 The modified LIST is returned. If the first member |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1457 of LIST has a car that is `equal' to KEY, there is no way to remove it |
57617
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1458 by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1459 sure of changing the value of `foo'." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1460 (when alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1461 (if (equal key (caar alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1462 (cdr alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1463 (setcdr alist (gnus-remassoc key (cdr alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1464 alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1465 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1466 (defun gnus-update-alist-soft (key value alist) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1467 (if value |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1468 (cons (cons key value) (gnus-remassoc key alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1469 (gnus-remassoc key alist))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1470 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1471 (defun gnus-create-info-command (node) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1472 "Create a command that will go to info NODE." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1473 `(lambda () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1474 (interactive) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1475 ,(concat "Enter the info system at node " node) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1476 (Info-goto-node ,node) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1477 (setq gnus-info-buffer (current-buffer)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1478 (gnus-configure-windows 'info))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1479 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1480 (defun gnus-not-ignore (&rest args) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1481 t) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1482 |
41494
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1483 (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
|
1484 "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
|
1485 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
|
1486 \"[/\\\\\]\" for some systems.") |
933ab100fb4a
2001-11-25 ShengHuo ZHU <zsh@cs.rochester.edu>
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
38861
diff
changeset
|
1487 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1488 (defun gnus-url-unhex (x) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1489 (if (> x ?9) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1490 (if (>= x ?a) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1491 (+ 10 (- x ?a)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1492 (+ 10 (- x ?A))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1493 (- x ?0))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1494 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1495 ;; Fixme: Do it like QP. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1496 (defun gnus-url-unhex-string (str &optional allow-newlines) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1497 "Remove %XX, embedded spaces, etc in a url. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1498 If optional second argument ALLOW-NEWLINES is non-nil, then allow the |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1499 decoding of carriage returns and line feeds in the string, which is normally |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1500 forbidden in URL encoding." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1501 (let ((tmp "") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1502 (case-fold-search t)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1503 (while (string-match "%[0-9a-f][0-9a-f]" str) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1504 (let* ((start (match-beginning 0)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1505 (ch1 (gnus-url-unhex (elt str (+ start 1)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1506 (code (+ (* 16 ch1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1507 (gnus-url-unhex (elt str (+ start 2)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1508 (setq tmp (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1509 tmp (substring str 0 start) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1510 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1511 (allow-newlines |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1512 (char-to-string code)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1513 ((or (= code ?\n) (= code ?\r)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1514 " ") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1515 (t (char-to-string code)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1516 str (substring str (match-end 0))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1517 (setq tmp (concat tmp str)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1518 tmp)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1519 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1520 (defun gnus-make-predicate (spec) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1521 "Transform SPEC into a function that can be called. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1522 SPEC is a predicate specifier that contains stuff like `or', `and', |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1523 `not', lists and functions. The functions all take one parameter." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1524 `(lambda (elem) ,(gnus-make-predicate-1 spec))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1525 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1526 (defun gnus-make-predicate-1 (spec) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1527 (cond |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1528 ((symbolp spec) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1529 `(,spec elem)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1530 ((listp spec) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1531 (if (memq (car spec) '(or and not)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1532 `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1533 (error "Invalid predicate specifier: %s" spec))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1534 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1535 (defun gnus-completing-read (prompt table &optional predicate require-match |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1536 history) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1537 (when (and history |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1538 (not (boundp history))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1539 (set history nil)) |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1540 (completing-read |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1541 (if (symbol-value history) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1542 (concat prompt " (" (car (symbol-value history)) "): ") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1543 (concat prompt ": ")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1544 table |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1545 predicate |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1546 require-match |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1547 nil |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1548 history |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1549 (car (symbol-value history)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1550 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1551 (defun gnus-graphic-display-p () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1552 (or (and (fboundp 'display-graphic-p) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1553 (display-graphic-p)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1554 ;;;!!!This is bogus. Fixme! |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1555 (and (featurep 'xemacs) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1556 t))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1557 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1558 (put 'gnus-parse-without-error 'lisp-indent-function 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1559 (put 'gnus-parse-without-error 'edebug-form-spec '(body)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1560 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1561 (defmacro gnus-parse-without-error (&rest body) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1562 "Allow continuing onto the next line even if an error occurs." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1563 `(while (not (eobp)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1564 (condition-case () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1565 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1566 ,@body |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1567 (goto-char (point-max))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1568 (error |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1569 (gnus-error 4 "Invalid data on line %d" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1570 (count-lines (point-min) (point))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1571 (forward-line 1))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1572 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1573 (defun gnus-cache-file-contents (file variable function) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1574 "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1575 (let ((time (nth 5 (file-attributes file))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1576 contents value) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1577 (if (or (null (setq value (symbol-value variable))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1578 (not (equal (car value) file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1579 (not (equal (nth 1 value) time))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1580 (progn |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1581 (setq contents (funcall function file)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1582 (set variable (list file time contents)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1583 contents) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1584 (nth 2 value)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1585 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1586 (defun gnus-multiple-choice (prompt choice &optional idx) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1587 "Ask user a multiple choice question. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1588 CHOICE is a list of the choice char and help message at IDX." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1589 (let (tchar buf) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1590 (save-window-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1591 (save-excursion |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1592 (while (not tchar) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1593 (message "%s (%s): " |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1594 prompt |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1595 (concat |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1596 (mapconcat (lambda (s) (char-to-string (car s))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1597 choice ", ") ", ?")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1598 (setq tchar (read-char)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1599 (when (not (assq tchar choice)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1600 (setq tchar nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1601 (setq buf (get-buffer-create "*Gnus Help*")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1602 (pop-to-buffer buf) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1603 (fundamental-mode) ; for Emacs 20.4+ |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1604 (buffer-disable-undo) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1605 (erase-buffer) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1606 (insert prompt ":\n\n") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1607 (let ((max -1) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1608 (list choice) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1609 (alist choice) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1610 (idx (or idx 1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1611 (i 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1612 n width pad format) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1613 ;; find the longest string to display |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1614 (while list |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1615 (setq n (length (nth idx (car list)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1616 (unless (> max n) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1617 (setq max n)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1618 (setq list (cdr list))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1619 (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1620 (setq n (/ (1- (window-width)) max)) ; items per line |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1621 (setq width (/ (1- (window-width)) n)) ; width of each item |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1622 ;; insert `n' items, each in a field of width `width' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1623 (while alist |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1624 (if (< i n) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1625 () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1626 (setq i 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1627 (delete-char -1) ; the `\n' takes a char |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1628 (insert "\n")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1629 (setq pad (- width 3)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1630 (setq format (concat "%c: %-" (int-to-string pad) "s")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1631 (insert (format format (caar alist) (nth idx (car alist)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1632 (setq alist (cdr alist)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1633 (setq i (1+ i)))))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1634 (if (buffer-live-p buf) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1635 (kill-buffer buf)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1636 tchar)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1637 |
95812 | 1638 (declare-function x-focus-frame "xfns.c" (frame)) |
87190
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1639 (declare-function w32-focus-frame "../term/w32-win" (frame)) |
5e1044759e6c
(declare-function): Add compatibility declaration.
Glenn Morris <rgm@gnu.org>
parents:
86154
diff
changeset
|
1640 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1641 (defun gnus-select-frame-set-input-focus (frame) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1642 "Select FRAME, raise it, and set input focus, if possible." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1643 (cond ((featurep 'xemacs) |
70146
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1644 (if (fboundp 'select-frame-set-input-focus) |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1645 (select-frame-set-input-focus frame) |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1646 (raise-frame frame) |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1647 (select-frame frame) |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1648 (focus-frame frame))) |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1649 ;; `select-frame-set-input-focus' defined in Emacs 21 will not |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1650 ;; set the input focus. |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1651 ((>= emacs-major-version 22) |
2cd7cafcba54
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-238
Miles Bader <miles@gnu.org>
parents:
69572
diff
changeset
|
1652 (select-frame-set-input-focus frame)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1653 (t |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1654 (raise-frame frame) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1655 (select-frame frame) |
96867
fe4950880bae
(ns-focus-frame): Remove declaration.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
96697
diff
changeset
|
1656 (cond ((memq window-system '(x ns mac)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1657 (x-focus-frame frame)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1658 ((eq window-system 'w32) |
96867
fe4950880bae
(ns-focus-frame): Remove declaration.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
96697
diff
changeset
|
1659 (w32-focus-frame frame))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1660 (when focus-follows-mouse |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1661 (set-mouse-position frame (1- (frame-width frame)) 0))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1662 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1663 (defun gnus-frame-or-window-display-name (object) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1664 "Given a frame or window, return the associated display name. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1665 Return nil otherwise." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1666 (if (featurep 'xemacs) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1667 (device-connection (dfw-device object)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1668 (if (or (framep object) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1669 (and (windowp object) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1670 (setq object (window-frame object)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1671 (let ((display (frame-parameter object 'display))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1672 (if (and (stringp display) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1673 ;; Exclude invalid display names. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1674 (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1675 display)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1676 display))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1677 |
86154 | 1678 (defvar tool-bar-mode) |
69572
b4faac2800dd
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-163
Miles Bader <miles@gnu.org>
parents:
69337
diff
changeset
|
1679 |
69337
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1680 (defun gnus-tool-bar-update (&rest ignore) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1681 "Update the tool bar." |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1682 (when (and (boundp 'tool-bar-mode) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1683 tool-bar-mode) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1684 (let* ((args nil) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1685 (func (cond ((featurep 'xemacs) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1686 'ignore) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1687 ((fboundp 'tool-bar-update) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1688 'tool-bar-update) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1689 ((fboundp 'force-window-update) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1690 'force-window-update) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1691 ((fboundp 'redraw-frame) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1692 (setq args (list (selected-frame))) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1693 'redraw-frame) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1694 (t 'ignore)))) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1695 (apply func args)))) |
55665aaac72b
* gnus-util.el (gnus-tool-bar-update): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
68633
diff
changeset
|
1696 |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1697 ;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1698 (defmacro gnus-mapcar (function seq1 &rest seqs2_n) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1699 "Apply FUNCTION to each element of the sequences, and make a list of the results. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1700 If there are several sequences, FUNCTION is called with that many arguments, |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1701 and mapping stops as soon as the shortest sequence runs out. With just one |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1702 sequence, this is like `mapcar'. With several, it is like the Common Lisp |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1703 `mapcar' function extended to arbitrary sequence types." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1704 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1705 (if seqs2_n |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1706 (let* ((seqs (cons seq1 seqs2_n)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1707 (cnt 0) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1708 (heads (mapcar (lambda (seq) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1709 (make-symbol (concat "head" |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1710 (int-to-string |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1711 (setq cnt (1+ cnt)))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1712 seqs)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1713 (result (make-symbol "result")) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1714 (result-tail (make-symbol "result-tail"))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1715 `(let* ,(let* ((bindings (cons nil nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1716 (heads heads)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1717 (nconc bindings (list (list result '(cons nil nil)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1718 (nconc bindings (list (list result-tail result))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1719 (while heads |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1720 (nconc bindings (list (list (pop heads) (pop seqs))))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1721 (cdr bindings)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1722 (while (and ,@heads) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1723 (setcdr ,result-tail (cons (funcall ,function |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1724 ,@(mapcar (lambda (h) (list 'car h)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1725 heads)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1726 nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1727 (setq ,result-tail (cdr ,result-tail) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1728 ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1729 (cdr ,result))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1730 `(mapcar ,function ,seq1))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1731 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1732 (if (fboundp 'merge) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1733 (defalias 'gnus-merge 'merge) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1734 ;; Adapted from cl-seq.el |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1735 (defun gnus-merge (type list1 list2 pred) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1736 "Destructively merge lists LIST1 and LIST2 to produce a new list. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1737 Argument TYPE is for compatibility and ignored. |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1738 Ordering of the elements is preserved according to PRED, a `less-than' |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1739 predicate on the elements." |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1740 (let ((res nil)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1741 (while (and list1 list2) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1742 (if (funcall pred (car list2) (car list1)) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1743 (push (pop list2) res) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1744 (push (pop list1) res))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1745 (nconc (nreverse res) list1 list2)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1746 |
86154 | 1747 (defvar xemacs-codename) |
1748 (defvar sxemacs-codename) | |
1749 (defvar emacs-program-version) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1750 |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1751 (defun gnus-emacs-version () |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1752 "Stringified Emacs version." |
65342
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1753 (let* ((lst (if (listp gnus-user-agent) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1754 gnus-user-agent |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1755 '(gnus emacs type))) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1756 (system-v (cond ((memq 'config lst) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1757 system-configuration) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1758 ((memq 'type lst) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1759 (symbol-name system-type)) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1760 (t nil))) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1761 codename emacsname) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1762 (cond ((featurep 'sxemacs) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1763 (setq emacsname "SXEmacs" |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1764 codename sxemacs-codename)) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1765 ((featurep 'xemacs) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1766 (setq emacsname "XEmacs" |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1767 codename xemacs-codename)) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1768 (t |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1769 (setq emacsname "Emacs"))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1770 (cond |
65342
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1771 ((not (memq 'emacs lst)) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1772 nil) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1773 ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) |
65342
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1774 ;; Emacs: |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1775 (concat "Emacs/" (match-string 1 emacs-version) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1776 (if system-v |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1777 (concat " (" system-v ")") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1778 ""))) |
65342
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1779 ((or (featurep 'sxemacs) (featurep 'xemacs)) |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1780 ;; XEmacs or SXEmacs: |
c71b1b2d2d04
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530
Miles Bader <miles@gnu.org>
parents:
65273
diff
changeset
|
1781 (concat emacsname "/" emacs-program-version |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1782 (let (plst) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1783 (when (memq 'codename lst) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1784 (push codename plst)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1785 (when system-v |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1786 (push system-v plst)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1787 (unless (featurep 'mule) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1788 (push "no MULE" plst)) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1789 (when (> (length plst) 0) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1790 (concat |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1791 " (" (mapconcat 'identity (reverse plst) ", ") ")"))))) |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1792 (t emacs-version)))) |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
1793 |
57617
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1794 (defun gnus-rename-file (old-path new-path &optional trim) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1795 "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1796 empty directories from OLD-PATH." |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1797 (when (file-exists-p old-path) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1798 (let* ((old-dir (file-name-directory old-path)) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1799 (old-name (file-name-nondirectory old-path)) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1800 (new-dir (file-name-directory new-path)) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1801 (new-name (file-name-nondirectory new-path)) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1802 temp) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1803 (gnus-make-directory new-dir) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1804 (rename-file old-path new-path t) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1805 (when trim |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1806 (while (progn (setq temp (directory-files old-dir)) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1807 (while (member (car temp) '("." "..")) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1808 (setq temp (cdr temp))) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1809 (= (length temp) 0)) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1810 (delete-directory old-dir) |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59089
diff
changeset
|
1811 (setq old-dir (file-name-as-directory |
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
59089
diff
changeset
|
1812 (file-truename |
57617
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1813 (concat old-dir ".."))))))))) |
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1814 |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1815 (defun gnus-set-file-modes (filename mode) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1816 "Wrapper for set-file-modes." |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1817 (ignore-errors |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1818 (set-file-modes filename mode))) |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
79143
diff
changeset
|
1819 |
62943
11d53dd5abd9
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-345
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
1820 (if (fboundp 'set-process-query-on-exit-flag) |
11d53dd5abd9
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-345
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
1821 (defalias 'gnus-set-process-query-on-exit-flag |
11d53dd5abd9
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-345
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
1822 'set-process-query-on-exit-flag) |
11d53dd5abd9
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-345
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
1823 (defalias 'gnus-set-process-query-on-exit-flag |
11d53dd5abd9
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-345
Miles Bader <miles@gnu.org>
parents:
62890
diff
changeset
|
1824 'process-kill-without-query)) |
57617
7fdc1df35f39
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Miles Bader <miles@gnu.org>
parents:
57153
diff
changeset
|
1825 |
73269 | 1826 (if (fboundp 'with-local-quit) |
1827 (defalias 'gnus-with-local-quit 'with-local-quit) | |
1828 (defmacro gnus-with-local-quit (&rest body) | |
1829 "Execute BODY, allowing quits to terminate BODY but not escape further. | |
1830 When a quit terminates BODY, `gnus-with-local-quit' returns nil but | |
1831 requests another quit. That quit will be processed as soon as quitting | |
1832 is allowed once again. (Immediately, if `inhibit-quit' is nil.)" | |
1833 ;;(declare (debug t) (indent 0)) | |
1834 `(condition-case nil | |
1835 (let ((inhibit-quit nil)) | |
1836 ,@body) | |
1837 (quit (setq quit-flag t) | |
1838 ;; This call is to give a chance to handle quit-flag | |
1839 ;; in case inhibit-quit is nil. | |
1840 ;; Without this, it will not be handled until the next function | |
1841 ;; call, and that might allow it to exit thru a condition-case | |
1842 ;; that intends to handle the quit signal next time. | |
1843 (eval '(ignore nil)))))) | |
1844 | |
95586
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
1845 (defalias 'gnus-read-shell-command |
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
1846 (if (fboundp 'read-shell-command) 'read-shell-command 'read-string)) |
64da3838a9aa
* gnus-util.el (gnus-read-shell-command): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94748
diff
changeset
|
1847 |
96024 | 1848 (defmacro gnus-put-display-table (range value display-table) |
1849 "Set the value for char RANGE to VALUE in DISPLAY-TABLE. " | |
1850 (if (featurep 'xemacs) | |
1851 (progn | |
1852 `(if (fboundp 'put-display-table) | |
1853 (put-display-table ,range ,value ,display-table) | |
1854 (if (sequencep ,display-table) | |
1855 (aset ,display-table ,range ,value) | |
1856 (put-char-table ,range ,value ,display-table)))) | |
1857 `(aset ,display-table ,range ,value))) | |
1858 | |
1859 (defmacro gnus-get-display-table (character display-table) | |
1860 "Find value for CHARACTER in DISPLAY-TABLE. " | |
1861 (if (featurep 'xemacs) | |
1862 `(if (fboundp 'get-display-table) | |
1863 (get-display-table ,character ,display-table) | |
1864 (if (sequencep ,display-table) | |
1865 (aref ,display-table ,character) | |
1866 (get-char-table ,character ,display-table))) | |
1867 `(aref ,display-table ,character))) | |
1868 | |
17493 | 1869 (provide 'gnus-util) |
1870 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92336
diff
changeset
|
1871 ;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 |
17493 | 1872 ;;; gnus-util.el ends here |