/[emacs]/emacs/lisp/gnus/nnheader.el
ViewVC logotype

Diff of /emacs/lisp/gnus/nnheader.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.17.6.1 by handa, Fri Mar 12 00:03:11 2004 UTC revision 1.17.6.2 by miles, Thu Sep 9 09:36:26 2004 UTC
# Line 1  Line 1 
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.
# Line 33  Line 33 
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                  '((?+ . ?-)))))                  '((?+ . ?-)))))
# Line 65  on your system, you could say something Line 97  on your system, you could say something
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.
# Line 186  on your system, you could say something Line 221  on your system, you could say something
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))
# Line 389  on your system, you could say something Line 439  on your system, you could say something
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"
# Line 432  the line could be found." Line 498  the line could be found."
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))
# Line 471  the line could be found." Line 537  the line could be found."
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    
# Line 490  the line could be found." Line 553  the line could be found."
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.
# Line 544  the line could be found." Line 608  the line could be found."
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
# Line 578  the line could be found." Line 642  the line could be found."
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))
# Line 609  the line could be found." Line 679  the line could be found."
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))
# Line 623  the line could be found." Line 699  the line could be found."
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."
# Line 653  If FULL, translate everything." Line 735  If FULL, translate everything."
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.
# Line 710  without formatting." Line 793  without formatting."
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."
# Line 752  without formatting." Line 822  without formatting."
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."
# Line 766  without formatting." Line 836  without formatting."
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."
# Line 780  without formatting." Line 850  without formatting."
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))
# Line 798  without formatting." Line 863  without formatting."
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
# Line 822  If FILE, find the \".../etc/PACKAGE\" fi Line 889  If FILE, find the \".../etc/PACKAGE\" fi
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)
# Line 851  find-file-hooks, etc. Line 922  find-file-hooks, etc.
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))
# Line 917  find-file-hooks, etc. Line 1008  find-file-hooks, etc.
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))

Legend:
Removed from v.1.17.6.1  
changed lines
  Added in v.1.17.6.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26