projects
/
gnus
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Refill some long/short copyright headers.
[gnus]
/
lisp
/
nnheader.el
diff --git
a/lisp/nnheader.el
b/lisp/nnheader.el
index
2c7b767
..
20cdeb5
100644
(file)
--- a/
lisp/nnheader.el
+++ b/
lisp/nnheader.el
@@
-1,8
+1,7
@@
;;; nnheader.el --- header access macros for Gnus and its backends
;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994,
-;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 1987-1990, 1993-1998, 2000-2011
+;; Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
@@
-10,10
+9,10
@@
;; This file is part of GNU Emacs.
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software
;
you can redistribute it and/or modify
+;; GNU Emacs is free software
:
you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation
; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation
, either version 3 of the License, or
+;;
(at your option)
any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@
-21,17
+20,21
@@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
;;; Commentary:
;;; Code:
+;; For Emacs <22.2 and XEmacs.
+(eval-and-compile
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile (require 'cl))
(defvar nnmail-extra-headers)
(eval-when-compile (require 'cl))
(defvar nnmail-extra-headers)
+(defvar gnus-newsgroup-name)
+(defvar nnheader-file-coding-system)
+(defvar jka-compr-compression-info-list)
;; Requiring `gnus-util' at compile time creates a circular
;; dependency between nnheader.el and gnus-util.el.
;; Requiring `gnus-util' at compile time creates a circular
;; dependency between nnheader.el and gnus-util.el.
@@
-40,11
+43,11
@@
(require 'mail-utils)
(require 'mm-util)
(require 'gnus-util)
(require 'mail-utils)
(require 'mm-util)
(require 'gnus-util)
-(eval-and-compile
-
(autoload 'gnus-sorted-intersection "gnus-range")
-
(autoload 'gnus-intersection "gnus-range")
-
(autoload 'gnus-sorted-complement "gnus-range")
-
(autoload 'gnus-sorted-difference "gnus-range")
)
+;; FIXME none of these are used explicitly in this file.
+(autoload 'gnus-sorted-intersection "gnus-range")
+(autoload 'gnus-intersection "gnus-range")
+(autoload 'gnus-sorted-complement "gnus-range")
+
(autoload 'gnus-sorted-difference "gnus-range"
)
(defcustom gnus-verbose-backends 7
"Integer that says how verbose the Gnus backends should be.
(defcustom gnus-verbose-backends 7
"Integer that says how verbose the Gnus backends should be.
@@
-74,7
+77,7
@@
Integer values will in effect be rounded up to the nearest multiple of
"*Length of each read operation when trying to fetch HEAD headers.")
(defvar nnheader-read-timeout
"*Length of each read operation when trying to fetch HEAD headers.")
(defvar nnheader-read-timeout
- (if (string-match "windows-nt\\|os/2\\|
emx\\|
cygwin"
+ (if (string-match "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
;;
(symbol-name system-type))
;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
;;
@@
-85,14
+88,21
@@
Integer values will in effect be rounded up to the nearest multiple of
;; what's possible. Perhaps better, maybe the Windows/DOS primitive
;; could round up non-zero timeouts to a minimum of 1.0?
1.0
;; what's possible. Perhaps better, maybe the Windows/DOS primitive
;; could round up non-zero timeouts to a minimum of 1.0?
1.0
- 0.1)
+ ;; 2008-05-19 change by Larsi:
+ ;; Change the default timeout from 0.1 seconds to 0.01 seconds. This will
+ ;; make nntp and pop3 article retrieval faster in some cases, but might
+ ;; make CPU usage larger. If this has any bad side effects, we might
+ ;; revert this change.
+ 0.01)
+ ;; When changing this variable, consider changing `pop3-read-timeout' as
+ ;; well.
"How long nntp should wait between checking for the end of output.
Shorter values mean quicker response, but are more CPU intensive.")
(defvar nnheader-file-name-translation-alist
(let ((case-fold-search t))
(cond
"How long nntp should wait between checking for the end of output.
Shorter values mean quicker response, but are more CPU intensive.")
(defvar nnheader-file-name-translation-alist
(let ((case-fold-search t))
(cond
- ((string-match "windows-nt\\|os/2\\|
emx\\|
cygwin"
+ ((string-match "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
(append (mapcar (lambda (c) (cons c ?_))
'(?: ?* ?\" ?< ?> ??))
(symbol-name system-type))
(append (mapcar (lambda (c) (cons c ?_))
'(?: ?* ?\" ?< ?> ??))
@@
-111,11
+121,9
@@
on your system, you could say something like:
(string-to-char (substring (file-name-as-directory ".") -1))
"*A character used to a directory separator.")
(string-to-char (substring (file-name-as-directory ".") -1))
"*A character used to a directory separator.")
-(eval-and-compile
- (autoload 'nnmail-message-id "nnmail")
- (autoload 'mail-position-on-field "sendmail")
- (autoload 'message-remove-header "message")
- (autoload 'gnus-buffer-live-p "gnus-util"))
+(autoload 'nnmail-message-id "nnmail")
+(autoload 'mail-position-on-field "sendmail")
+(autoload 'gnus-buffer-live-p "gnus-util")
;;; Header access macros.
;;; Header access macros.
@@
-248,6
+256,8
@@
on your system, you could say something like:
(skip-chars-forward " \t")
(buffer-substring (point) (point-at-eol)))
(skip-chars-forward " \t")
(buffer-substring (point) (point-at-eol)))
+(autoload 'ietf-drums-unfold-fws "ietf-drums")
+
(defun nnheader-parse-naked-head (&optional number)
;; This function unfolds continuation lines in this buffer
;; destructively. When this side effect is unwanted, use
(defun nnheader-parse-naked-head (&optional number)
;; This function unfolds continuation lines in this buffer
;; destructively. When this side effect is unwanted, use
@@
-355,15
+365,13
@@
on your system, you could say something like:
(setq num 0
beg (point-min)
end (point-max))
(setq num 0
beg (point-min)
end (point-max))
- (goto-char (point-min))
;; Search to the beginning of the next header. Error
;; messages do not begin with 2 or 3.
(when (re-search-forward "^[23][0-9]+ " nil t)
;; Search to the beginning of the next header. Error
;; messages do not begin with 2 or 3.
(when (re-search-forward "^[23][0-9]+ " nil t)
- (end-of-line)
(setq num (read cur)
beg (point)
end (if (search-forward "\n.\n" nil t)
(setq num (read cur)
beg (point)
end (if (search-forward "\n.\n" nil t)
- (
- (point) 2
)
+ (
goto-char (- (point) 2)
)
(point)))))
(with-temp-buffer
(insert-buffer-substring cur beg end)
(point)))))
(with-temp-buffer
(insert-buffer-substring cur beg end)
@@
-395,7
+403,8
@@
on your system, you could say something like:
out)))
out))
out)))
out))
-(defvar nnheader-uniquify-message-id nil)
+(eval-and-compile
+ (defvar nnheader-uniquify-message-id nil))
(defmacro nnheader-nov-read-message-id (&optional number)
`(let ((id (nnheader-nov-field)))
(defmacro nnheader-nov-read-message-id (&optional number)
`(let ((id (nnheader-nov-field)))
@@
-452,7
+461,7
@@
on your system, you could say something like:
(let ((extra (mail-header-extra header)))
(while extra
(insert (symbol-name (caar extra))
(let ((extra (mail-header-extra header)))
(while extra
(insert (symbol-name (caar extra))
- ": " (
cdar extra
) "\t")
+ ": " (
if (stringp (cdar extra)) (cdar extra) ""
) "\t")
(pop extra))))
(insert "\n")
(backward-char 1)
(pop extra))))
(insert "\n")
(backward-char 1)
@@
-559,19
+568,16
@@
the line could be found."
(defvar nntp-server-buffer nil)
(defvar nntp-process-response nil)
(defvar nntp-server-buffer nil)
(defvar nntp-process-response nil)
-(defvar news-reply-yank-from nil)
-(defvar news-reply-yank-message-id nil)
(defvar nnheader-callback-function nil)
(defun nnheader-init-server-buffer ()
"Initialize the Gnus-backend communication buffer."
(defvar nnheader-callback-function nil)
(defun nnheader-init-server-buffer ()
"Initialize the Gnus-backend communication buffer."
- (save-excursion
- (unless (gnus-buffer-live-p nntp-server-buffer)
- (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
- (set-buffer nntp-server-buffer)
- (mm-enable-multibyte)
+ (unless (gnus-buffer-live-p nntp-server-buffer)
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(erase-buffer)
+ (mm-enable-multibyte)
(kill-all-local-variables)
(setq case-fold-search t) ;Should ignore case.
(set (make-local-variable 'nntp-process-response) nil)
(kill-all-local-variables)
(setq case-fold-search t) ;Should ignore case.
(set (make-local-variable 'nntp-process-response) nil)
@@
-653,8
+659,12
@@
the line could be found."
;; without inserting extra newline.
(fill-region-as-paragraph begin (1+ (point))))))
;; without inserting extra newline.
(fill-region-as-paragraph begin (1+ (point))))))
+(declare-function message-remove-header "message"
+ (header &optional is-regexp first reverse))
+
(defun nnheader-replace-header (header new-value)
"Remove HEADER and insert the NEW-VALUE."
(defun nnheader-replace-header (header new-value)
"Remove HEADER and insert the NEW-VALUE."
+ (require 'message)
(save-excursion
(save-restriction
(nnheader-narrow-to-headers)
(save-excursion
(save-restriction
(nnheader-narrow-to-headers)
@@
-695,7
+705,6
@@
the line could be found."
(erase-buffer))
(current-buffer))
(erase-buffer))
(current-buffer))
-(eval-when-compile (defvar jka-compr-compression-info-list))
(defvar nnheader-numerical-files
(if (boundp 'jka-compr-compression-info-list)
(concat "\\([0-9]+\\)\\("
(defvar nnheader-numerical-files
(if (boundp 'jka-compr-compression-info-list)
(concat "\\([0-9]+\\)\\("
@@
-773,8
+782,7
@@
If FULL, translate everything."
;; We translate -- but only the file name. We leave the directory
;; alone.
(if (and (featurep 'xemacs)
;; We translate -- but only the file name. We leave the directory
;; alone.
(if (and (featurep 'xemacs)
- (memq system-type '(cygwin32 win32 w32 mswindows windows-nt
- cygwin)))
+ (memq system-type '(windows-nt cygwin)))
;; This is needed on NT and stuff, because
;; file-name-nondirectory is not enough to split
;; file names, containing ':', e.g.
;; This is needed on NT and stuff, because
;; file-name-nondirectory is not enough to split
;; file names, containing ':', e.g.
@@
-812,19
+820,22
@@
The first string in ARGS can be a format string."
(apply 'format args)))
nil)
(apply 'format args)))
nil)
-(defun nnheader-get-report (backend)
+(defun nnheader-get-report
-string
(backend)
"Get the most recent report from BACKEND."
(condition-case ()
"Get the most recent report from BACKEND."
(condition-case ()
- (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
- backend))))
- (error (nnheader-message 5 ""))))
+ (format "%s" (symbol-value (intern (format "%s-status-string"
+ backend))))
+ (error "")))
+
+(defun nnheader-get-report (backend)
+ "Get the most recent report from BACKEND."
+ (nnheader-message 5 (nnheader-get-report-string backend)))
(defun nnheader-insert (format &rest args)
"Clear the communication buffer and insert FORMAT and ARGS into the buffer.
If FORMAT isn't a format string, it and all ARGS will be inserted
without formatting."
(defun nnheader-insert (format &rest args)
"Clear the communication buffer and insert FORMAT and ARGS into the buffer.
If FORMAT isn't a format string, it and all ARGS will be inserted
without formatting."
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(if (string-match "%" format)
(insert (apply 'format format args))
(erase-buffer)
(if (string-match "%" format)
(insert (apply 'format format args))
@@
-866,7
+877,9
@@
without formatting."
"Message if the Gnus backends are talkative."
(if (or (not (numberp gnus-verbose-backends))
(<= level gnus-verbose-backends))
"Message if the Gnus backends are talkative."
(if (or (not (numberp gnus-verbose-backends))
(<= level gnus-verbose-backends))
- (apply 'message args)
+ (if gnus-add-timestamp-to-message
+ (apply 'gnus-message-with-timestamp args)
+ (apply 'message args))
(apply 'format args)))
(defun nnheader-be-verbose (level)
(apply 'format args)))
(defun nnheader-be-verbose (level)
@@
-936,9
+949,8
@@
first. Otherwise, find the newest one, though it may take a time."
(car results)
(car (sort results 'file-newer-than-file-p)))))
(car results)
(car (sort results 'file-newer-than-file-p)))))
-(eval-when-compile
- (defvar ange-ftp-path-format)
- (defvar efs-path-regexp))
+(defvar ange-ftp-path-format)
+(defvar efs-path-regexp)
(defun nnheader-re-read-dir (path)
"Re-read directory PATH if PATH is on a remote system."
(if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
(defun nnheader-re-read-dir (path)
"Re-read directory PATH if PATH is on a remote system."
(if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
@@
-983,17
+995,18
@@
find-file-hooks, etc.
(defun nnheader-find-file-noselect (&rest args)
"Open a file with some variables bound.
See `find-file-noselect' for the arguments."
(defun nnheader-find-file-noselect (&rest args)
"Open a file with some variables bound.
See `find-file-noselect' for the arguments."
- (let* ((format-alist nil)
- (auto-mode-alist (mm-auto-mode-alist))
- (default-major-mode 'fundamental-mode)
- (enable-local-variables nil)
- (after-insert-file-functions nil)
- (enable-local-eval nil)
- (coding-system-for-read nnheader-file-coding-system)
- (ffh (if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
- (val (symbol-value ffh)))
+ (letf* ((format-alist nil)
+ (auto-mode-alist (mm-auto-mode-alist))
+ ((default-value 'major-mode) 'fundamental-mode)
+ (enable-local-variables nil)
+ (after-insert-file-functions nil)
+ (enable-local-eval nil)
+ (coding-system-for-read nnheader-file-coding-system)
+ (version-control 'never)
+ (ffh (if (boundp 'find-file-hook)
+ 'find-file-hook
+ 'find-file-hooks))
+ (val (symbol-value ffh)))
(set ffh nil)
(unwind-protect
(apply 'find-file-noselect args)
(set ffh nil)
(unwind-protect
(apply 'find-file-noselect args)
@@
-1053,8
+1066,9
@@
See `find-file-noselect' for the arguments."
(defalias 'nnheader-cancel-timer 'cancel-timer)
(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
(defalias 'nnheader-cancel-timer 'cancel-timer)
(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
-(defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
+;; When changing this function, consider changing `pop3-accept-process-output'
+;; as well.
(defun nnheader-accept-process-output (process)
(accept-process-output
process
(defun nnheader-accept-process-output (process)
(accept-process-output
process
@@
-1063,6
+1077,26
@@
See `find-file-noselect' for the arguments."
(truncate nnheader-read-timeout))
1000))))
(truncate nnheader-read-timeout))
1000))))
+(defun nnheader-update-marks-actions (backend-marks actions)
+ (dolist (action actions)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (dolist (mark marks)
+ (setq backend-marks
+ (gnus-update-alist-soft
+ mark
+ (cond
+ ((eq what 'add)
+ (gnus-range-add (cdr (assoc mark backend-marks)) range))
+ ((eq what 'del)
+ (gnus-remove-from-range
+ (cdr (assoc mark backend-marks)) range))
+ ((eq what 'set)
+ range))
+ backend-marks)))))
+ backend-marks)
+
(when (featurep 'xemacs)
(require 'nnheaderxm))
(when (featurep 'xemacs)
(require 'nnheaderxm))
@@
-1070,5
+1104,4
@@
See `find-file-noselect' for the arguments."
(provide 'nnheader)
(provide 'nnheader)
-;;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202
;;; nnheader.el ends here
;;; nnheader.el ends here