;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 198,997,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(eval-when-compile (require 'cl))
(require 'mail-utils)
-(require 'mm-util)
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
(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.
"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
(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)))))
(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)))
(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))
(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)
(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)
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)
(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)
(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)
(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)
"/")))
(when (string-match (car ange-ftp-path-format) path)
(ange-ftp-re-read-dir path)))))
-(defvar nnheader-file-coding-system 'binary
+(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)
(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."
`(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)
(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))
projects / elisp / gnus.git- / blobdiff