-;;; 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 <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Katsumi Yamaoka <yamaoka@jpl.org>
+;; Keywords: mail, news, MIME
;; This file is part of GNU Emacs.
(eval-when-compile (require 'cl))
(require 'mail-utils)
+(require 'mime)
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
(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 '((?: . ?_)))")
(autoload 'mail-position-on-field "sendmail")
(autoload 'message-remove-header "message")
(autoload 'cancel-function-timers "timers")
- (autoload 'gnus-point-at-eol "gnus-util"))
+ (autoload 'gnus-point-at-eol "gnus-util")
+ (autoload 'gnus-delete-line "gnus-util")
+ (autoload 'gnus-buffer-live-p "gnus-util"))
;;; Header access macros.
+(require 'mmgnus)
+
(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))
-
-(defmacro mail-header-subject (header)
- "Return subject string in HEADER."
- `(aref ,header 1))
-
-(defmacro mail-header-set-subject (header subject)
- "Set article subject of HEADER to SUBJECT."
- `(aset ,header 1 ,subject))
-
-(defmacro mail-header-from (header)
- "Return author string in HEADER."
- `(aref ,header 2))
+ `(mime-entity-set-location-internal ,header ,number))
-(defmacro mail-header-set-from (header from)
- "Set article author of HEADER to FROM."
- `(aset ,header 2 ,from))
+(defalias 'mail-header-subject 'mime-gnus-entity-subject-internal)
+(defalias 'mail-header-set-subject 'mime-gnus-entity-set-subject-internal)
-(defmacro mail-header-date (header)
- "Return date in HEADER."
- `(aref ,header 3))
+(defalias 'mail-header-from 'mime-gnus-entity-from-internal)
+(defalias 'mail-header-set-from 'mime-gnus-entity-set-from-internal)
-(defmacro mail-header-set-date (header date)
- "Set article date of HEADER to DATE."
- `(aset ,header 3 ,date))
+(defalias 'mail-header-date 'mime-gnus-entity-date-internal)
+(defalias 'mail-header-set-date 'mime-gnus-entity-set-date-internal)
-(defalias 'mail-header-message-id 'mail-header-id)
-(defmacro mail-header-id (header)
- "Return Id in HEADER."
- `(aref ,header 4))
+(defalias 'mail-header-message-id 'mime-gnus-entity-id-internal)
+(defalias 'mail-header-id 'mime-gnus-entity-id-internal)
+(defalias 'mail-header-set-message-id 'mime-gnus-entity-set-id-internal)
+(defalias 'mail-header-set-id 'mime-gnus-entity-set-id-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-references 'mime-gnus-entity-references-internal)
+(defalias 'mail-header-set-references
+ 'mime-gnus-entity-set-references-internal)
-(defmacro mail-header-references (header)
- "Return references in HEADER."
- `(aref ,header 5))
+(defalias 'mail-header-chars 'mime-gnus-entity-chars-internal)
+(defalias 'mail-header-set-chars 'mime-gnus-entity-set-chars-internal)
-(defmacro mail-header-set-references (header ref)
- "Set article references of HEADER to REF."
- `(aset ,header 5 ,ref))
+(defalias 'mail-header-lines 'mime-gnus-entity-lines-internal)
+(defalias 'mail-header-set-lines 'mime-gnus-entity-set-lines-internal)
-(defmacro mail-header-chars (header)
- "Return number of chars of article in HEADER."
- `(aref ,header 6))
+(defalias 'mail-header-xref 'mime-gnus-entity-xref-internal)
+(defalias 'mail-header-set-xref 'mime-gnus-entity-set-xref-internal)
-(defmacro mail-header-set-chars (header chars)
- "Set number of chars in article of HEADER to CHARS."
- `(aset ,header 6 ,chars))
+(defalias 'nnheader-decode-subject
+ (mime-find-field-decoder 'Subject 'nov))
+(defalias 'nnheader-decode-from
+ (mime-find-field-decoder 'From 'nov))
-(defmacro mail-header-lines (header)
- "Return lines in HEADER."
- `(aref ,header 7))
+(defalias 'mail-header-extra 'ignore)
+(defalias 'mail-header-set-extra 'ignore)
-(defmacro mail-header-set-lines (header lines)
- "Set article lines of HEADER to LINES."
- `(aset ,header 7 ,lines))
+(defsubst nnheader-decode-field-body (field-body field-name
+ &optional mode max-column)
+ (mime-decode-field-body field-body
+ (if (stringp field-name)
+ (intern (capitalize field-name))
+ field-name)
+ mode max-column))
-(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 extra)
+ "Create a new mail header structure initialized with the parameters given."
+ (luna-make-entity (mm-expand-class-name 'gnus)
+ :location number
+ :subject (if subject
+ (nnheader-decode-subject subject))
+ :from (if from
+ (nnheader-decode-from from))
+ :date date
+ :id id
+ :references references
+ :chars chars
+ :lines lines
+ :xref xref
+ :original-header (list (cons 'Subject subject)
+ (cons 'From from))
+ ;; :extra ???
+ ))
+
+(defsubst make-full-mail-header-from-decoded-header
+ (&optional number subject from date id references chars lines xref extra)
+ "Create a new mail header structure initialized with the parameters given."
+ (luna-make-entity (mm-expand-class-name 'gnus)
+ :location number
+ :subject subject
+ :from from
+ :date date
+ :id id
+ :references references
+ :chars chars
+ :lines lines
+ :xref xref
+ ;; :extra ???
+ ))
(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 init))
;; fake message-ids: generation and detection
;; 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
;; promising.
(if (and (search-forward "\nin-reply-to: " nil t)
(setq in-reply-to (nnheader-header-value))
- (string-match "<[^>]+>" in-reply-to))
+ (string-match "<[^\n>]+>" in-reply-to))
(let (ref2)
(setq ref (substring in-reply-to (match-beginning 0)
(match-end 0)))
- (while (string-match "<[^>]+>" in-reply-to (match-end 0))
+ (while (string-match "<[^\n>]+>"
+ in-reply-to (match-end 0))
(setq ref2 (substring in-reply-to (match-beginning 0)
(match-end 0)))
(when (> (length ref2) (length ref))
- (setq ref ref2))))
- "")))
+ (setq ref ref2)))
+ ref)
+ nil)))
;; Chars.
0
;; Lines.
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (nnheader-header-value)))))
+ (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))))
(when naked
(goto-char (point-min))
(delete-char 1)))))
(defmacro nnheader-nov-read-integer ()
'(prog1
- (if (= (following-char) ?\t)
+ (if (eq (char-after) ?\t)
0
(let ((num (ignore-errors (read (current-buffer)))))
(if (numberp num) num 0)))
- (or (eobp) (forward-char 1))))
-
-;; (defvar nnheader-none-counter 0)
+ (unless (eobp)
+ (search-forward "\t" eol 'move))))
+
+(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))
+
+(defmacro nnheader-nov-read-message-id ()
+ '(let ((id (nnheader-nov-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
- )))
+ (nnheader-nov-parse-extra)))) ; extra
(defun nnheader-insert-nov (header)
(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))
(princ (or (mail-header-lines header) 0) (current-buffer))
(insert "\t")
(when (mail-header-xref header)
- (insert "Xref: " (mail-header-xref header) "\t"))
+ (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 "\n"))
(defun nnheader-insert-article-line (article)
(beginning-of-line)
(eq num article)))
+(defun nnheader-retrieve-headers-from-directory* (articles
+ directory dependencies
+ &optional
+ fetch-old force-new large
+ backend)
+ (with-temp-buffer
+ (let* ((file nil)
+ (number (length articles))
+ (count 0)
+ (pathname-coding-system 'binary)
+ (case-fold-search t)
+ (cur (current-buffer))
+ article
+ headers header id end ref in-reply-to lines chars ctype)
+ ;; We don't support fetching by Message-ID.
+ (if (stringp (car articles))
+ 'headers
+ (while articles
+ (when (and (file-exists-p
+ (setq file (expand-file-name
+ (int-to-string
+ (setq article (pop articles)))
+ directory)))
+ (not (file-directory-p file)))
+ (erase-buffer)
+ (nnheader-insert-head file)
+ (save-restriction
+ (std11-narrow-to-header)
+ (setq
+ header
+ (make-full-mail-header
+ ;; Number.
+ article
+ ;; Subject.
+ (or (std11-fetch-field "Subject")
+ "(none)")
+ ;; From.
+ (or (std11-fetch-field "From")
+ "(nobody)")
+ ;; Date.
+ (or (std11-fetch-field "Date")
+ "")
+ ;; Message-ID.
+ (progn
+ (goto-char (point-min))
+ (setq id (if (re-search-forward
+ "^Message-ID: *\\(<[^\n\t> ]+>\\)" nil t)
+ ;; We do it this way to make sure the Message-ID
+ ;; is (somewhat) syntactically valid.
+ (buffer-substring (match-beginning 1)
+ (match-end 1))
+ ;; If there was no message-id, we just fake one
+ ;; to make subsequent routines simpler.
+ (nnheader-generate-fake-message-id))))
+ ;; References.
+ (progn
+ (goto-char (point-min))
+ (if (search-forward "\nReferences: " nil t)
+ (progn
+ (setq end (point))
+ (prog1
+ (buffer-substring (match-end 0) (std11-field-end))
+ (setq ref
+ (buffer-substring
+ (progn
+ ;; (end-of-line)
+ (search-backward ">" end t)
+ (1+ (point)))
+ (progn
+ (search-backward "<" end t)
+ (point))))))
+ ;; Get the references from the in-reply-to header if there
+ ;; were no references and the in-reply-to header looks
+ ;; promising.
+ (if (and (search-forward "\nIn-Reply-To: " nil t)
+ (setq in-reply-to
+ (buffer-substring (match-end 0)
+ (std11-field-end)))
+ (string-match "<[^>]+>" in-reply-to))
+ (let (ref2)
+ (setq ref (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (while (string-match "<[^>]+>"
+ in-reply-to (match-end 0))
+ (setq ref2
+ (substring in-reply-to (match-beginning 0)
+ (match-end 0)))
+ (when (> (length ref2) (length ref))
+ (setq ref ref2)))
+ ref)
+ (setq ref nil))))
+ ;; Chars.
+ (progn
+ (goto-char (point-min))
+ (if (search-forward "\nChars: " nil t)
+ (if (numberp (setq chars (ignore-errors (read cur))))
+ chars 0)
+ 0))
+ ;; Lines.
+ (progn
+ (goto-char (point-min))
+ (if (search-forward "\nLines: " nil t)
+ (if (numberp (setq lines (ignore-errors (read cur))))
+ lines 0)
+ 0))
+ ;; Xref.
+ (std11-fetch-field "Xref")
+ ))
+ (goto-char (point-min))
+ (if (setq ctype (std11-fetch-field "Content-Type"))
+ (mime-entity-set-content-type-internal
+ header (mime-parse-Content-Type ctype)))
+ )
+ (when (setq header
+ (gnus-dependencies-add-header
+ header dependencies force-new))
+ (push header headers))
+ )
+ (setq count (1+ count))
+
+ (and large
+ (zerop (% count 20))
+ (nnheader-message 5 "%s: Receiving headers... %d%%"
+ backend
+ (/ (* count 100) number))))
+
+ (when large
+ (nnheader-message 5 "%s: Receiving headers...done" backend))
+
+ headers))))
+
+(defun nnheader-retrieve-headers-from-directory (articles
+ directory dependencies
+ &optional
+ fetch-old force-new large
+ backend)
+ (cons 'header
+ (nreverse (nnheader-retrieve-headers-from-directory*
+ articles directory dependencies
+ fetch-old force-new large backend))))
+
+(defun nnheader-get-newsgroup-headers-xover* (sequence
+ &optional
+ force-new dependencies
+ group)
+ "Parse the news overview data in the server buffer, and return a
+list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
+ ;; Get the Xref when the users reads the articles since most/some
+ ;; NNTP servers do not include Xrefs when using XOVER.
+ ;; (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
+ (let ((cur nntp-server-buffer)
+ number headers header)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;; Allow the user to mangle the headers before parsing them.
+ (gnus-run-hooks 'gnus-parse-headers-hook)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (condition-case ()
+ (while (and sequence (not (eobp)))
+ (setq number (read cur))
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence)))
+ (and sequence
+ (eq number (car sequence))
+ (progn
+ (setq sequence (cdr sequence))
+ (setq header (inline
+ (gnus-nov-parse-line
+ number dependencies force-new))))
+ (push header headers))
+ (forward-line 1))
+ (error
+ (gnus-error 4 "Strange nov line (%d)"
+ (count-lines (point-min) (point)))))
+ (forward-line 1))
+ ;; A common bug in inn is that if you have posted an article and
+ ;; then retrieves the active file, it will answer correctly --
+ ;; the new article is included. However, a NOV entry for the
+ ;; article may not have been generated yet, so this may fail.
+ ;; We work around this problem by retrieving the last few
+ ;; headers using HEAD.
+ headers)))
+
;; 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
(unless (gnus-buffer-live-p nntp-server-buffer)
(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.
+ (set (make-local-variable 'nntp-process-response) nil)
t))
;;; Various functions the backends use.
nil
(narrow-to-region (point-min) (1- (point)))
(goto-char (point-min))
- (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
+ (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
(goto-char (match-end 0)))
(prog1
(eobp)
(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)
(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 (current-buffer))
+ (buffer-disable-undo)
(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)
(defsubst nnheader-file-to-number (file)
"Take a file name and return the article number."
- (if (not (boundp 'jka-compr-compression-info-list))
+ (if (string= nnheader-numerical-short-files "^[0-9]+$")
(string-to-int file)
(string-match nnheader-numerical-short-files file)
(string-to-int (match-string 0 file))))
"Fold continuation lines in the current buffer."
(nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
-(defun nnheader-translate-file-chars (file)
+(defun nnheader-translate-file-chars (file &optional full)
+ "Translate FILE into something that can be a file name.
+If FULL, translate everything."
(if (null nnheader-file-name-translation-alist)
;; No translation is necessary.
file
- ;; We translate -- but only the file name. We leave the directory
- ;; alone.
(let* ((i 0)
trans leaf path len)
- (if (string-match "/[^/]+\\'" file)
- ;; This is needed on NT's and stuff.
- (setq leaf (substring file (1+ (match-beginning 0)))
- path (substring file 0 (1+ (match-beginning 0))))
- ;; Fall back on this.
- (setq leaf (file-name-nondirectory file)
- path (file-name-directory file)))
+ (if full
+ ;; Do complete translation.
+ (setq leaf (copy-sequence file)
+ path "")
+ ;; We translate -- but only the file name. We leave the directory
+ ;; alone.
+ (if (string-match "/[^/]+\\'" file)
+ ;; This is needed on NT's and stuff.
+ (setq leaf (substring file (1+ (match-beginning 0)))
+ path (substring file 0 (1+ (match-beginning 0))))
+ ;; Fall back on this.
+ (setq leaf (file-name-nondirectory file)
+ path (file-name-directory file))))
(setq len (length leaf))
(while (< i len)
(when (setq trans (cdr (assq (aref leaf i)
(defun nnheader-get-report (backend)
"Get the most recent report from BACKEND."
(condition-case ()
- (message "%s" (symbol-value (intern (format "%s-status-string"
+ (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
backend))))
- (error (message ""))))
+ (error (nnheader-message 5 ""))))
(defun nnheader-insert (format &rest args)
"Clear the communication buffer and insert FORMAT and ARGS into the buffer.
(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)
(concat dir group "/")
;; If not, we translate dots into slashes.
(concat dir
- (gnus-encode-coding-string
+ (encode-coding-string
(nnheader-replace-chars-in-string group ?. ?/)
nnheader-pathname-coding-system)
"/")))
(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)
- (coding-system-for-read nnheader-file-coding-system))
- (insert-file-contents filename visit beg end replace)))
+ (enable-local-eval 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)
- (coding-system-for-read nnheader-file-coding-system))
- (apply 'find-file-noselect args)))
+ (after-insert-file-functions nil)
+ (enable-local-eval 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