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