X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=8d1edeb44b22c233575b86db1c7793a3b11b7c8e;hb=21b78c5cf88ba55a2a842d21a8ec028cf652d9b3;hp=b37b539738042557077386fa8006904cd39a2a89;hpb=8f23fa8532a7a28694825cea0fe3e6140b4eaa08;p=elisp%2Fgnus.git- diff --git a/lisp/nnheader.el b/lisp/nnheader.el index b37b539..8d1edeb 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. @@ -24,22 +26,12 @@ ;;; 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. The -;; 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: (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 +41,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,93 +53,112 @@ 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-encode-coding-string "gnus-ems")) + (autoload 'gnus-buffer-live-p "gnus-util")) ;;; Header access macros. +;; 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. The +;; 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 extra] +;; +;; (That next-to-last entry is defined as "misc" in the NOV format, +;; but Gnus uses it for xrefs.) + +(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 'mime-gnus-entity-extra-internal) +(defalias 'mail-header-set-extra 'mime-gnus-entity-set-extra-internal) -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) +(defun 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 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 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 @@ -183,7 +194,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 @@ -233,11 +244,12 @@ on your system, you could say something like: ;; 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)) @@ -257,7 +269,20 @@ on your system, you could say something like: (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))))) @@ -270,37 +295,51 @@ on your system, you could say something like: (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)) @@ -311,7 +350,16 @@ 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) "\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) @@ -382,9 +430,195 @@ the line could be found." (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 @@ -400,10 +634,10 @@ the line could be found." (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. @@ -446,7 +680,7 @@ the line could be found." 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) @@ -455,7 +689,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) @@ -494,57 +729,11 @@ 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 (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) @@ -595,21 +784,27 @@ If FILE is t, return the buffer contents as a string." "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) @@ -630,9 +825,9 @@ The first string in ARGS can be a format string." (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. @@ -683,7 +878,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) @@ -695,7 +890,7 @@ without formatting." (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) "/"))) @@ -767,18 +962,23 @@ find-file-hooks, etc. (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." @@ -814,8 +1014,6 @@ 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 +1046,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))