diff options
Diffstat (limited to 'lisp/nnheader.el')
| -rw-r--r-- | lisp/nnheader.el | 358 |
1 files changed, 358 insertions, 0 deletions
diff --git a/lisp/nnheader.el b/lisp/nnheader.el new file mode 100644 index 00000000000..8e303615cfa --- /dev/null +++ b/lisp/nnheader.el @@ -0,0 +1,358 @@ +;;; 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> +;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; These macros may look very much like the ones in GNUS 4.1. They +;; are, in a way, but you should note that the indices they use have +;; been changed from the internal GNUS format to the NOV format. Makes +;; it possible to read headers from XOVER much faster. +;; +;; The format of a header is now: +;; [number subject from date id references chars lines xref] +;; +;; (That last entry is defined as "misc" in the NOV format, but Gnus +;; uses it for xrefs.) + +;;; Code: + +(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 '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 'mail-header-subject) +(defmacro mail-header-subject (header) + "Return subject string in HEADER." + (` (aref (, header) 1))) + +(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 'mail-header-from) +(defmacro mail-header-from (header) + "Return author string in HEADER." + (` (aref (, header) 2))) + +(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-date 'mail-header-date) +(defmacro mail-header-date (header) + "Return date in HEADER." + (` (aref (, header) 3))) + +(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 'mail-header-id) +(defmacro mail-header-id (header) + "Return Id in HEADER." + (` (aref (, header) 4))) + +(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 'mail-header-references) +(defmacro mail-header-references (header) + "Return references in HEADER." + (` (aref (, header) 5))) + +(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 'mail-header-chars) +(defmacro mail-header-chars (header) + "Return number of chars of article in HEADER." + (` (aref (, header) 6))) + +(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) +(defvar gnus-verbose-backends t + "*If non-nil, Gnus backends will generate lots of comments.") +(defvar gnus-nov-is-evil nil + "If non-nil, Gnus backends will never output headers in the NOV format.") +(defvar news-reply-yank-from nil) +(defvar news-reply-yank-message-id nil) + +;; All backends use this function, so I moved it to this file. + +(defun nnheader-init-server-buffer () + (save-excursion + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (setq case-fold-search t) ;Should ignore case. + t)) + +(defun nnheader-set-init-variables (server defs) + (let ((s server) + val) + ;; First we set the server variables in the sequence required. We + ;; use the definitions from the `defs' list where that is + ;; possible. + (while s + (set (car (car s)) + (if (setq val (assq (car (car s)) defs)) + (nth 1 val) + (nth 1 (car s)))) + (setq s (cdr s))) + ;; The we go through the defs list and set any variables that were + ;; not set in the first sweep. + (while defs + (if (not (assq (car (car defs)) server)) + (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) + (let (out) + (while server + (setq out (cons (list (car (car server)) + (symbol-value (car (car server)))) + out)) + (setq server (cdr server))) + (nreverse out))) + +(defun nnheader-restore-variables (state) + (while state + (set (car (car state)) (nth 1 (car state))) + (setq state (cdr state)))) + +;; Read the head of an article. +(defun nnheader-insert-head (file) + (let ((beg 0) + (chop 1024)) + (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))))))) + +(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. + (mail-position-on-field "References") + ;; Fold long references line to follow RFC1036. + (let ((begin (gnus-point-at-bol)) + (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)))))) + +(provide 'nnheader) + +;;; nnheader.el ends here |