annotate lisp/gnus/gnus-util.el @ 109649:1f8f03cfcd2b

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