1 |
;;; nnheader.el --- header access macros for Gnus and its backends |
;;; nnheader.el --- header access macros for Gnus and its backends |
2 |
|
|
3 |
;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, |
;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, |
4 |
;; 1997, 1998, 2000, 2001 |
;; 1997, 1998, 2000, 2001, 2002, 2003 |
5 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
6 |
|
|
7 |
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
8 |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
;; Lars Magne Ingebrigtsen <larsi@gnus.org> |
9 |
;; Keywords: news |
;; Keywords: news |
10 |
|
|
11 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
33 |
|
|
34 |
;; Requiring `gnus-util' at compile time creates a circular |
;; Requiring `gnus-util' at compile time creates a circular |
35 |
;; dependency between nnheader.el and gnus-util.el. |
;; dependency between nnheader.el and gnus-util.el. |
36 |
;(eval-when-compile (require 'gnus-util)) |
;;(eval-when-compile (require 'gnus-util)) |
37 |
|
|
38 |
(require 'mail-utils) |
(require 'mail-utils) |
39 |
(require 'mm-util) |
(require 'mm-util) |
40 |
|
(require 'gnus-util) |
41 |
(eval-and-compile |
(eval-and-compile |
42 |
|
(autoload 'gnus-sorted-intersection "gnus-range") |
43 |
(autoload 'gnus-intersection "gnus-range") |
(autoload 'gnus-intersection "gnus-range") |
44 |
(autoload 'gnus-sorted-complement "gnus-range")) |
(autoload 'gnus-sorted-complement "gnus-range") |
45 |
|
(autoload 'gnus-sorted-difference "gnus-range")) |
46 |
|
|
47 |
|
(defcustom gnus-verbose-backends 7 |
48 |
|
"Integer that says how verbose the Gnus backends should be. |
49 |
|
The higher the number, the more messages the Gnus backends will flash |
50 |
|
to say what it's doing. At zero, the Gnus backends will be totally |
51 |
|
mute; at five, they will display most important messages; and at ten, |
52 |
|
they will keep on jabbering all the time." |
53 |
|
:group 'gnus-start |
54 |
|
:type 'integer) |
55 |
|
|
56 |
|
(defcustom gnus-nov-is-evil nil |
57 |
|
"If non-nil, Gnus backends will never output headers in the NOV format." |
58 |
|
:group 'gnus-server |
59 |
|
:type 'boolean) |
60 |
|
|
61 |
(defvar nnheader-max-head-length 4096 |
(defvar nnheader-max-head-length 4096 |
62 |
"*Max length of the head of articles.") |
"*Max length of the head of articles. |
63 |
|
|
64 |
|
Value is an integer, nil, or t. nil means read in chunks of a file |
65 |
|
indefinitely until a complete head is found\; t means always read the |
66 |
|
entire file immediately, disregarding `nnheader-head-chop-length'. |
67 |
|
|
68 |
|
Integer values will in effect be rounded up to the nearest multiple of |
69 |
|
`nnheader-head-chop-length'.") |
70 |
|
|
71 |
(defvar nnheader-head-chop-length 2048 |
(defvar nnheader-head-chop-length 2048 |
72 |
"*Length of each read operation when trying to fetch HEAD headers.") |
"*Length of each read operation when trying to fetch HEAD headers.") |
73 |
|
|
74 |
|
(defvar nnheader-read-timeout |
75 |
|
(if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" |
76 |
|
(symbol-name system-type)) |
77 |
|
1.0 ; why? |
78 |
|
0.1) |
79 |
|
"How long nntp should wait between checking for the end of output. |
80 |
|
Shorter values mean quicker response, but are more CPU intensive.") |
81 |
|
|
82 |
(defvar nnheader-file-name-translation-alist |
(defvar nnheader-file-name-translation-alist |
83 |
(let ((case-fold-search t)) |
(let ((case-fold-search t)) |
84 |
(cond |
(cond |
85 |
((string-match "windows-nt\\|os/2\\|emx\\|cygwin32" |
((string-match "windows-nt\\|os/2\\|emx\\|cygwin" |
86 |
(symbol-name system-type)) |
(symbol-name system-type)) |
87 |
(append (mapcar (lambda (c) (cons c ?_)) |
(append (mapcar (lambda (c) (cons c ?_)) |
88 |
'(?: ?* ?\" ?< ?> ??)) |
'(?: ?* ?\" ?< ?> ??)) |
89 |
(if (string-match "windows-nt\\|cygwin32" |
(if (string-match "windows-nt\\|cygwin" |
90 |
(symbol-name system-type)) |
(symbol-name system-type)) |
91 |
nil |
nil |
92 |
'((?+ . ?-))))) |
'((?+ . ?-))))) |
97 |
|
|
98 |
\(setq nnheader-file-name-translation-alist '((?: . ?_)))") |
\(setq nnheader-file-name-translation-alist '((?: . ?_)))") |
99 |
|
|
100 |
|
(defvar nnheader-directory-separator-character |
101 |
|
(string-to-char (substring (file-name-as-directory ".") -1)) |
102 |
|
"*A character used to a directory separator.") |
103 |
|
|
104 |
(eval-and-compile |
(eval-and-compile |
105 |
(autoload 'nnmail-message-id "nnmail") |
(autoload 'nnmail-message-id "nnmail") |
106 |
(autoload 'mail-position-on-field "sendmail") |
(autoload 'mail-position-on-field "sendmail") |
107 |
(autoload 'message-remove-header "message") |
(autoload 'message-remove-header "message") |
108 |
(autoload 'gnus-point-at-eol "gnus-util") |
(autoload 'gnus-point-at-eol "gnus-util") |
|
(autoload 'gnus-delete-line "gnus-util" nil nil 'macro) |
|
109 |
(autoload 'gnus-buffer-live-p "gnus-util")) |
(autoload 'gnus-buffer-live-p "gnus-util")) |
110 |
|
|
111 |
;;; Header access macros. |
;;; Header access macros. |
221 |
(concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) |
(concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) |
222 |
|
|
223 |
(defsubst nnheader-fake-message-id-p (id) |
(defsubst nnheader-fake-message-id-p (id) |
224 |
(save-match-data ; regular message-id's are <.*> |
(save-match-data ; regular message-id's are <.*> |
225 |
(string-match "\\`fake\\+none\\+[0-9]+\\'" id))) |
(string-match "\\`fake\\+none\\+[0-9]+\\'" id))) |
226 |
|
|
227 |
;; Parsing headers and NOV lines. |
;; Parsing headers and NOV lines. |
228 |
|
|
229 |
|
(defsubst nnheader-remove-cr-followed-by-lf () |
230 |
|
(goto-char (point-max)) |
231 |
|
(while (search-backward "\r\n" nil t) |
232 |
|
(delete-char 1))) |
233 |
|
|
234 |
(defsubst nnheader-header-value () |
(defsubst nnheader-header-value () |
235 |
(buffer-substring (match-end 0) (gnus-point-at-eol))) |
(skip-chars-forward " \t") |
236 |
|
(buffer-substring (point) (gnus-point-at-eol))) |
237 |
|
|
238 |
(defun nnheader-parse-head (&optional naked) |
(defun nnheader-parse-naked-head (&optional number) |
239 |
|
;; This function unfolds continuation lines in this buffer |
240 |
|
;; destructively. When this side effect is unwanted, use |
241 |
|
;; `nnheader-parse-head' instead of this function. |
242 |
(let ((case-fold-search t) |
(let ((case-fold-search t) |
|
(cur (current-buffer)) |
|
243 |
(buffer-read-only nil) |
(buffer-read-only nil) |
244 |
in-reply-to lines p ref) |
(cur (current-buffer)) |
245 |
(goto-char (point-min)) |
(p (point-min)) |
246 |
(when naked |
in-reply-to lines ref) |
247 |
(insert "\n")) |
(nnheader-remove-cr-followed-by-lf) |
248 |
;; Search to the beginning of the next header. Error messages |
(ietf-drums-unfold-fws) |
249 |
;; do not begin with 2 or 3. |
(subst-char-in-region (point-min) (point-max) ?\t ? ) |
250 |
|
(goto-char p) |
251 |
|
(insert "\n") |
252 |
(prog1 |
(prog1 |
253 |
(when (or naked (re-search-forward "^[23][0-9]+ " nil t)) |
;; This implementation of this function, with nine |
254 |
;; This implementation of this function, with nine |
;; search-forwards instead of the one re-search-forward and a |
255 |
;; search-forwards instead of the one re-search-forward and |
;; case (which basically was the old function) is actually |
256 |
;; a case (which basically was the old function) is actually |
;; about twice as fast, even though it looks messier. You |
257 |
;; about twice as fast, even though it looks messier. You |
;; can't have everything, I guess. Speed and elegance don't |
258 |
;; can't have everything, I guess. Speed and elegance |
;; always go hand in hand. |
259 |
;; don't always go hand in hand. |
(vector |
260 |
(vector |
;; Number. |
261 |
;; Number. |
(or number 0) |
262 |
(if naked |
;; Subject. |
263 |
(progn |
(progn |
264 |
(setq p (point-min)) |
(goto-char p) |
265 |
0) |
(if (search-forward "\nsubject:" nil t) |
266 |
(prog1 |
(nnheader-header-value) "(none)")) |
267 |
(read cur) |
;; From. |
268 |
(end-of-line) |
(progn |
269 |
(setq p (point)) |
(goto-char p) |
270 |
(narrow-to-region (point) |
(if (search-forward "\nfrom:" nil t) |
271 |
(or (and (search-forward "\n.\n" nil t) |
(nnheader-header-value) "(nobody)")) |
272 |
(- (point) 2)) |
;; Date. |
273 |
(point))))) |
(progn |
274 |
;; Subject. |
(goto-char p) |
275 |
(progn |
(if (search-forward "\ndate:" nil t) |
276 |
(goto-char p) |
(nnheader-header-value) "")) |
277 |
(if (search-forward "\nsubject: " nil t) |
;; Message-ID. |
278 |
(nnheader-header-value) "(none)")) |
(progn |
279 |
;; From. |
(goto-char p) |
280 |
(progn |
(if (search-forward "\nmessage-id:" nil t) |
281 |
(goto-char p) |
(buffer-substring |
282 |
(if (or (search-forward "\nfrom: " nil t) |
(1- (or (search-forward "<" (gnus-point-at-eol) t) |
283 |
(search-forward "\nfrom:" nil t)) |
(point))) |
284 |
(nnheader-header-value) "(nobody)")) |
(or (search-forward ">" (gnus-point-at-eol) t) (point))) |
285 |
;; Date. |
;; If there was no message-id, we just fake one to make |
286 |
(progn |
;; subsequent routines simpler. |
287 |
(goto-char p) |
(nnheader-generate-fake-message-id))) |
288 |
(if (search-forward "\ndate: " nil t) |
;; References. |
289 |
(nnheader-header-value) "")) |
(progn |
290 |
;; Message-ID. |
(goto-char p) |
291 |
(progn |
(if (search-forward "\nreferences:" nil t) |
292 |
(goto-char p) |
(nnheader-header-value) |
293 |
(if (search-forward "\nmessage-id:" nil t) |
;; Get the references from the in-reply-to header if |
294 |
(buffer-substring |
;; there were no references and the in-reply-to header |
295 |
(1- (or (search-forward "<" (gnus-point-at-eol) t) |
;; looks promising. |
296 |
(point))) |
(if (and (search-forward "\nin-reply-to:" nil t) |
297 |
(or (search-forward ">" (gnus-point-at-eol) t) (point))) |
(setq in-reply-to (nnheader-header-value)) |
298 |
;; If there was no message-id, we just fake one to make |
(string-match "<[^\n>]+>" in-reply-to)) |
299 |
;; subsequent routines simpler. |
(let (ref2) |
300 |
(nnheader-generate-fake-message-id))) |
(setq ref (substring in-reply-to (match-beginning 0) |
301 |
;; References. |
(match-end 0))) |
302 |
(progn |
(while (string-match "<[^\n>]+>" |
303 |
(goto-char p) |
in-reply-to (match-end 0)) |
304 |
(if (search-forward "\nreferences: " nil t) |
(setq ref2 (substring in-reply-to (match-beginning 0) |
305 |
(nnheader-header-value) |
(match-end 0))) |
306 |
;; Get the references from the in-reply-to header if there |
(when (> (length ref2) (length ref)) |
307 |
;; were no references and the in-reply-to header looks |
(setq ref ref2))) |
308 |
;; promising. |
ref) |
309 |
(if (and (search-forward "\nin-reply-to: " nil t) |
nil))) |
310 |
(setq in-reply-to (nnheader-header-value)) |
;; Chars. |
311 |
(string-match "<[^\n>]+>" in-reply-to)) |
0 |
312 |
(let (ref2) |
;; Lines. |
313 |
(setq ref (substring in-reply-to (match-beginning 0) |
(progn |
314 |
(match-end 0))) |
(goto-char p) |
315 |
(while (string-match "<[^\n>]+>" |
(if (search-forward "\nlines: " nil t) |
316 |
in-reply-to (match-end 0)) |
(if (numberp (setq lines (read cur))) |
317 |
(setq ref2 (substring in-reply-to (match-beginning 0) |
lines 0) |
318 |
(match-end 0))) |
0)) |
319 |
(when (> (length ref2) (length ref)) |
;; Xref. |
320 |
(setq ref ref2))) |
(progn |
321 |
ref) |
(goto-char p) |
322 |
nil))) |
(and (search-forward "\nxref:" nil t) |
323 |
;; Chars. |
(nnheader-header-value))) |
324 |
0 |
;; Extra. |
325 |
;; Lines. |
(when nnmail-extra-headers |
326 |
(progn |
(let ((extra nnmail-extra-headers) |
327 |
(goto-char p) |
out) |
328 |
(if (search-forward "\nlines: " nil t) |
(while extra |
329 |
(if (numberp (setq lines (read cur))) |
(goto-char p) |
330 |
lines 0) |
(when (search-forward |
331 |
0)) |
(concat "\n" (symbol-name (car extra)) ":") nil t) |
332 |
;; Xref. |
(push (cons (car extra) (nnheader-header-value)) |
333 |
(progn |
out)) |
334 |
(goto-char p) |
(pop extra)) |
335 |
(and (search-forward "\nxref: " nil t) |
out))) |
336 |
(nnheader-header-value))) |
(goto-char p) |
337 |
|
(delete-char 1)))) |
338 |
;; Extra. |
|
339 |
(when nnmail-extra-headers |
(defun nnheader-parse-head (&optional naked) |
340 |
(let ((extra nnmail-extra-headers) |
(let ((cur (current-buffer)) num beg end) |
341 |
out) |
(when (if naked |
342 |
(while extra |
(setq num 0 |
343 |
(goto-char p) |
beg (point-min) |
344 |
(when (search-forward |
end (point-max)) |
345 |
(concat "\n" (symbol-name (car extra)) ": ") nil t) |
(goto-char (point-min)) |
346 |
(push (cons (car extra) (nnheader-header-value)) |
;; Search to the beginning of the next header. Error |
347 |
out)) |
;; messages do not begin with 2 or 3. |
348 |
(pop extra)) |
(when (re-search-forward "^[23][0-9]+ " nil t) |
349 |
out)))) |
(end-of-line) |
350 |
(when naked |
(setq num (read cur) |
351 |
(goto-char (point-min)) |
beg (point) |
352 |
(delete-char 1))))) |
end (if (search-forward "\n.\n" nil t) |
353 |
|
(- (point) 2) |
354 |
|
(point))))) |
355 |
|
(with-temp-buffer |
356 |
|
(insert-buffer-substring cur beg end) |
357 |
|
(nnheader-parse-naked-head num))))) |
358 |
|
|
359 |
(defmacro nnheader-nov-skip-field () |
(defmacro nnheader-nov-skip-field () |
360 |
'(search-forward "\t" eol 'move)) |
'(search-forward "\t" eol 'move)) |
439 |
(delete-char 1)) |
(delete-char 1)) |
440 |
(forward-line 1))) |
(forward-line 1))) |
441 |
|
|
442 |
|
(defun nnheader-parse-overview-file (file) |
443 |
|
"Parse FILE and return a list of headers." |
444 |
|
(mm-with-unibyte-buffer |
445 |
|
(nnheader-insert-file-contents file) |
446 |
|
(goto-char (point-min)) |
447 |
|
(let (headers) |
448 |
|
(while (not (eobp)) |
449 |
|
(push (nnheader-parse-nov) headers) |
450 |
|
(forward-line 1)) |
451 |
|
(nreverse headers)))) |
452 |
|
|
453 |
|
(defun nnheader-write-overview-file (file headers) |
454 |
|
"Write HEADERS to FILE." |
455 |
|
(with-temp-file file |
456 |
|
(mapcar 'nnheader-insert-nov headers))) |
457 |
|
|
458 |
(defun nnheader-insert-header (header) |
(defun nnheader-insert-header (header) |
459 |
(insert |
(insert |
460 |
"Subject: " (or (mail-header-subject header) "(none)") "\n" |
"Subject: " (or (mail-header-subject header) "(none)") "\n" |
498 |
(prev (point-min)) |
(prev (point-min)) |
499 |
num found) |
num found) |
500 |
(while (not found) |
(while (not found) |
501 |
(goto-char (/ (+ max min) 2)) |
(goto-char (+ min (/ (- max min) 2))) |
502 |
(beginning-of-line) |
(beginning-of-line) |
503 |
(if (or (= (point) prev) |
(if (or (= (point) prev) |
504 |
(eobp)) |
(eobp)) |
537 |
;; Various cruft the backends and Gnus need to communicate. |
;; Various cruft the backends and Gnus need to communicate. |
538 |
|
|
539 |
(defvar nntp-server-buffer nil) |
(defvar nntp-server-buffer nil) |
540 |
(defvar gnus-verbose-backends 7 |
(defvar nntp-process-response nil) |
|
"*A number that says how talkative the Gnus backends should be.") |
|
|
(defvar gnus-nov-is-evil nil |
|
|
"If non-nil, Gnus backends will never output headers in the NOV format.") |
|
541 |
(defvar news-reply-yank-from nil) |
(defvar news-reply-yank-from nil) |
542 |
(defvar news-reply-yank-message-id nil) |
(defvar news-reply-yank-message-id nil) |
543 |
|
|
553 |
(erase-buffer) |
(erase-buffer) |
554 |
(kill-all-local-variables) |
(kill-all-local-variables) |
555 |
(setq case-fold-search t) ;Should ignore case. |
(setq case-fold-search t) ;Should ignore case. |
556 |
|
(set (make-local-variable 'nntp-process-response) nil) |
557 |
t)) |
t)) |
558 |
|
|
559 |
;;; Various functions the backends use. |
;;; Various functions the backends use. |
608 |
;; This is invalid, but not all articles have Message-IDs. |
;; This is invalid, but not all articles have Message-IDs. |
609 |
() |
() |
610 |
(mail-position-on-field "References") |
(mail-position-on-field "References") |
611 |
(let ((begin (save-excursion (beginning-of-line) (point))) |
(let ((begin (gnus-point-at-bol)) |
612 |
(fill-column 78) |
(fill-column 78) |
613 |
(fill-prefix "\t")) |
(fill-prefix "\t")) |
614 |
(when references |
(when references |
642 |
(point-max))) |
(point-max))) |
643 |
(goto-char (point-min))) |
(goto-char (point-min))) |
644 |
|
|
645 |
|
(defun nnheader-remove-body () |
646 |
|
"Remove the body from an article in this current buffer." |
647 |
|
(goto-char (point-min)) |
648 |
|
(when (re-search-forward "\n\r?\n" nil t) |
649 |
|
(delete-region (point) (point-max)))) |
650 |
|
|
651 |
(defun nnheader-set-temp-buffer (name &optional noerase) |
(defun nnheader-set-temp-buffer (name &optional noerase) |
652 |
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." |
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." |
653 |
(set-buffer (get-buffer-create name)) |
(set-buffer (get-buffer-create name)) |
679 |
(string-match nnheader-numerical-short-files file) |
(string-match nnheader-numerical-short-files file) |
680 |
(string-to-int (match-string 0 file)))) |
(string-to-int (match-string 0 file)))) |
681 |
|
|
682 |
|
(defvar nnheader-directory-files-is-safe |
683 |
|
(or (eq system-type 'windows-nt) |
684 |
|
(and (not (featurep 'xemacs)) |
685 |
|
(> emacs-major-version 20))) |
686 |
|
"If non-nil, Gnus believes `directory-files' is safe. |
687 |
|
It has been reported numerous times that `directory-files' fails with |
688 |
|
an alarming frequency on NFS mounted file systems. If it is nil, |
689 |
|
`nnheader-directory-files-safe' is used.") |
690 |
|
|
691 |
(defun nnheader-directory-files-safe (&rest args) |
(defun nnheader-directory-files-safe (&rest args) |
692 |
;; It has been reported numerous times that `directory-files' |
"Execute `directory-files' twice and returns the longer result." |
|
;; fails with an alarming frequency on NFS mounted file systems. |
|
|
;; This function executes that function twice and returns |
|
|
;; the longest result. |
|
693 |
(let ((first (apply 'directory-files args)) |
(let ((first (apply 'directory-files args)) |
694 |
(second (apply 'directory-files args))) |
(second (apply 'directory-files args))) |
695 |
(if (> (length first) (length second)) |
(if (> (length first) (length second)) |
699 |
(defun nnheader-directory-articles (dir) |
(defun nnheader-directory-articles (dir) |
700 |
"Return a list of all article files in directory DIR." |
"Return a list of all article files in directory DIR." |
701 |
(mapcar 'nnheader-file-to-number |
(mapcar 'nnheader-file-to-number |
702 |
(nnheader-directory-files-safe |
(if nnheader-directory-files-is-safe |
703 |
dir nil nnheader-numerical-short-files t))) |
(directory-files |
704 |
|
dir nil nnheader-numerical-short-files t) |
705 |
|
(nnheader-directory-files-safe |
706 |
|
dir nil nnheader-numerical-short-files t)))) |
707 |
|
|
708 |
(defun nnheader-article-to-file-alist (dir) |
(defun nnheader-article-to-file-alist (dir) |
709 |
"Return an alist of article/file pairs in DIR." |
"Return an alist of article/file pairs in DIR." |
710 |
(mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) |
(mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) |
711 |
(nnheader-directory-files-safe |
(if nnheader-directory-files-is-safe |
712 |
dir nil nnheader-numerical-short-files t))) |
(directory-files |
713 |
|
dir nil nnheader-numerical-short-files t) |
714 |
|
(nnheader-directory-files-safe |
715 |
|
dir nil nnheader-numerical-short-files t)))) |
716 |
|
|
717 |
(defun nnheader-fold-continuation-lines () |
(defun nnheader-fold-continuation-lines () |
718 |
"Fold continuation lines in the current buffer." |
"Fold continuation lines in the current buffer." |
735 |
;; We translate -- but only the file name. We leave the directory |
;; We translate -- but only the file name. We leave the directory |
736 |
;; alone. |
;; alone. |
737 |
(if (and (featurep 'xemacs) |
(if (and (featurep 'xemacs) |
738 |
(memq system-type '(win32 w32 mswindows windows-nt cygwin))) |
(memq system-type '(cygwin32 win32 w32 mswindows windows-nt |
739 |
|
cygwin))) |
740 |
;; This is needed on NT and stuff, because |
;; This is needed on NT and stuff, because |
741 |
;; file-name-nondirectory is not enough to split |
;; file-name-nondirectory is not enough to split |
742 |
;; file names, containing ':', e.g. |
;; file names, containing ':', e.g. |
793 |
(apply 'insert format args)) |
(apply 'insert format args)) |
794 |
t)) |
t)) |
795 |
|
|
796 |
(eval-and-compile |
(defsubst nnheader-replace-chars-in-string (string from to) |
797 |
(if (fboundp 'subst-char-in-string) |
(mm-subst-char-in-string from to string)) |
|
(defsubst nnheader-replace-chars-in-string (string from to) |
|
|
(subst-char-in-string from to string)) |
|
|
(defun nnheader-replace-chars-in-string (string from to) |
|
|
"Replace characters in STRING from FROM to TO." |
|
|
(let ((string (substring string 0)) ;Copy string. |
|
|
(len (length string)) |
|
|
(idx 0)) |
|
|
;; Replace all occurrences of FROM with TO. |
|
|
(while (< idx len) |
|
|
(when (= (aref string idx) from) |
|
|
(aset string idx to)) |
|
|
(setq idx (1+ idx))) |
|
|
string)))) |
|
798 |
|
|
799 |
(defun nnheader-replace-duplicate-chars-in-string (string from to) |
(defun nnheader-replace-duplicate-chars-in-string (string from to) |
800 |
"Replace characters in STRING from FROM to TO." |
"Replace characters in STRING from FROM to TO." |
822 |
(expand-file-name |
(expand-file-name |
823 |
(file-name-as-directory top)))) |
(file-name-as-directory top)))) |
824 |
(error ""))) |
(error ""))) |
825 |
?/ ?.)) |
nnheader-directory-separator-character ?.)) |
826 |
|
|
827 |
(defun nnheader-message (level &rest args) |
(defun nnheader-message (level &rest args) |
828 |
"Message if the Gnus backends are talkative." |
"Message if the Gnus backends are talkative." |
836 |
(or (not (numberp gnus-verbose-backends)) |
(or (not (numberp gnus-verbose-backends)) |
837 |
(<= level gnus-verbose-backends))) |
(<= level gnus-verbose-backends))) |
838 |
|
|
839 |
(defvar nnheader-pathname-coding-system 'binary |
(defvar nnheader-pathname-coding-system 'iso-8859-1 |
840 |
"*Coding system for file names.") |
"*Coding system for file name.") |
841 |
|
|
842 |
(defun nnheader-group-pathname (group dir &optional file) |
(defun nnheader-group-pathname (group dir &optional file) |
843 |
"Make file name for GROUP." |
"Make file name for GROUP." |
850 |
;; If not, we translate dots into slashes. |
;; If not, we translate dots into slashes. |
851 |
(expand-file-name (mm-encode-coding-string |
(expand-file-name (mm-encode-coding-string |
852 |
(nnheader-replace-chars-in-string group ?. ?/) |
(nnheader-replace-chars-in-string group ?. ?/) |
853 |
nnheader-pathname-coding-system) |
nnheader-pathname-coding-system) |
854 |
dir)))) |
dir)))) |
855 |
(cond ((null file) "") |
(cond ((null file) "") |
856 |
((numberp file) (int-to-string file)) |
((numberp file) (int-to-string file)) |
857 |
(t file)))) |
(t file)))) |
858 |
|
|
|
(defun nnheader-functionp (form) |
|
|
"Return non-nil if FORM is funcallable." |
|
|
(or (and (symbolp form) (fboundp form)) |
|
|
(and (listp form) (eq (car form) 'lambda)))) |
|
|
|
|
859 |
(defun nnheader-concat (dir &rest files) |
(defun nnheader-concat (dir &rest files) |
860 |
"Concat DIR as directory to FILES." |
"Concat DIR as directory to FILES." |
861 |
(apply 'concat (file-name-as-directory dir) files)) |
(apply 'concat (file-name-as-directory dir) files)) |
863 |
(defun nnheader-ms-strip-cr () |
(defun nnheader-ms-strip-cr () |
864 |
"Strip ^M from the end of all lines." |
"Strip ^M from the end of all lines." |
865 |
(save-excursion |
(save-excursion |
866 |
(goto-char (point-min)) |
(nnheader-remove-cr-followed-by-lf))) |
|
(while (re-search-forward "\r$" nil t) |
|
|
(delete-backward-char 1)))) |
|
867 |
|
|
868 |
(defun nnheader-file-size (file) |
(defun nnheader-file-size (file) |
869 |
"Return the file size of FILE or 0." |
"Return the file size of FILE or 0." |
870 |
(or (nth 7 (file-attributes file)) 0)) |
(or (nth 7 (file-attributes file)) 0)) |
871 |
|
|
872 |
(defun nnheader-find-etc-directory (package &optional file) |
(defun nnheader-find-etc-directory (package &optional file first) |
873 |
"Go through the path and find the \".../etc/PACKAGE\" directory. |
"Go through `load-path' and find the \"../etc/PACKAGE\" directory. |
874 |
If FILE, find the \".../etc/PACKAGE\" file instead." |
This function will look in the parent directory of each `load-path' |
875 |
|
entry, and look for the \"etc\" directory there. |
876 |
|
If FILE, find the \".../etc/PACKAGE\" file instead. |
877 |
|
If FIRST is non-nil, return the directory or the file found at the |
878 |
|
first. Otherwise, find the newest one, though it may take a time." |
879 |
(let ((path load-path) |
(let ((path load-path) |
880 |
dir result) |
dir results) |
881 |
;; We try to find the dir by looking at the load path, |
;; We try to find the dir by looking at the load path, |
882 |
;; stripping away the last component and adding "etc/". |
;; stripping away the last component and adding "etc/". |
883 |
(while path |
(while path |
889 |
"etc/" package |
"etc/" package |
890 |
(if file "" "/")))) |
(if file "" "/")))) |
891 |
(or file (file-directory-p dir))) |
(or file (file-directory-p dir))) |
892 |
(setq result dir |
(progn |
893 |
path nil) |
(or (member dir results) |
894 |
|
(push dir results)) |
895 |
|
(setq path (if first nil (cdr path)))) |
896 |
(setq path (cdr path)))) |
(setq path (cdr path)))) |
897 |
result)) |
(if (or first (not (cdr results))) |
898 |
|
(car results) |
899 |
|
(car (sort results 'file-newer-than-file-p))))) |
900 |
|
|
901 |
(eval-when-compile |
(eval-when-compile |
902 |
(defvar ange-ftp-path-format) |
(defvar ange-ftp-path-format) |
922 |
(let ((coding-system-for-read nnheader-file-coding-system)) |
(let ((coding-system-for-read nnheader-file-coding-system)) |
923 |
(mm-insert-file-contents filename visit beg end replace))) |
(mm-insert-file-contents filename visit beg end replace))) |
924 |
|
|
925 |
|
(defun nnheader-insert-nov-file (file first) |
926 |
|
(let ((size (nth 7 (file-attributes file))) |
927 |
|
(cutoff (* 32 1024))) |
928 |
|
(when size |
929 |
|
(if (< size cutoff) |
930 |
|
;; If the file is small, we just load it. |
931 |
|
(nnheader-insert-file-contents file) |
932 |
|
;; We start on the assumption that FIRST is pretty recent. If |
933 |
|
;; not, we just insert the rest of the file as well. |
934 |
|
(let (current) |
935 |
|
(nnheader-insert-file-contents file nil (- size cutoff) size) |
936 |
|
(goto-char (point-min)) |
937 |
|
(delete-region (point) (or (search-forward "\n" nil 'move) (point))) |
938 |
|
(setq current (ignore-errors (read (current-buffer)))) |
939 |
|
(if (and (numberp current) |
940 |
|
(< current first)) |
941 |
|
t |
942 |
|
(delete-region (point-min) (point-max)) |
943 |
|
(nnheader-insert-file-contents file))))))) |
944 |
|
|
945 |
(defun nnheader-find-file-noselect (&rest args) |
(defun nnheader-find-file-noselect (&rest args) |
946 |
(let ((format-alist nil) |
(let ((format-alist nil) |
947 |
(auto-mode-alist (mm-auto-mode-alist)) |
(auto-mode-alist (mm-auto-mode-alist)) |
948 |
(default-major-mode 'fundamental-mode) |
(default-major-mode 'fundamental-mode) |
949 |
(enable-local-variables nil) |
(enable-local-variables nil) |
950 |
(after-insert-file-functions nil) |
(after-insert-file-functions nil) |
951 |
(enable-local-eval nil) |
(enable-local-eval nil) |
952 |
(find-file-hooks nil) |
(find-file-hooks nil) |
953 |
(coding-system-for-read nnheader-file-coding-system)) |
(coding-system-for-read nnheader-file-coding-system)) |
1008 |
(defalias 'nnheader-run-at-time 'run-at-time) |
(defalias 'nnheader-run-at-time 'run-at-time) |
1009 |
(defalias 'nnheader-cancel-timer 'cancel-timer) |
(defalias 'nnheader-cancel-timer 'cancel-timer) |
1010 |
(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) |
(defalias 'nnheader-cancel-function-timers 'cancel-function-timers) |
1011 |
|
(defalias 'nnheader-string-as-multibyte 'string-as-multibyte) |
1012 |
|
|
1013 |
|
(defun nnheader-accept-process-output (process) |
1014 |
|
(accept-process-output |
1015 |
|
process |
1016 |
|
(truncate nnheader-read-timeout) |
1017 |
|
(truncate (* (- nnheader-read-timeout |
1018 |
|
(truncate nnheader-read-timeout)) |
1019 |
|
1000)))) |
1020 |
|
|
1021 |
(when (featurep 'xemacs) |
(when (featurep 'xemacs) |
1022 |
(require 'nnheaderxm)) |
(require 'nnheaderxm)) |