X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=7ef13f243782bdd7e9ee8371ff02fb7e6e67b922;hb=ed341c45e5e97c823e86a642b7136a140f2af6f3;hp=5f685a3c9737c535650f63af3aff234b39d27748;hpb=5c85eb9dd8a85edecf9b9da5bfeb5ca5d754aa1b;p=elisp%2Fgnus.git- diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 5f685a3..7ef13f2 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -40,7 +40,6 @@ (eval-when-compile (require 'cl)) (require 'mail-utils) -(require 'mm-util) (defvar nnheader-max-head-length 4096 "*Max length of the head of articles.") @@ -62,7 +61,8 @@ 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. @@ -140,23 +140,14 @@ on your system, you could say something like: "Set article xref of HEADER to xref." `(aset ,header 8 ,xref)) -(defmacro mail-header-extra (header) - "Return the extra headers in HEADER." - `(aref ,header 9)) - -(defmacro mail-header-set-extra (header extra) - "Set the extra headers in HEADER to EXTRA." - `(aset ,header 9 ',extra)) - (defun make-mail-header (&optional init) "Create a new mail header structure initialized with INIT." - (make-vector 10 init)) + (make-vector 9 init)) (defun make-full-mail-header (&optional number subject from date id - references chars lines xref - extra) + 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 extra)) + (vector number subject from date id references chars lines xref)) ;; fake message-ids: generation and detection @@ -266,20 +257,7 @@ on your system, you could say something like: (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (nnheader-header-value))) - - ;; Extra. - (when nnmail-extra-headers - (let ((extra nnmail-extra-headers) - out) - (while extra - (goto-char p) - (when (search-forward - (concat "\n" (symbol-name (car extra)) ": ") nil t) - (push (cons (car extra) (nnheader-header-value)) - out)) - (pop extra)) - out)))) + (nnheader-header-value))))) (when naked (goto-char (point-min)) (delete-char 1))))) @@ -292,21 +270,13 @@ on your system, you could say something like: (defmacro nnheader-nov-read-integer () '(prog1 - (if (eq (char-after) ?\t) + (if (= (following-char) ?\t) 0 (let ((num (ignore-errors (read (current-buffer))))) (if (numberp num) num 0))) (or (eobp) (forward-char 1)))) -(defmacro nnheader-nov-parse-extra () - '(let (out string) - (while (not (memq (char-after) '(?\n nil))) - (setq string (nnheader-nov-field)) - (when (string-match "^\\([^ :]+\\): " string) - (push (cons (intern (match-string 1 string)) - (substring string (match-end 0))) - out))) - out)) +;; (defvar nnheader-none-counter 0) (defun nnheader-parse-nov () (let ((eol (gnus-point-at-eol))) @@ -320,10 +290,10 @@ on your system, you could say something like: (nnheader-nov-field) ; refs (nnheader-nov-read-integer) ; chars (nnheader-nov-read-integer) ; lines - (if (eq (char-after) ?\n) + (if (= (following-char) ?\n) nil (nnheader-nov-field)) ; misc - (nnheader-nov-parse-extra)))) ; extra + ))) (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) @@ -341,16 +311,7 @@ on your system, you could say something like: (princ (or (mail-header-lines header) 0) (current-buffer)) (insert "\t") (when (mail-header-xref header) - (insert "Xref: " (mail-header-xref header))) - (when (or (mail-header-xref header) - (mail-header-extra header)) - (insert "\t")) - (when (mail-header-extra header) - (let ((extra (mail-header-extra header))) - (while extra - (insert (symbol-name (caar extra)) - ": " (cdar extra) "\t") - (pop extra)))) + (insert "Xref: " (mail-header-xref header) "\t")) (insert "\n")) (defun nnheader-insert-article-line (article) @@ -438,7 +399,6 @@ the line could be found." (save-excursion (unless (gnus-buffer-live-p nntp-server-buffer) (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) - (mm-enable-multibyte) (set-buffer nntp-server-buffer) (erase-buffer) (kill-all-local-variables) @@ -485,7 +445,7 @@ the line could be found." nil (narrow-to-region (point-min) (1- (point))) (goto-char (point-min)) - (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") + (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") (goto-char (match-end 0))) (prog1 (eobp) @@ -533,11 +493,57 @@ the line could be found." (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) + (buffer-disable-undo (current-buffer)) (unless noerase (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) @@ -682,7 +688,7 @@ without formatting." (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends))) -(defvar nnheader-pathname-coding-system 'binary +(defvar nnheader-pathname-coding-system 'iso-8859-1 "*Coding system for pathname.") (defun nnheader-group-pathname (group dir &optional file) @@ -694,7 +700,7 @@ without formatting." (concat dir group "/") ;; If not, we translate dots into slashes. (concat dir - (mm-encode-coding-string + (gnus-encode-coding-string (nnheader-replace-chars-in-string group ?. ?/) nnheader-pathname-coding-system) "/"))) @@ -754,7 +760,7 @@ If FILE, find the \".../etc/PACKAGE\" file instead." (when (string-match (car ange-ftp-path-format) path) (ange-ftp-re-read-dir path))))) -(defvar nnheader-file-coding-system 'no-conversion +(defvar nnheader-file-coding-system 'raw-text "Coding system used in file backends of Gnus.") (defun nnheader-insert-file-contents (filename &optional visit beg end replace) @@ -767,20 +773,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." @@ -816,6 +822,8 @@ find-file-hooks, etc. `(let ((new (generate-new-buffer " *nnheader replace*")) (cur (current-buffer)) (start (point-min))) + (set-buffer new) + (buffer-disable-undo (current-buffer)) (set-buffer cur) (goto-char (point-min)) (while (,(if regexp 're-search-forward 'search-forward) @@ -848,6 +856,23 @@ find-file-hooks, etc. (fset 'nnheader-cancel-timer 'cancel-timer) (fset 'nnheader-cancel-function-timers 'cancel-function-timers) +(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))