annotate lisp/gnus/gnus-util.el @ 32604:c8b8e93bf2fd

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