Commit | Line | Data |
---|---|---|
41487370 | 1 | ;;; nnheader.el --- header access macros for Gnus and its backends |
231f989b | 2 | ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. |
41487370 LMI |
3 | |
4 | ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | |
5 | ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
6 | ;; Keywords: news | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 2, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
22 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 | ;; Boston, MA 02111-1307, USA. | |
41487370 LMI |
24 | |
25 | ;;; Commentary: | |
26 | ||
231f989b | 27 | ;; These macros may look very much like the ones in GNUS 4.1. They |
41487370 | 28 | ;; are, in a way, but you should note that the indices they use have |
231f989b LMI |
29 | ;; been changed from the internal GNUS format to the NOV format. The |
30 | ;; makes it possible to read headers from XOVER much faster. | |
41487370 LMI |
31 | ;; |
32 | ;; The format of a header is now: | |
33 | ;; [number subject from date id references chars lines xref] | |
34 | ;; | |
35 | ;; (That last entry is defined as "misc" in the NOV format, but Gnus | |
36 | ;; uses it for xrefs.) | |
37 | ||
38 | ;;; Code: | |
39 | ||
231f989b LMI |
40 | (require 'mail-utils) |
41 | (eval-when-compile (require 'cl)) | |
42 | ||
43 | (defvar nnheader-max-head-length 4096 | |
44 | "*Max length of the head of articles.") | |
45 | ||
46 | (defvar nnheader-file-name-translation-alist nil | |
47 | "*Alist that says how to translate characters in file names. | |
48 | For instance, if \":\" is illegal as a file character in file names | |
49 | on your system, you could say something like: | |
50 | ||
51 | \(setq nnheader-file-name-translation-alist '((?: . ?_)))") | |
52 | ||
53 | ;;; Header access macros. | |
54 | ||
41487370 LMI |
55 | (defmacro mail-header-number (header) |
56 | "Return article number in HEADER." | |
231f989b | 57 | `(aref ,header 0)) |
41487370 | 58 | |
41487370 LMI |
59 | (defmacro mail-header-set-number (header number) |
60 | "Set article number of HEADER to NUMBER." | |
231f989b | 61 | `(aset ,header 0 ,number)) |
41487370 | 62 | |
41487370 LMI |
63 | (defmacro mail-header-subject (header) |
64 | "Return subject string in HEADER." | |
231f989b | 65 | `(aref ,header 1)) |
41487370 | 66 | |
41487370 LMI |
67 | (defmacro mail-header-set-subject (header subject) |
68 | "Set article subject of HEADER to SUBJECT." | |
231f989b | 69 | `(aset ,header 1 ,subject)) |
41487370 | 70 | |
41487370 LMI |
71 | (defmacro mail-header-from (header) |
72 | "Return author string in HEADER." | |
231f989b | 73 | `(aref ,header 2)) |
41487370 | 74 | |
41487370 LMI |
75 | (defmacro mail-header-set-from (header from) |
76 | "Set article author of HEADER to FROM." | |
231f989b | 77 | `(aset ,header 2 ,from)) |
41487370 | 78 | |
41487370 LMI |
79 | (defmacro mail-header-date (header) |
80 | "Return date in HEADER." | |
231f989b | 81 | `(aref ,header 3)) |
41487370 | 82 | |
41487370 LMI |
83 | (defmacro mail-header-set-date (header date) |
84 | "Set article date of HEADER to DATE." | |
231f989b | 85 | `(aset ,header 3 ,date)) |
41487370 | 86 | |
231f989b | 87 | (defalias 'mail-header-message-id 'mail-header-id) |
41487370 LMI |
88 | (defmacro mail-header-id (header) |
89 | "Return Id in HEADER." | |
231f989b | 90 | `(aref ,header 4)) |
41487370 | 91 | |
231f989b | 92 | (defalias 'mail-header-set-message-id 'mail-header-set-id) |
41487370 LMI |
93 | (defmacro mail-header-set-id (header id) |
94 | "Set article Id of HEADER to ID." | |
231f989b | 95 | `(aset ,header 4 ,id)) |
41487370 | 96 | |
41487370 LMI |
97 | (defmacro mail-header-references (header) |
98 | "Return references in HEADER." | |
231f989b | 99 | `(aref ,header 5)) |
41487370 | 100 | |
41487370 LMI |
101 | (defmacro mail-header-set-references (header ref) |
102 | "Set article references of HEADER to REF." | |
231f989b | 103 | `(aset ,header 5 ,ref)) |
41487370 | 104 | |
41487370 LMI |
105 | (defmacro mail-header-chars (header) |
106 | "Return number of chars of article in HEADER." | |
231f989b | 107 | `(aref ,header 6)) |
41487370 | 108 | |
41487370 LMI |
109 | (defmacro mail-header-set-chars (header chars) |
110 | "Set number of chars in article of HEADER to CHARS." | |
231f989b | 111 | `(aset ,header 6 ,chars)) |
41487370 | 112 | |
41487370 LMI |
113 | (defmacro mail-header-lines (header) |
114 | "Return lines in HEADER." | |
231f989b | 115 | `(aref ,header 7)) |
41487370 | 116 | |
41487370 LMI |
117 | (defmacro mail-header-set-lines (header lines) |
118 | "Set article lines of HEADER to LINES." | |
231f989b | 119 | `(aset ,header 7 ,lines)) |
41487370 | 120 | |
41487370 LMI |
121 | (defmacro mail-header-xref (header) |
122 | "Return xref string in HEADER." | |
231f989b | 123 | `(aref ,header 8)) |
41487370 | 124 | |
41487370 LMI |
125 | (defmacro mail-header-set-xref (header xref) |
126 | "Set article xref of HEADER to xref." | |
231f989b LMI |
127 | `(aset ,header 8 ,xref)) |
128 | ||
129 | (defun make-mail-header (&optional init) | |
130 | "Create a new mail header structure initialized with INIT." | |
131 | (make-vector 9 init)) | |
132 | ||
133 | ;; Parsing headers and NOV lines. | |
41487370 | 134 | |
231f989b LMI |
135 | (defsubst nnheader-header-value () |
136 | (buffer-substring (match-end 0) (gnus-point-at-eol))) | |
137 | ||
138 | (defvar nnheader-newsgroup-none-id 1) | |
139 | ||
140 | (defun nnheader-parse-head (&optional naked) | |
141 | (let ((case-fold-search t) | |
142 | (cur (current-buffer)) | |
143 | (buffer-read-only nil) | |
144 | end ref in-reply-to lines p) | |
145 | (goto-char (point-min)) | |
146 | (when naked | |
147 | (insert "\n")) | |
148 | ;; Search to the beginning of the next header. Error messages | |
149 | ;; do not begin with 2 or 3. | |
150 | (prog1 | |
151 | (when (or naked (re-search-forward "^[23][0-9]+ " nil t)) | |
152 | ;; This implementation of this function, with nine | |
153 | ;; search-forwards instead of the one re-search-forward and | |
154 | ;; a case (which basically was the old function) is actually | |
155 | ;; about twice as fast, even though it looks messier. You | |
156 | ;; can't have everything, I guess. Speed and elegance | |
157 | ;; doesn't always go hand in hand. | |
158 | (vector | |
159 | ;; Number. | |
160 | (if naked | |
161 | (progn | |
162 | (setq p (point-min)) | |
163 | 0) | |
164 | (prog1 | |
165 | (read cur) | |
166 | (end-of-line) | |
167 | (setq p (point)) | |
168 | (narrow-to-region (point) | |
169 | (or (and (search-forward "\n.\n" nil t) | |
170 | (- (point) 2)) | |
171 | (point))))) | |
172 | ;; Subject. | |
173 | (progn | |
174 | (goto-char p) | |
175 | (if (search-forward "\nsubject: " nil t) | |
176 | (nnheader-header-value) "(none)")) | |
177 | ;; From. | |
178 | (progn | |
179 | (goto-char p) | |
180 | (if (search-forward "\nfrom: " nil t) | |
181 | (nnheader-header-value) "(nobody)")) | |
182 | ;; Date. | |
183 | (progn | |
184 | (goto-char p) | |
185 | (if (search-forward "\ndate: " nil t) | |
186 | (nnheader-header-value) "")) | |
187 | ;; Message-ID. | |
188 | (progn | |
189 | (goto-char p) | |
190 | (if (search-forward "\nmessage-id: " nil t) | |
191 | (nnheader-header-value) | |
192 | ;; If there was no message-id, we just fake one to make | |
193 | ;; subsequent routines simpler. | |
194 | (concat "none+" | |
195 | (int-to-string | |
196 | (incf nnheader-newsgroup-none-id))))) | |
197 | ;; References. | |
198 | (progn | |
199 | (goto-char p) | |
200 | (if (search-forward "\nreferences: " nil t) | |
201 | (nnheader-header-value) | |
202 | ;; Get the references from the in-reply-to header if there | |
203 | ;; were no references and the in-reply-to header looks | |
204 | ;; promising. | |
205 | (if (and (search-forward "\nin-reply-to: " nil t) | |
206 | (setq in-reply-to (nnheader-header-value)) | |
207 | (string-match "<[^>]+>" in-reply-to)) | |
208 | (substring in-reply-to (match-beginning 0) | |
209 | (match-end 0)) | |
210 | ""))) | |
211 | ;; Chars. | |
212 | 0 | |
213 | ;; Lines. | |
214 | (progn | |
215 | (goto-char p) | |
216 | (if (search-forward "\nlines: " nil t) | |
217 | (if (numberp (setq lines (read cur))) | |
218 | lines 0) | |
219 | 0)) | |
220 | ;; Xref. | |
221 | (progn | |
222 | (goto-char p) | |
223 | (and (search-forward "\nxref: " nil t) | |
224 | (nnheader-header-value))))) | |
225 | (when naked | |
226 | (goto-char (point-min)) | |
227 | (delete-char 1))))) | |
228 | ||
229 | (defun nnheader-insert-nov (header) | |
230 | (princ (mail-header-number header) (current-buffer)) | |
231 | (insert | |
232 | "\t" | |
233 | (or (mail-header-subject header) "(none)") "\t" | |
234 | (or (mail-header-from header) "(nobody)") "\t" | |
235 | (or (mail-header-date header) "") "\t" | |
236 | (or (mail-header-id header) | |
237 | (nnmail-message-id)) "\t" | |
238 | (or (mail-header-references header) "") "\t") | |
239 | (princ (or (mail-header-chars header) 0) (current-buffer)) | |
240 | (insert "\t") | |
241 | (princ (or (mail-header-lines header) 0) (current-buffer)) | |
242 | (insert "\t") | |
243 | (when (mail-header-xref header) | |
244 | (insert "Xref: " (mail-header-xref header) "\t")) | |
245 | (insert "\n")) | |
246 | ||
247 | (defun nnheader-insert-article-line (article) | |
248 | (goto-char (point-min)) | |
249 | (insert "220 ") | |
250 | (princ article (current-buffer)) | |
251 | (insert " Article retrieved.\n") | |
252 | (search-forward "\n\n" nil 'move) | |
253 | (delete-region (point) (point-max)) | |
254 | (forward-char -1) | |
255 | (insert ".")) | |
41487370 LMI |
256 | |
257 | ;; Various cruft the backends and Gnus need to communicate. | |
258 | ||
259 | (defvar nntp-server-buffer nil) | |
231f989b LMI |
260 | (defvar gnus-verbose-backends 7 |
261 | "*A number that says how talkative the Gnus backends should be.") | |
41487370 LMI |
262 | (defvar gnus-nov-is-evil nil |
263 | "If non-nil, Gnus backends will never output headers in the NOV format.") | |
264 | (defvar news-reply-yank-from nil) | |
265 | (defvar news-reply-yank-message-id nil) | |
266 | ||
231f989b | 267 | (defvar nnheader-callback-function nil) |
41487370 LMI |
268 | |
269 | (defun nnheader-init-server-buffer () | |
231f989b | 270 | "Initialize the Gnus-backend communication buffer." |
41487370 LMI |
271 | (save-excursion |
272 | (setq nntp-server-buffer (get-buffer-create " *nntpd*")) | |
273 | (set-buffer nntp-server-buffer) | |
274 | (buffer-disable-undo (current-buffer)) | |
275 | (erase-buffer) | |
276 | (kill-all-local-variables) | |
277 | (setq case-fold-search t) ;Should ignore case. | |
278 | t)) | |
279 | ||
41487370 | 280 | |
231f989b LMI |
281 | ;;; Various functions the backends use. |
282 | ||
283 | (defun nnheader-file-error (file) | |
284 | "Return a string that says what is wrong with FILE." | |
285 | (format | |
286 | (cond | |
287 | ((not (file-exists-p file)) | |
288 | "%s does not exist") | |
289 | ((file-directory-p file) | |
290 | "%s is a directory") | |
291 | ((not (file-readable-p file)) | |
292 | "%s is not readable")) | |
293 | file)) | |
0353f9e1 | 294 | |
41487370 | 295 | (defun nnheader-insert-head (file) |
0353f9e1 | 296 | "Insert the head of the article." |
231f989b LMI |
297 | (when (file-exists-p file) |
298 | (if (eq nnheader-max-head-length t) | |
299 | ;; Just read the entire file. | |
300 | (nnheader-insert-file-contents-literally file) | |
301 | ;; Read 1K blocks until we find a separator. | |
302 | (let ((beg 0) | |
303 | format-alist | |
304 | (chop 1024)) | |
50ef36f5 KH |
305 | (while (and (not (zerop (nth 1 (insert-file-contents |
306 | file nil beg (incf beg chop))))) | |
231f989b LMI |
307 | (prog1 (not (search-forward "\n\n" nil t)) |
308 | (goto-char (point-max))) | |
309 | (or (null nnheader-max-head-length) | |
310 | (< beg nnheader-max-head-length)))))) | |
311 | t)) | |
41487370 LMI |
312 | |
313 | (defun nnheader-article-p () | |
231f989b | 314 | "Say whether the current buffer looks like an article." |
41487370 LMI |
315 | (goto-char (point-min)) |
316 | (if (not (search-forward "\n\n" nil t)) | |
317 | nil | |
318 | (narrow-to-region (point-min) (1- (point))) | |
319 | (goto-char (point-min)) | |
320 | (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") | |
321 | (goto-char (match-end 0))) | |
322 | (prog1 | |
323 | (eobp) | |
324 | (widen)))) | |
325 | ||
41487370 | 326 | (defun nnheader-insert-references (references message-id) |
231f989b | 327 | "Insert a References header based on REFERENCES and MESSAGE-ID." |
41487370 | 328 | (if (and (not references) (not message-id)) |
231f989b | 329 | () ; This is illegal, but not all articles have Message-IDs. |
41487370 | 330 | (mail-position-on-field "References") |
231f989b | 331 | (let ((begin (save-excursion (beginning-of-line) (point))) |
41487370 LMI |
332 | (fill-column 78) |
333 | (fill-prefix "\t")) | |
334 | (if references (insert references)) | |
335 | (if (and references message-id) (insert " ")) | |
336 | (if message-id (insert message-id)) | |
231f989b | 337 | ;; Fold long References lines to conform to RFC1036 (sort of). |
41487370 LMI |
338 | ;; The region must end with a newline to fill the region |
339 | ;; without inserting extra newline. | |
340 | (fill-region-as-paragraph begin (1+ (point)))))) | |
341 | ||
231f989b LMI |
342 | (defun nnheader-replace-header (header new-value) |
343 | "Remove HEADER and insert the NEW-VALUE." | |
344 | (save-excursion | |
345 | (save-restriction | |
346 | (nnheader-narrow-to-headers) | |
347 | (prog1 | |
348 | (message-remove-header header) | |
349 | (goto-char (point-max)) | |
350 | (insert header ": " new-value "\n"))))) | |
351 | ||
352 | (defun nnheader-narrow-to-headers () | |
353 | "Narrow to the head of an article." | |
354 | (widen) | |
355 | (narrow-to-region | |
356 | (goto-char (point-min)) | |
357 | (if (search-forward "\n\n" nil t) | |
358 | (1- (point)) | |
359 | (point-max))) | |
360 | (goto-char (point-min))) | |
361 | ||
362 | (defun nnheader-set-temp-buffer (name) | |
363 | "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." | |
364 | (set-buffer (get-buffer-create name)) | |
365 | (buffer-disable-undo (current-buffer)) | |
366 | (erase-buffer) | |
367 | (current-buffer)) | |
368 | ||
369 | (defmacro nnheader-temp-write (file &rest forms) | |
370 | "Create a new buffer, evaluate FORM there, and write the buffer to FILE." | |
371 | `(save-excursion | |
372 | (let ((nnheader-temp-file ,file) | |
373 | (nnheader-temp-cur-buffer | |
374 | (nnheader-set-temp-buffer | |
375 | (generate-new-buffer-name " *nnheader temp*")))) | |
376 | (when (and nnheader-temp-file | |
377 | (not (file-directory-p (file-name-directory | |
378 | nnheader-temp-file)))) | |
379 | (make-directory (file-name-directory nnheader-temp-file) t)) | |
380 | (unwind-protect | |
381 | (prog1 | |
382 | (progn | |
383 | ,@forms) | |
384 | (when nnheader-temp-file | |
385 | (set-buffer nnheader-temp-cur-buffer) | |
386 | (write-region (point-min) (point-max) | |
387 | nnheader-temp-file nil 'nomesg))) | |
388 | (when (buffer-name nnheader-temp-cur-buffer) | |
389 | (kill-buffer nnheader-temp-cur-buffer)))))) | |
390 | ||
391 | (put 'nnheader-temp-write 'lisp-indent-function 1) | |
392 | (put 'nnheader-temp-write 'lisp-indent-hook 1) | |
393 | (put 'nnheader-temp-write 'edebug-form-spec '(form body)) | |
394 | ||
395 | (defvar jka-compr-compression-info-list) | |
396 | (defvar nnheader-numerical-files | |
397 | (if (boundp 'jka-compr-compression-info-list) | |
398 | (concat "\\([0-9]+\\)\\(" | |
399 | (mapconcat (lambda (i) (aref i 0)) | |
400 | jka-compr-compression-info-list "\\|") | |
401 | "\\)?") | |
402 | "[0-9]+$") | |
403 | "Regexp that match numerical files.") | |
404 | ||
405 | (defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files) | |
406 | "Regexp that matches numerical file names.") | |
407 | ||
408 | (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) | |
409 | "Regexp that matches numerical full file paths.") | |
410 | ||
411 | (defsubst nnheader-file-to-number (file) | |
412 | "Take a file name and return the article number." | |
413 | (if (not (boundp 'jka-compr-compression-info-list)) | |
414 | (string-to-int file) | |
415 | (string-match nnheader-numerical-short-files file) | |
416 | (string-to-int (match-string 0 file)))) | |
417 | ||
418 | (defun nnheader-directory-files-safe (&rest args) | |
419 | ;; It has been reported numerous times that `directory-files' | |
420 | ;; fails with an alarming frequency on NFS mounted file systems. | |
421 | ;; This function executes that function twice and returns | |
422 | ;; the longest result. | |
423 | (let ((first (apply 'directory-files args)) | |
424 | (second (apply 'directory-files args))) | |
425 | (if (> (length first) (length second)) | |
426 | first | |
427 | second))) | |
428 | ||
429 | (defun nnheader-directory-articles (dir) | |
430 | "Return a list of all article files in a directory." | |
431 | (mapcar 'nnheader-file-to-number | |
432 | (nnheader-directory-files-safe | |
433 | dir nil nnheader-numerical-short-files t))) | |
434 | ||
435 | (defun nnheader-article-to-file-alist (dir) | |
436 | "Return an alist of article/file pairs in DIR." | |
437 | (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) | |
438 | (nnheader-directory-files-safe | |
439 | dir nil nnheader-numerical-short-files t))) | |
440 | ||
441 | (defun nnheader-fold-continuation-lines () | |
442 | "Fold continuation lines in the current buffer." | |
443 | (goto-char (point-min)) | |
444 | (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
445 | (replace-match " " t t))) | |
446 | ||
447 | (defun nnheader-translate-file-chars (file) | |
448 | (if (null nnheader-file-name-translation-alist) | |
449 | ;; No translation is necessary. | |
450 | file | |
451 | ;; We translate -- but only the file name. We leave the directory | |
452 | ;; alone. | |
453 | (let* ((i 0) | |
454 | trans leaf path len) | |
455 | (if (string-match "/[^/]+\\'" file) | |
456 | ;; This is needed on NT's and stuff. | |
457 | (setq leaf (substring file (1+ (match-beginning 0))) | |
458 | path (substring file 0 (1+ (match-beginning 0)))) | |
459 | ;; Fall back on this. | |
460 | (setq leaf (file-name-nondirectory file) | |
461 | path (file-name-directory file))) | |
462 | (setq len (length leaf)) | |
463 | (while (< i len) | |
464 | (when (setq trans (cdr (assq (aref leaf i) | |
465 | nnheader-file-name-translation-alist))) | |
466 | (aset leaf i trans)) | |
467 | (incf i)) | |
468 | (concat path leaf)))) | |
469 | ||
470 | (defun nnheader-report (backend &rest args) | |
471 | "Report an error from the BACKEND. | |
472 | The first string in ARGS can be a format string." | |
473 | (set (intern (format "%s-status-string" backend)) | |
474 | (if (< (length args) 2) | |
475 | (car args) | |
476 | (apply 'format args))) | |
477 | nil) | |
478 | ||
479 | (defun nnheader-get-report (backend) | |
480 | (message "%s" (symbol-value (intern (format "%s-status-string" backend))))) | |
481 | ||
482 | (defun nnheader-insert (format &rest args) | |
483 | "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer. | |
484 | If FORMAT isn't a format string, it and all ARGS will be inserted | |
485 | without formatting." | |
486 | (save-excursion | |
487 | (set-buffer nntp-server-buffer) | |
488 | (erase-buffer) | |
489 | (if (string-match "%" format) | |
490 | (insert (apply 'format format args)) | |
491 | (apply 'insert format args)) | |
492 | t)) | |
493 | ||
494 | (defun nnheader-mail-file-mbox-p (file) | |
495 | "Say whether FILE looks like an Unix mbox file." | |
496 | (when (and (file-exists-p file) | |
497 | (file-readable-p file) | |
498 | (file-regular-p file)) | |
499 | (save-excursion | |
500 | (nnheader-set-temp-buffer " *mail-file-mbox-p*") | |
501 | (nnheader-insert-file-contents-literally file) | |
502 | (goto-char (point-min)) | |
503 | (prog1 | |
504 | (looking-at message-unix-mail-delimiter) | |
505 | (kill-buffer (current-buffer)))))) | |
506 | ||
507 | (defun nnheader-replace-chars-in-string (string from to) | |
508 | "Replace characters in STRING from FROM to TO." | |
509 | (let ((string (substring string 0)) ;Copy string. | |
510 | (len (length string)) | |
511 | (idx 0)) | |
512 | ;; Replace all occurrences of FROM with TO. | |
513 | (while (< idx len) | |
514 | (if (= (aref string idx) from) | |
515 | (aset string idx to)) | |
516 | (setq idx (1+ idx))) | |
517 | string)) | |
518 | ||
519 | (defun nnheader-file-to-group (file &optional top) | |
520 | "Return a group name based on FILE and TOP." | |
521 | (nnheader-replace-chars-in-string | |
522 | (if (not top) | |
523 | file | |
524 | (condition-case () | |
525 | (substring (expand-file-name file) | |
526 | (length | |
527 | (expand-file-name | |
528 | (file-name-as-directory top)))) | |
529 | (error ""))) | |
530 | ?/ ?.)) | |
531 | ||
532 | (defun nnheader-message (level &rest args) | |
533 | "Message if the Gnus backends are talkative." | |
534 | (if (or (not (numberp gnus-verbose-backends)) | |
535 | (<= level gnus-verbose-backends)) | |
536 | (apply 'message args) | |
537 | (apply 'format args))) | |
538 | ||
539 | (defun nnheader-be-verbose (level) | |
540 | "Return whether the backends should be verbose on LEVEL." | |
541 | (or (not (numberp gnus-verbose-backends)) | |
542 | (<= level gnus-verbose-backends))) | |
543 | ||
544 | (defun nnheader-group-pathname (group dir &optional file) | |
545 | "Make pathname for GROUP." | |
546 | (concat | |
547 | (let ((dir (file-name-as-directory (expand-file-name dir)))) | |
548 | ;; If this directory exists, we use it directly. | |
549 | (if (file-directory-p (concat dir group)) | |
550 | (concat dir group "/") | |
551 | ;; If not, we translate dots into slashes. | |
552 | (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) | |
553 | (cond ((null file) "") | |
554 | ((numberp file) (int-to-string file)) | |
555 | (t file)))) | |
556 | ||
557 | (defun nnheader-functionp (form) | |
558 | "Return non-nil if FORM is funcallable." | |
559 | (or (and (symbolp form) (fboundp form)) | |
560 | (and (listp form) (eq (car form) 'lambda)))) | |
561 | ||
562 | (defun nnheader-concat (dir file) | |
563 | "Concat DIR as directory to FILE." | |
564 | (concat (file-name-as-directory dir) file)) | |
565 | ||
566 | (defun nnheader-ms-strip-cr () | |
567 | "Strip ^M from the end of all lines." | |
568 | (save-excursion | |
569 | (goto-char (point-min)) | |
570 | (while (re-search-forward "\r$" nil t) | |
571 | (delete-backward-char 1)))) | |
572 | ||
c4c7f54c LMI |
573 | (defun nnheader-file-size (file) |
574 | "Return the file size of FILE or 0." | |
575 | (or (nth 7 (file-attributes file)) 0)) | |
576 | ||
577 | (defun nnheader-find-etc-directory (package) | |
578 | "Go through the path and find the \".../etc/PACKAGE\" directory." | |
579 | (let ((path load-path) | |
580 | dir result) | |
581 | ;; We try to find the dir by looking at the load path, | |
582 | ;; stripping away the last component and adding "etc/". | |
583 | (while path | |
584 | (if (and (car path) | |
585 | (file-exists-p | |
586 | (setq dir (concat | |
587 | (file-name-directory | |
588 | (directory-file-name (car path))) | |
589 | "etc/" package "/"))) | |
590 | (file-directory-p dir)) | |
591 | (setq result dir | |
592 | path nil) | |
593 | (setq path (cdr path)))) | |
594 | result)) | |
595 | ||
596 | (defvar ange-ftp-path-format) | |
597 | (defvar efs-path-regexp) | |
598 | (defun nnheader-re-read-dir (path) | |
599 | "Re-read directory PATH if PATH is on a remote system." | |
600 | (if (boundp 'ange-ftp-path-format) | |
601 | (when (string-match (car ange-ftp-path-format) path) | |
602 | (ange-ftp-re-read-dir path)) | |
603 | (if (boundp 'efs-path-regexp) | |
604 | (when (string-match efs-path-regexp path) | |
605 | (efs-re-read-dir path))))) | |
606 | ||
231f989b LMI |
607 | (fset 'nnheader-run-at-time 'run-at-time) |
608 | (fset 'nnheader-cancel-timer 'cancel-timer) | |
609 | (fset 'nnheader-find-file-noselect 'find-file-noselect) | |
610 | (fset 'nnheader-insert-file-contents-literally | |
611 | 'insert-file-contents-literally) | |
612 | ||
613 | (when (string-match "XEmacs\\|Lucid" emacs-version) | |
614 | (require 'nnheaderxm)) | |
615 | ||
616 | (run-hooks 'nnheader-load-hook) | |
617 | ||
41487370 LMI |
618 | (provide 'nnheader) |
619 | ||
620 | ;;; nnheader.el ends here |