X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=5751973723b21cde8ea35c69d7c5fabfd9fcd94e;hb=754a007c9c67f3506008dab6e7e8943eb51848f2;hp=8288b1da20e4c1a02647e7885c8dee2d99af90f0;hpb=b28454eed83f245c4160228b076134ce930b320a;p=gnus diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 8288b1da2..575197372 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,5 +1,5 @@ ;;; 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 @@ -37,6 +37,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + (require 'mail-utils) (defvar nnheader-max-head-length 4096 @@ -58,7 +60,9 @@ on your system, you could say something like: (autoload 'message-remove-header "message") (autoload 'cancel-function-timers "timers") (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-buffer-live-p "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. @@ -165,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")) @@ -178,7 +182,7 @@ on your system, you could say something like: ;; a case (which basically was the old function) is actually ;; about twice as fast, even though it looks messier. You ;; can't have everything, I guess. Speed and elegance - ;; doesn't always go hand in hand. + ;; don't always go hand in hand. (vector ;; Number. (if naked @@ -211,8 +215,11 @@ on your system, you could say something like: ;; Message-ID. (progn (goto-char p) - (if (search-forward "\nmessage-id: " nil t) - (nnheader-header-value) + (if (search-forward "\nmessage-id:" nil t) + (buffer-substring + (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))) @@ -227,8 +234,14 @@ 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)))) ""))) ;; Chars. 0 @@ -338,7 +351,10 @@ the line could be found." (eobp)) (setq found t) (setq prev (point)) - (cond ((> (setq num (read cur)) article) + (while (and (not (numberp (setq num (read cur)))) + (not (eobp))) + (gnus-delete-line)) + (cond ((> num article) (setq max (point))) ((< num article) (setq min (point))) @@ -666,6 +682,9 @@ without formatting." (or (not (numberp gnus-verbose-backends)) (<= level gnus-verbose-backends))) +(defvar nnheader-pathname-coding-system 'iso-8859-1 + "*Coding system for pathname.") + (defun nnheader-group-pathname (group dir &optional file) "Make pathname for GROUP." (concat @@ -674,7 +693,11 @@ without formatting." (if (file-directory-p (concat dir group)) (concat dir group "/") ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) + (concat dir + (gnus-encode-coding-string + (nnheader-replace-chars-in-string group ?. ?/) + nnheader-pathname-coding-system) + "/"))) (cond ((null file) "") ((numberp file) (int-to-string file)) (t file)))) @@ -731,6 +754,9 @@ 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 'raw-text + "Coding system used in file backends of Gnus.") + (defun nnheader-insert-file-contents (filename &optional visit beg end replace) "Like `insert-file-contents', q.v., but only reads in the file. A buffer may be modified in several ways after reading into the buffer due @@ -740,7 +766,8 @@ 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)) + (after-insert-file-functions nil) + (coding-system-for-read nnheader-file-coding-system)) (insert-file-contents filename visit beg end replace))) (defun nnheader-find-file-noselect (&rest args) @@ -748,7 +775,8 @@ 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)) + (after-insert-file-functions nil) + (coding-system-for-read nnheader-file-coding-system)) (apply 'find-file-noselect args))) (defun nnheader-auto-mode-alist () @@ -771,6 +799,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))