;;; Code:
(require 'mail-utils)
-(require 'sendmail)
-(eval-when-compile (require 'cl))
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
+(defvar nnheader-head-chop-length 2048
+ "*Length of each read operation when trying to fetch HEAD headers.")
+
(defvar nnheader-file-name-translation-alist nil
"*Alist that says how to translate characters in file names.
For instance, if \":\" is illegal as a file character in file names
\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
+(eval-and-compile
+ (autoload 'nnmail-message-id "nnmail")
+ (autoload 'mail-position-on-field "sendmail")
+ (autoload 'message-remove-header "message")
+ (autoload 'cancel-function-timers "timers"))
+
;;; Header access macros.
(defmacro mail-header-number (header)
"Create a new mail header structure initialized with INIT."
(make-vector 9 init))
+(defun make-full-mail-header (&optional number subject from date id
+ references chars lines xref)
+ "Create a new mail header structure initialized with the parameters given."
+ (vector number subject from date id references chars lines xref))
+
;; Parsing headers and NOV lines.
(defsubst nnheader-header-value ()
(let ((case-fold-search t)
(cur (current-buffer))
(buffer-read-only nil)
- end ref in-reply-to lines p)
+ in-reply-to lines p)
(goto-char (point-min))
(when naked
(insert "\n"))
- ;; Search to the beginning of the next header. Error messages
+ ;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
(prog1
(when (or naked (re-search-forward "^[23][0-9]+ " nil t))
(goto-char (point-min))
(delete-char 1)))))
+(defmacro nnheader-nov-skip-field ()
+ '(search-forward "\t" eol 'move))
+
+(defmacro nnheader-nov-field ()
+ '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol)))
+
+(defmacro nnheader-nov-read-integer ()
+ '(prog1
+ (if (= (following-char) ?\t)
+ 0
+ (let ((num (condition-case nil (read (current-buffer)) (error nil))))
+ (if (numberp num) num 0)))
+ (or (eobp) (forward-char 1))))
+
+(defvar nnheader-none-counter 0)
+
+(defun nnheader-parse-nov ()
+ (let ((eol (gnus-point-at-eol)))
+ (vector
+ (nnheader-nov-read-integer) ; number
+ (nnheader-nov-field) ; subject
+ (nnheader-nov-field) ; from
+ (nnheader-nov-field) ; date
+ (or (nnheader-nov-field)
+ (concat "none+"
+ (int-to-string
+ (incf nnheader-none-counter)))) ; id
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (if (= (following-char) ?\n)
+ nil
+ (nnheader-nov-field)) ; misc
+ )))
+
(defun nnheader-insert-nov (header)
(princ (mail-header-number header) (current-buffer))
(insert
(or (mail-header-subject header) "(none)") "\t"
(or (mail-header-from header) "(nobody)") "\t"
(or (mail-header-date header) "") "\t"
- (or (mail-header-id header) "") "\t"
+ (or (mail-header-id header)
+ (nnmail-message-id)) "\t"
(or (mail-header-references header) "") "\t")
(princ (or (mail-header-chars header) 0) (current-buffer))
(insert "\t")
(forward-char -1)
(insert "."))
+(defun nnheader-nov-delete-outside-range (beg end)
+ "Delete all NOV lines that lie outside the BEG to END range."
+ ;; First we find the first wanted line.
+ (nnheader-find-nov-line beg)
+ (delete-region (point-min) (point))
+ ;; Then we find the last wanted line.
+ (when (nnheader-find-nov-line end)
+ (forward-line 1))
+ (delete-region (point) (point-max)))
+
+(defun nnheader-find-nov-line (article)
+ "Put point at the NOV line that start with ARTICLE.
+If ARTICLE doesn't exist, put point where that line
+would have been. The function will return non-nil if
+the line could be found."
+ ;; This function basically does a binary search.
+ (let ((max (point-max))
+ (min (goto-char (point-min)))
+ (cur (current-buffer))
+ (prev (point-min))
+ num found)
+ (while (not found)
+ (goto-char (/ (+ max min) 2))
+ (beginning-of-line)
+ (if (or (= (point) prev)
+ (eobp))
+ (setq found t)
+ (setq prev (point))
+ (cond ((> (setq num (read cur)) article)
+ (setq max (point)))
+ ((< num article)
+ (setq min (point)))
+ (t
+ (setq found 'yes)))))
+ ;; Now we may have found the article we're looking for, or we
+ ;; may be somewhere near it.
+ (when (and (not (eq found 'yes))
+ (not (eq num article)))
+ (setq found (point))
+ (while (and (< (point) max)
+ (or (not (numberp num))
+ (< num article)))
+ (forward-line 1)
+ (setq found (point))
+ (or (eobp)
+ (= (setq num (read cur)) article)))
+ (unless (eq num article)
+ (goto-char found)))
+ (beginning-of-line)
+ (eq num article)))
+
;; Various cruft the backends and Gnus need to communicate.
(defvar nntp-server-buffer nil)
(defun nnheader-init-server-buffer ()
"Initialize the Gnus-backend communication buffer."
(save-excursion
- (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
+ (unless (gnus-buffer-live-p nntp-server-buffer)
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
(set-buffer nntp-server-buffer)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(setq case-fold-search t) ;Should ignore case.
t))
-
;;; Various functions the backends use.
(defun nnheader-file-error (file)
(when (file-exists-p file)
(if (eq nnheader-max-head-length t)
;; Just read the entire file.
- (insert-file-contents-literally file)
+ (nnheader-insert-file-contents-literally file)
;; Read 1K blocks until we find a separator.
(let ((beg 0)
- format-alist
- (chop 1024))
- (while (and (eq chop (nth 1 (insert-file-contents
- file nil beg (incf beg chop))))
+ format-alist)
+ (while (and (eq nnheader-head-chop-length
+ (nth 1 (nnheader-insert-file-contents-literally
+ file nil beg
+ (incf beg nnheader-head-chop-length))))
(prog1 (not (search-forward "\n\n" nil t))
(goto-char (point-max)))
(or (null nnheader-max-head-length)
(defun nnheader-insert-references (references message-id)
"Insert a References header based on REFERENCES and MESSAGE-ID."
(if (and (not references) (not message-id))
- () ; This is illegal, but not all articles have Message-IDs.
+ () ; This is illegal, but not all articles have Message-IDs.
(mail-position-on-field "References")
(let ((begin (save-excursion (beginning-of-line) (point)))
(fill-column 78)
(point-max)))
(goto-char (point-min)))
-(defun nnheader-set-temp-buffer (name)
+(defun nnheader-set-temp-buffer (name &optional noerase)
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
(set-buffer (get-buffer-create name))
(buffer-disable-undo (current-buffer))
- (erase-buffer)
+ (unless noerase
+ (erase-buffer))
(current-buffer))
(defmacro nnheader-temp-write (file &rest forms)
"Create a new buffer, evaluate FORM there, and write the buffer to FILE."
`(save-excursion
- (let ((nnheader-temp-file ,file)
- (nnheader-temp-cur-buffer
- (nnheader-set-temp-buffer
- (generate-new-buffer-name " *nnheader temp*"))))
+ (let* ((nnheader-temp-file ,file)
+ (default-major-mode 'fundamental-mode)
+ (nnheader-temp-cur-buffer
+ (nnheader-set-temp-buffer
+ (generate-new-buffer-name " *nnheader temp*"))))
(when (and nnheader-temp-file
(not (file-directory-p (file-name-directory
nnheader-temp-file))))
(put 'nnheader-temp-write 'lisp-indent-function 1)
(put 'nnheader-temp-write 'lisp-indent-hook 1)
-(put 'nnheader-temp-write 'edebug-form-spec '(file &rest form))
+(put 'nnheader-temp-write 'edebug-form-spec '(form body))
(defvar jka-compr-compression-info-list)
(defvar nnheader-numerical-files
(string-match nnheader-numerical-short-files file)
(string-to-int (match-string 0 file))))
+(defun nnheader-directory-files-safe (&rest args)
+ ;; It has been reported numerous times that `directory-files'
+ ;; fails with an alarming frequency on NFS mounted file systems.
+ ;; This function executes that function twice and returns
+ ;; the longest result.
+ (let ((first (apply 'directory-files args))
+ (second (apply 'directory-files args)))
+ (if (> (length first) (length second))
+ first
+ second)))
+
(defun nnheader-directory-articles (dir)
"Return a list of all article files in a directory."
(mapcar 'nnheader-file-to-number
- (directory-files dir nil nnheader-numerical-short-files t)))
+ (nnheader-directory-files-safe
+ dir nil nnheader-numerical-short-files t)))
(defun nnheader-article-to-file-alist (dir)
"Return an alist of article/file pairs in DIR."
(mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
- (directory-files dir nil nnheader-numerical-short-files t)))
+ (nnheader-directory-files-safe
+ dir nil nnheader-numerical-short-files t)))
(defun nnheader-fold-continuation-lines ()
"Fold continuation lines in the current buffer."
file
;; We translate -- but only the file name. We leave the directory
;; alone.
- (let* ((new (file-name-nondirectory file))
- (len (length new))
- (i 0)
- trans)
+ (let* ((i 0)
+ trans leaf path len)
+ (if (string-match "/[^/]+\\'" file)
+ ;; This is needed on NT's and stuff.
+ (setq leaf (substring file (1+ (match-beginning 0)))
+ path (substring file 0 (1+ (match-beginning 0))))
+ ;; Fall back on this.
+ (setq leaf (file-name-nondirectory file)
+ path (file-name-directory file)))
+ (setq len (length leaf))
(while (< i len)
- (when (setq trans (cdr (assq (aref new i)
+ (when (setq trans (cdr (assq (aref leaf i)
nnheader-file-name-translation-alist)))
- (aset new i trans))
+ (aset leaf i trans))
(incf i))
- (concat (file-name-directory file) new))))
+ (concat path leaf))))
(defun nnheader-report (backend &rest args)
"Report an error from the BACKEND.
nil)
(defun nnheader-get-report (backend)
- (message "%s" (symbol-value (intern (format "%s-status-string" backend)))))
+ "Get the most recent report from BACKEND."
+ (condition-case ()
+ (message "%s" (symbol-value (intern (format "%s-status-string"
+ backend))))
+ (error (message ""))))
(defun nnheader-insert (format &rest args)
- "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer.
+ "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
(file-regular-p file))
(save-excursion
(nnheader-set-temp-buffer " *mail-file-mbox-p*")
- (insert-file-contents-literally file)
+ (nnheader-insert-file-contents-literally file)
(goto-char (point-min))
(prog1
(looking-at message-unix-mail-delimiter)
(or (and (symbolp form) (fboundp form))
(and (listp form) (eq (car form) 'lambda))))
-(defun nnheader-concat (dir file)
+(defun nnheader-concat (dir &rest files)
"Concat DIR as directory to FILE."
- (concat (file-name-as-directory dir) file))
+ (apply 'concat (file-name-as-directory dir) files))
-(require 'nnheader-es)
+(defun nnheader-ms-strip-cr ()
+ "Strip ^M from the end of all lines."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" nil t)
+ (delete-backward-char 1))))
+
+(defun nnheader-file-size (file)
+ "Return the file size of FILE or 0."
+ (or (nth 7 (file-attributes file)) 0))
+
+(defun nnheader-find-etc-directory (package &optional file)
+ "Go through the path and find the \".../etc/PACKAGE\" directory.
+If FILE, find the \".../etc/PACKAGE\" file instead."
+ (let ((path load-path)
+ dir result)
+ ;; We try to find the dir by looking at the load path,
+ ;; stripping away the last component and adding "etc/".
+ (while path
+ (if (and (car path)
+ (file-exists-p
+ (setq dir (concat
+ (file-name-directory
+ (directory-file-name (car path)))
+ "etc/" package
+ (if file "" "/"))))
+ (or file (file-directory-p dir)))
+ (setq result dir
+ path nil)
+ (setq path (cdr path))))
+ result))
+
+(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))
+ (when (string-match efs-path-regexp path)
+ (efs-re-read-dir path))
+ (if (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
+ (when (string-match (car ange-ftp-path-format) path)
+ (ange-ftp-re-read-dir path)))))
+
+(defun nnheader-insert-file-contents-literally (filename &optional visit beg end replace)
+ "Like `insert-file-contents', q.v., but only reads in the file.
+A buffer may be modified in several ways after reading into the buffer due
+to advanced Emacs features, such as file-name-handlers, format decoding,
+find-file-hooks, etc.
+ This function ensures that none of these modifications will take place."
+ (let ((format-alist nil)
+ (after-insert-file-functions nil))
+ (insert-file-contents filename visit beg end replace)))
+
+(fset 'nnheader-run-at-time 'run-at-time)
+(fset 'nnheader-cancel-timer 'cancel-timer)
+(fset 'nnheader-cancel-function-timers 'cancel-function-timers)
+(fset 'nnheader-find-file-noselect 'find-file-noselect)
+
+(when (string-match "XEmacs\\|Lucid" emacs-version)
+ (require 'nnheaderxm))
(run-hooks 'nnheader-load-hook)
projects / gnus / blobdiff