-;;; nnheader: Header access macros for Gnus and its backends
+;;; nnheader.el --- header access macros for Gnus and its backends
;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;;; Code:
-(defalias 'nntp-header-number 'header-number)
-(defmacro header-number (header)
+(require 'mail-utils)
+(require 'sendmail)
+(eval-when-compile (require 'cl))
+
+(defvar nnheader-max-head-length 4096
+ "*Max length of the head of articles.")
+
+(defalias 'nntp-header-number 'mail-header-number)
+(defmacro mail-header-number (header)
"Return article number in HEADER."
(` (aref (, header) 0)))
-(defalias 'nntp-set-header-number 'header-set-number)
-(defmacro header-set-number (header number)
+(defalias 'nntp-set-header-number 'mail-header-set-number)
+(defmacro mail-header-set-number (header number)
"Set article number of HEADER to NUMBER."
(` (aset (, header) 0 (, number))))
-(defalias 'nntp-header-subject 'header-subject)
-(defmacro header-subject (header)
+(defalias 'nntp-header-subject 'mail-header-subject)
+(defmacro mail-header-subject (header)
"Return subject string in HEADER."
(` (aref (, header) 1)))
-(defalias 'nntp-set-header-subject 'header-set-subject)
-(defmacro header-set-subject (header subject)
+(defalias 'nntp-set-header-subject 'mail-header-set-subject)
+(defmacro mail-header-set-subject (header subject)
"Set article subject of HEADER to SUBJECT."
(` (aset (, header) 1 (, subject))))
-(defalias 'nntp-header-from 'header-from)
-(defmacro header-from (header)
+(defalias 'nntp-header-from 'mail-header-from)
+(defmacro mail-header-from (header)
"Return author string in HEADER."
(` (aref (, header) 2)))
-(defalias 'nntp-set-header-from 'header-set-from)
-(defmacro header-set-from (header from)
+(defalias 'nntp-set-header-from 'mail-header-set-from)
+(defmacro mail-header-set-from (header from)
"Set article author of HEADER to FROM."
(` (aset (, header) 2 (, from))))
-(defalias 'nntp-header-xref 'header-xref)
-(defmacro header-xref (header)
- "Return xref string in HEADER."
- (` (aref (, header) 8)))
-
-(defalias 'nntp-set-header-xref 'header-set-xref)
-(defmacro header-set-xref (header xref)
- "Set article xref of HEADER to xref."
- (` (aset (, header) 8 (, xref))))
-
-(defalias 'nntp-header-lines 'header-lines)
-(defmacro header-lines (header)
- "Return lines in HEADER."
- (` (aref (, header) 7)))
-
-(defalias 'nntp-set-header-lines 'header-set-lines)
-(defmacro header-set-lines (header lines)
- "Set article lines of HEADER to LINES."
- (` (aset (, header) 7 (, lines))))
-
-(defalias 'nntp-header-date 'header-date)
-(defmacro header-date (header)
+(defalias 'nntp-header-date 'mail-header-date)
+(defmacro mail-header-date (header)
"Return date in HEADER."
(` (aref (, header) 3)))
-(defalias 'nntp-set-header-date 'header-set-date)
-(defmacro header-set-date (header date)
+(defalias 'nntp-set-header-date 'mail-header-set-date)
+(defmacro mail-header-set-date (header date)
"Set article date of HEADER to DATE."
(` (aset (, header) 3 (, date))))
-(defalias 'nntp-header-id 'header-id)
-(defmacro header-id (header)
+(defalias 'nntp-header-id 'mail-header-id)
+(defmacro mail-header-id (header)
"Return Id in HEADER."
(` (aref (, header) 4)))
-(defalias 'nntp-set-header-id 'header-set-id)
-(defmacro header-set-id (header id)
+(defalias 'nntp-set-header-id 'mail-header-set-id)
+(defmacro mail-header-set-id (header id)
"Set article Id of HEADER to ID."
(` (aset (, header) 4 (, id))))
-(defalias 'nntp-header-references 'header-references)
-(defmacro header-references (header)
+(defalias 'nntp-header-references 'mail-header-references)
+(defmacro mail-header-references (header)
"Return references in HEADER."
(` (aref (, header) 5)))
-(defalias 'nntp-set-header-references 'header-set-references)
-(defmacro header-set-references (header ref)
+(defalias 'nntp-set-header-references 'mail-header-set-references)
+(defmacro mail-header-set-references (header ref)
"Set article references of HEADER to REF."
(` (aset (, header) 5 (, ref))))
-(defalias 'nntp-header-chars 'header-chars)
-(defmacro header-chars (header)
+(defalias 'nntp-header-chars 'mail-header-chars)
+(defmacro mail-header-chars (header)
"Return number of chars of article in HEADER."
(` (aref (, header) 6)))
-(defalias 'nntp-set-header-chars 'header-set-chars)
-(defmacro header-set-chars (header chars)
+(defalias 'nntp-set-header-chars 'mail-header-set-chars)
+(defmacro mail-header-set-chars (header chars)
"Set number of chars in article of HEADER to CHARS."
(` (aset (, header) 6 (, chars))))
+(defalias 'nntp-header-lines 'mail-header-lines)
+(defmacro mail-header-lines (header)
+ "Return lines in HEADER."
+ (` (aref (, header) 7)))
+
+(defalias 'nntp-set-header-lines 'mail-header-set-lines)
+(defmacro mail-header-set-lines (header lines)
+ "Set article lines of HEADER to LINES."
+ (` (aset (, header) 7 (, lines))))
+
+(defalias 'nntp-header-xref 'mail-header-xref)
+(defmacro mail-header-xref (header)
+ "Return xref string in HEADER."
+ (` (aref (, header) 8)))
+
+(defalias 'nntp-set-header-xref 'mail-header-set-xref)
+(defmacro mail-header-set-xref (header xref)
+ "Set article xref of HEADER to xref."
+ (` (aset (, header) 8 (, xref))))
+
+
;; Various cruft the backends and Gnus need to communicate.
(defvar nntp-server-buffer nil)
;; not set in the first sweep.
(while defs
(if (not (assq (car (car defs)) server))
- (set (car (car defs)) (eval (nth 1 (car defs)))))
+ (set (car (car defs))
+ (if (and (symbolp (nth 1 (car defs)))
+ (not (boundp (nth 1 (car defs)))))
+ (nth 1 (car defs))
+ (eval (nth 1 (car defs))))))
(setq defs (cdr defs)))))
(defun nnheader-save-variables (server)
(set (car (car state)) (nth 1 (car state)))
(setq state (cdr state))))
+;; Read the head of an article.
+(defun nnheader-insert-head (file)
+ (if (eq nnheader-max-head-length t)
+ ;; Just read the entire file.
+ (nnheader-insert-file-contents-literally file)
+ (let ((beg 0)
+ (chop 1024))
+ ;; Read 1K blocks until we find a separator.
+ (while (and (eq chop (nth 1 (nnheader-insert-file-contents-literally
+ file nil beg (setq beg (+ chop beg)))))
+ (prog1 (not (search-backward "\n\n" nil t))
+ (goto-char (point-max)))
+ (or (null nnheader-max-head-length)
+ (< beg nnheader-max-head-length)))))))
+
+(defun nnheader-article-p ()
+ (goto-char (point-min))
+ (if (not (search-forward "\n\n" nil t))
+ nil
+ (narrow-to-region (point-min) (1- (point)))
+ (goto-char (point-min))
+ (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
+ (goto-char (match-end 0)))
+ (prog1
+ (eobp)
+ (widen))))
+
+;; Written by Erik Naggum <erik@naggum.no>.
+(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 ( ; (file-name-handler-alist nil)
+ (format-alist nil)
+ (after-insert-file-functions nil)
+ (find-buffer-file-type-function
+ (if (fboundp 'find-buffer-file-type)
+ (symbol-function 'find-buffer-file-type)
+ nil)))
+ (unwind-protect
+ (progn
+ (fset 'find-buffer-file-type (lambda (filename) t))
+ (insert-file-contents filename visit beg end replace))
+ (if find-buffer-file-type-function
+ (fset 'find-buffer-file-type find-buffer-file-type-function)
+ (fmakunbound 'find-buffer-file-type)))))
+
+(defun nnheader-find-file-noselect (filename &optional nowarn rawfile)
+ "Read file FILENAME into a buffer and return the buffer.
+If a buffer exists visiting FILENAME, return that one, but
+verify that the file has not changed since visited or saved.
+The buffer is not selected, just returned to the caller."
+ (setq filename
+ (abbreviate-file-name
+ (expand-file-name filename)))
+ (if (file-directory-p filename)
+ (if find-file-run-dired
+ (dired-noselect filename)
+ (error "%s is a directory." filename))
+ (let* ((buf (get-file-buffer filename))
+ (truename (abbreviate-file-name (file-truename filename)))
+ (number (nthcdr 10 (file-attributes truename)))
+ ;; Find any buffer for a file which has same truename.
+ (other (and (not buf)
+ (if (fboundp 'find-buffer-visiting)
+ (find-buffer-visiting filename)
+ (get-file-buffer filename))))
+ error)
+ ;; Let user know if there is a buffer with the same truename.
+ (if other
+ (progn
+ (or nowarn
+ (string-equal filename (buffer-file-name other))
+ (message "%s and %s are the same file"
+ filename (buffer-file-name other)))
+ ;; Optionally also find that buffer.
+ (if (or (and (boundp 'find-file-existing-other-name)
+ find-file-existing-other-name)
+ find-file-visit-truename)
+ (setq buf other))))
+ (if buf
+ (or nowarn
+ (verify-visited-file-modtime buf)
+ (cond ((not (file-exists-p filename))
+ (error "File %s no longer exists!" filename))
+ ((yes-or-no-p
+ (if (string= (file-name-nondirectory filename)
+ (buffer-name buf))
+ (format
+ (if (buffer-modified-p buf)
+ "File %s changed on disk. Discard your edits? "
+ "File %s changed on disk. Reread from disk? ")
+ (file-name-nondirectory filename))
+ (format
+ (if (buffer-modified-p buf)
+ "File %s changed on disk. Discard your edits in %s? "
+ "File %s changed on disk. Reread from disk into %s? ")
+ (file-name-nondirectory filename)
+ (buffer-name buf))))
+ (save-excursion
+ (set-buffer buf)
+ (revert-buffer t t)))))
+ (save-excursion
+;;; The truename stuff makes this obsolete.
+;;; (let* ((link-name (car (file-attributes filename)))
+;;; (linked-buf (and (stringp link-name)
+;;; (get-file-buffer link-name))))
+;;; (if (bufferp linked-buf)
+;;; (message "Symbolic link to file in buffer %s"
+;;; (buffer-name linked-buf))))
+ (setq buf (create-file-buffer filename))
+ ;; (set-buffer-major-mode buf)
+ (set-buffer buf)
+ (erase-buffer)
+ (if rawfile
+ (condition-case ()
+ (nnheader-insert-file-contents-literally filename t)
+ (file-error
+ ;; Unconditionally set error
+ (setq error t)))
+ (condition-case ()
+ (insert-file-contents filename t)
+ (file-error
+ ;; Run find-file-not-found-hooks until one returns non-nil.
+ (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks)
+ ;; If they fail too, set error.
+ (setq error t)))))
+ ;; Find the file's truename, and maybe use that as visited name.
+ (setq buffer-file-truename truename)
+ (setq buffer-file-number number)
+ ;; On VMS, we may want to remember which directory in a search list
+ ;; the file was found in.
+ (and (eq system-type 'vax-vms)
+ (let (logical)
+ (if (string-match ":" (file-name-directory filename))
+ (setq logical (substring (file-name-directory filename)
+ 0 (match-beginning 0))))
+ (not (member logical find-file-not-true-dirname-list)))
+ (setq buffer-file-name buffer-file-truename))
+ (if find-file-visit-truename
+ (setq buffer-file-name
+ (setq filename
+ (expand-file-name buffer-file-truename))))
+ ;; Set buffer's default directory to that of the file.
+ (setq default-directory (file-name-directory filename))
+ ;; Turn off backup files for certain file names. Since
+ ;; this is a permanent local, the major mode won't eliminate it.
+ (and (not (funcall backup-enable-predicate buffer-file-name))
+ (progn
+ (make-local-variable 'backup-inhibited)
+ (setq backup-inhibited t)))
+ (if rawfile
+ nil
+ (after-find-file error (not nowarn)))))
+ buf)))
+
+(defun nnheader-insert-references (references message-id)
+ (if (and (not references) (not message-id))
+ () ; This is illegal, but not all articles have Message-IDs.
+ ;; Fold long references line to follow RFC1036.
+ (mail-position-on-field "References")
+ (let ((begin (save-excursion (beginning-of-line) (point)))
+ (fill-column 78)
+ (fill-prefix "\t"))
+ (if references (insert references))
+ (if (and references message-id) (insert " "))
+ (if message-id (insert message-id))
+ ;; The region must end with a newline to fill the region
+ ;; without inserting extra newline.
+ (fill-region-as-paragraph begin (1+ (point))))))
+
+(defun nnheader-remove-header (header &optional is-regexp first)
+ "Remove HEADER.
+If FIRST, only remove the first instance if the header.
+Return the number of headers removed."
+ (goto-char (point-min))
+ (let ((regexp (if is-regexp header (concat "^" header ":")))
+ (number 0)
+ (case-fold-search t)
+ last)
+ (while (and (re-search-forward regexp nil t)
+ (not last))
+ (incf number)
+ (when first
+ (setq last t))
+ (delete-region
+ (match-beginning 0)
+ ;; There might be a continuation header, so we have to search
+ ;; until we find a new non-continuation line.
+ (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (point-max))))
+ number))
+
+(defun nnheader-set-temp-buffer (name)
+ (set-buffer (get-buffer-create name))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer))
+
+(defvar jka-compr-compression-info-list)
+(defvar nnheader-numerical-files
+ (if (boundp 'jka-compr-compression-info-list)
+ (concat "\\([0-9]+\\)\\("
+ (mapconcat (lambda (i) (aref i 0))
+ jka-compr-compression-info-list "\\|")
+ "\\)?")
+ "[0-9]+$")
+ "Regexp that match numerical files.")
+
+(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files)
+ "Regexp that matches numerical file names.")
+
+(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
+ "Regexp that matches numerical full file paths.")
+
+(defun nnheader-file-to-number (file)
+ (if (not (boundp 'jka-compr-compression-info-list))
+ (string-to-int file)
+ (string-match nnheader-numerical-short-files file)
+ (match-string 1 file)))
+
+(defun nnheader-directory-articles (dir)
+ (mapcar 'nnheader-file-to-number
+ (directory-files dir nil nnheader-numerical-short-files t)))
+
(provide 'nnheader)
;;; nnheader.el ends here
projects / gnus / blobdiff