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