X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=dafbfba665575387ed378df94cd610add9fe9d6d;hb=73875b94e7c68219461eb24402bd5887f1a94990;hp=98da65975090b9d8bf94ea94f81d7cb82acc9c01;hpb=8105541ee890397f15d41f6ac2d1a818ce80e0f4;p=elisp%2Fgnus.git- diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 98da659..dafbfba 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,9 +1,11 @@ -;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. +;;; nnheader.el --- header access macros for Semi-gnus and its backends +;; Copyright (C) 1987-1990,1993-1999 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news +;; Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Katsumi Yamaoka +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -40,6 +42,7 @@ (eval-when-compile (require 'cl)) (require 'mail-utils) +(require 'mime) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") @@ -49,7 +52,7 @@ (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 +For instance, if \":\" is invalid as a file character in file names on your system, you could say something like: \(setq nnheader-file-name-translation-alist '((?: . ?_)))") @@ -61,92 +64,85 @@ on your system, you could say something like: (autoload 'cancel-function-timers "timers") (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-delete-line "gnus-util") - (autoload 'gnus-buffer-live-p "gnus-util")) + (autoload 'gnus-buffer-live-p "gnus-util") + (autoload 'gnus-encode-coding-string "gnus-ems")) ;;; Header access macros. (defmacro mail-header-number (header) "Return article number in HEADER." - `(aref ,header 0)) + `(mime-entity-location-internal ,header)) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) + `(mime-entity-set-location-internal ,header ,number)) -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) +(defalias 'mail-header-subject 'mime-entity-decoded-subject-internal) +(defalias 'mail-header-set-subject 'mime-entity-set-decoded-subject-internal) -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) +(defalias 'mail-header-from 'mime-entity-decoded-from-internal) +(defalias 'mail-header-set-from 'mime-entity-set-decoded-from-internal) -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) +(defalias 'mail-header-date 'mime-entity-date-internal) +(defalias 'mail-header-set-date 'mime-entity-set-date-internal) -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) +(defalias 'mail-header-message-id 'mime-entity-message-id-internal) +(defalias 'mail-header-id 'mime-entity-message-id-internal) +(defalias 'mail-header-set-message-id 'mime-entity-set-message-id-internal) +(defalias 'mail-header-set-id 'mime-entity-set-message-id-internal) -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) +(defalias 'mail-header-references 'mime-entity-references-internal) +(defalias 'mail-header-set-references 'mime-entity-set-references-internal) -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) +(defalias 'mail-header-chars 'mime-entity-chars-internal) +(defalias 'mail-header-set-chars 'mime-entity-set-chars-internal) -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) +(defalias 'mail-header-lines 'mime-entity-lines-internal) +(defalias 'mail-header-set-lines 'mime-entity-set-lines-internal) -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) +(defalias 'mail-header-xref 'mime-entity-xref-internal) +(defalias 'mail-header-set-xref 'mime-entity-set-xref-internal) -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) +(defalias 'nnheader-decode-subject + (mime-find-field-decoder 'Subject 'nov)) +(defalias 'nnheader-decode-from + (mime-find-field-decoder 'From 'nov)) -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." - `(aset ,header 8 ,xref)) +(defsubst 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." + (make-mime-entity-internal + 'gnus number + nil + nil nil nil + (if subject + (nnheader-decode-subject subject) + ) + (if from + (nnheader-decode-from from) + ) + date id references + chars lines xref + (list (cons 'Subject subject) + (cons 'From from)) + )) + +(defsubst make-full-mail-header-from-decoded-header + (&optional number subject from date id references chars lines xref) + "Create a new mail header structure initialized with the parameters given." + (make-mime-entity-internal + 'gnus number + nil + nil nil nil + subject + from + date id references + chars lines xref)) (defun make-mail-header (&optional init) "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)) + (make-full-mail-header init init init init init + init init init init)) ;; fake message-ids: generation and detection @@ -182,7 +178,7 @@ on your system, you could say something like: ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance ;; don't always go hand in hand. - (vector + (make-full-mail-header ;; Number. (if naked (progn @@ -261,6 +257,13 @@ on your system, you could say something like: (goto-char (point-min)) (delete-char 1))))) +(defmacro nnheader-nov-next-field () + ;; Go to the beginning of the next field and returns a point of + ;; the end of the current field. + '(if (search-forward "\t" eol t) + (1- (point)) + eol)) + (defmacro nnheader-nov-skip-field () '(search-forward "\t" eol 'move)) @@ -268,28 +271,29 @@ on your system, you could say something like: '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol))) (defmacro nnheader-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read (current-buffer))))) - (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) + '(let ((field (buffer-substring (point) (nnheader-nov-next-field)))) + (if (string-match "^[0-9]+$" field) + (string-to-number field) + 0))) -;; (defvar nnheader-none-counter 0) +(defmacro nnheader-nov-read-message-id () + '(let ((id (buffer-substring (point) (nnheader-nov-next-field)))) + (if (string-match "^<[^>]+>$" id) + id + (nnheader-generate-fake-message-id)))) (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) - (vector + (make-full-mail-header (nnheader-nov-read-integer) ; number (nnheader-nov-field) ; subject (nnheader-nov-field) ; from (nnheader-nov-field) ; date - (or (nnheader-nov-field) - (nnheader-generate-fake-message-id)) ; id + (nnheader-nov-read-message-id) ; id (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines - (if (= (following-char) ?\n) + (if (eq (char-after) ?\n) nil (nnheader-nov-field)) ; misc ))) @@ -298,8 +302,8 @@ on your system, you could say something like: (princ (mail-header-number header) (current-buffer)) (insert "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" + (or (mime-fetch-field 'Subject header) "(none)") "\t" + (or (mime-fetch-field 'From header) "(nobody)") "\t" (or (mail-header-date header) "") "\t" (or (mail-header-id header) (nnmail-message-id)) @@ -384,6 +388,7 @@ the line could be found." ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) +(defvar nntp-process-response nil) (defvar gnus-verbose-backends 7 "*A number that says how talkative the Gnus backends should be.") (defvar gnus-nov-is-evil nil @@ -402,6 +407,7 @@ the line could be found." (erase-buffer) (kill-all-local-variables) (setq case-fold-search t) ;Should ignore case. + (set (make-local-variable 'nntp-process-response) nil) t)) ;;; Various functions the backends use. @@ -453,7 +459,8 @@ the line could be found." (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 invalid, but not all articles have Message-IDs. + () (mail-position-on-field "References") (let ((begin (save-excursion (beginning-of-line) (point))) (fill-column 78) @@ -497,6 +504,52 @@ the line could be found." (erase-buffer)) (current-buffer)) +(defmacro nnheader-temp-write (file &rest forms) + "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. +Return the value of FORMS. +If FILE is nil, just evaluate FORMS and don't save anything. +If FILE is t, return the buffer contents as a string." + (let ((temp-file (make-symbol "temp-file")) + (temp-buffer (make-symbol "temp-buffer")) + (temp-results (make-symbol "temp-results"))) + `(save-excursion + (let* ((,temp-file ,file) + (default-major-mode 'fundamental-mode) + (,temp-buffer + (set-buffer + (get-buffer-create + (generate-new-buffer-name " *nnheader temp*")))) + ,temp-results) + (unwind-protect + (progn + (setq ,temp-results (progn ,@forms)) + (cond + ;; Don't save anything. + ((null ,temp-file) + ,temp-results) + ;; Return the buffer contents. + ((eq ,temp-file t) + (set-buffer ,temp-buffer) + (buffer-string)) + ;; Save a file. + (t + (set-buffer ,temp-buffer) + ;; Make sure the directory where this file is + ;; to be saved exists. + (when (not (file-directory-p + (file-name-directory ,temp-file))) + (make-directory (file-name-directory ,temp-file) t)) + ;; Save the file. + (write-region (point-min) (point-max) + ,temp-file nil 'nomesg) + ,temp-results))) + ;; Kill the buffer. + (when (buffer-name ,temp-buffer) + (kill-buffer ,temp-buffer))))))) + +(put 'nnheader-temp-write 'lisp-indent-function 1) +(put 'nnheader-temp-write 'edebug-form-spec '(form body)) + (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) @@ -641,7 +694,7 @@ without formatting." (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends))) -(defvar nnheader-pathname-coding-system 'iso-8859-1 +(defvar nnheader-pathname-coding-system 'binary "*Coding system for pathname.") (defun nnheader-group-pathname (group dir &optional file) @@ -653,7 +706,7 @@ without formatting." (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir - (nnheader-encode-coding-string + (gnus-encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) "/"))) @@ -726,20 +779,20 @@ find-file-hooks, etc. (auto-mode-alist (nnheader-auto-mode-alist)) (default-major-mode 'fundamental-mode) (enable-local-variables nil) - (after-insert-file-functions nil) - (find-file-hooks nil) - (coding-system-for-read nnheader-file-coding-system)) - (insert-file-contents filename visit beg end replace))) + (after-insert-file-functions nil) + (find-file-hooks nil)) + (insert-file-contents-as-coding-system + nnheader-file-coding-system filename visit beg end replace))) (defun nnheader-find-file-noselect (&rest args) (let ((format-alist nil) (auto-mode-alist (nnheader-auto-mode-alist)) (default-major-mode 'fundamental-mode) (enable-local-variables nil) - (after-insert-file-functions nil) - (find-file-hooks nil) - (coding-system-for-read nnheader-file-coding-system)) - (apply 'find-file-noselect args))) + (after-insert-file-functions nil) + (find-file-hooks nil)) + (apply 'find-file-noselect-as-coding-system + nnheader-file-coding-system args))) (defun nnheader-auto-mode-alist () "Return an `auto-mode-alist' with only the .gz (etc) thingies." @@ -809,13 +862,22 @@ find-file-hooks, etc. (fset 'nnheader-cancel-timer 'cancel-timer) (fset 'nnheader-cancel-function-timers 'cancel-function-timers) -(if (fboundp 'encode-coding-string) - (fset 'nnheader-encode-coding-string 'encode-coding-string) - (fset 'nnheader-encode-coding-string (lambda (s a) s))) - -(if (fboundp 'decode-coding-string) - (fset 'nnheader-decode-coding-string 'decode-coding-string) - (fset 'nnheader-decode-coding-string (lambda (s a) s))) +(defun nnheader-Y-or-n-p (prompt) + "Ask user a \"Y/n\" question. Return t if answer is neither \"n\", \"N\" nor \"C-g\"." + (let ((cursor-in-echo-area t) + (echo-keystrokes 0) + (inhibit-quit t) + ans) + (let (message-log-max) + (while (not (memq ans '(?\ ?N ?Y ?\C-g ?\e ?\n ?\r ?n ?y))) + (message "%s(Y/n) " prompt) + (setq ans (read-char-exclusive)))) + (if (memq ans '(?\C-g ?N ?n)) + (progn + (message "%s(Y/n) No" prompt) + nil) + (message "%s(Y/n) Yes" prompt) + t))) (when (string-match "XEmacs\\|Lucid" emacs-version) (require 'nnheaderxm))