X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=7ef13f243782bdd7e9ee8371ff02fb7e6e67b922;hb=ed341c45e5e97c823e86a642b7136a140f2af6f3;hp=97c842b2d0c208497581cd1d13c2f58a00752411;hpb=4c2e20a67169654caf07221554d9e637d3f7bbfa;p=elisp%2Fgnus.git- diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 97c842b..7ef13f2 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,8 +1,8 @@ ;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc. +;; Copyright (C) 1987,88,89,90,93,94,95,96,97,98 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -59,7 +59,10 @@ on your system, you could say something like: (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") + (autoload 'gnus-encode-coding-string "gnus-ems")) ;;; Header access macros. @@ -166,7 +169,7 @@ on your system, you could say something like: (let ((case-fold-search t) (cur (current-buffer)) (buffer-read-only nil) - in-reply-to lines p) + in-reply-to lines p ref) (goto-char (point-min)) (when naked (insert "\n")) @@ -214,8 +217,9 @@ on your system, you could say something like: (goto-char p) (if (search-forward "\nmessage-id:" nil t) (buffer-substring - (1- (or (search-forward "<" nil t) (point))) - (or (search-forward ">" nil t) (point))) + (1- (or (search-forward "<" (gnus-point-at-eol) t) + (point))) + (or (search-forward ">" (gnus-point-at-eol) t) (point))) ;; If there was no message-id, we just fake one to make ;; subsequent routines simpler. (nnheader-generate-fake-message-id))) @@ -230,9 +234,16 @@ on your system, you could say something like: (if (and (search-forward "\nin-reply-to: " nil t) (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) - (substring in-reply-to (match-beginning 0) - (match-end 0)) - ""))) + (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) + nil))) ;; Chars. 0 ;; Lines. @@ -389,7 +400,6 @@ 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. @@ -552,7 +562,7 @@ If FILE is t, return the buffer contents as a string." (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)))) @@ -584,21 +594,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) @@ -619,9 +635,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. @@ -744,8 +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))))) -;; 1997/5/4 by MORIOKA Tomohiko -(defvar nnheader-file-coding-system nil +(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) @@ -757,20 +772,21 @@ find-file-hooks, etc. (let ((format-alist nil) (auto-mode-alist (nnheader-auto-mode-alist)) (default-major-mode 'fundamental-mode) - (after-insert-file-functions nil) - ;; 1997/5/4 by MORIOKA Tomohiko - (coding-system-for-read nnheader-file-coding-system)) - (insert-file-contents filename visit beg end replace))) + (enable-local-variables nil) + (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) - ;; 1997/5/16 by MORIOKA Tomohiko - (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." @@ -792,6 +808,16 @@ find-file-hooks, etc. (pop files)) (nreverse out))) +(defun nnheader-directory-files (&rest args) + "Same as `directory-files', but prune \".\" and \"..\"." + (let ((files (apply 'directory-files args)) + out) + (while files + (unless (member (file-name-nondirectory (car files)) '("." "..")) + (push (car files) out)) + (pop files)) + (nreverse out))) + (defmacro nnheader-skeleton-replace (from &optional to regexp) `(let ((new (generate-new-buffer " *nnheader replace*")) (cur (current-buffer)) @@ -830,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))