X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnheader.el;h=a8e8e7d08efbd9603b78062a8558ee6a526d7902;hb=c52fcc4a0c585ea3770843f80579ad5a00dab7e8;hp=7c5ddb9fcc82bbb648186fe191c34e958d88e394;hpb=2b3de2090d6596687d795c6ca4e46a34cfb335aa;p=gnus diff --git a/lisp/nnheader.el b/lisp/nnheader.el index 7c5ddb9fc..a8e8e7d08 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1,8 +1,7 @@ ;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, -;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1987-1990, 1993-1998, 2000-2011 +;; Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Lars Magne Ingebrigtsen @@ -27,6 +26,9 @@ ;;; Code: +;; For Emacs <22.2 and XEmacs. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar nnmail-extra-headers) @@ -41,6 +43,8 @@ (require 'mail-utils) (require 'mm-util) (require 'gnus-util) +(autoload 'gnus-range-add "gnus-range") +(autoload 'gnus-remove-from-range "gnus-range") ;; FIXME none of these are used explicitly in this file. (autoload 'gnus-sorted-intersection "gnus-range") (autoload 'gnus-intersection "gnus-range") @@ -75,7 +79,7 @@ Integer values will in effect be rounded up to the nearest multiple of "*Length of each read operation when trying to fetch HEAD headers.") (defvar nnheader-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de ;; @@ -100,7 +104,7 @@ Shorter values mean quicker response, but are more CPU intensive.") (defvar nnheader-file-name-translation-alist (let ((case-fold-search t)) (cond - ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" + ((string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) (append (mapcar (lambda (c) (cons c ?_)) '(?: ?* ?\" ?< ?> ??)) @@ -121,7 +125,6 @@ on your system, you could say something like: (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") -(autoload 'message-remove-header "message") (autoload 'gnus-buffer-live-p "gnus-util") ;;; Header access macros. @@ -364,15 +367,13 @@ on your system, you could say something like: (setq num 0 beg (point-min) end (point-max)) - (goto-char (point-min)) ;; Search to the beginning of the next header. Error ;; messages do not begin with 2 or 3. (when (re-search-forward "^[23][0-9]+ " nil t) - (end-of-line) (setq num (read cur) beg (point) end (if (search-forward "\n.\n" nil t) - (- (point) 2) + (goto-char (- (point) 2)) (point))))) (with-temp-buffer (insert-buffer-substring cur beg end) @@ -462,7 +463,7 @@ on your system, you could say something like: (let ((extra (mail-header-extra header))) (while extra (insert (symbol-name (caar extra)) - ": " (cdar extra) "\t") + ": " (if (stringp (cdar extra)) (cdar extra) "") "\t") (pop extra)))) (insert "\n") (backward-char 1) @@ -569,8 +570,6 @@ the line could be found." (defvar nntp-server-buffer nil) (defvar nntp-process-response nil) -(defvar news-reply-yank-from nil) -(defvar news-reply-yank-message-id nil) (defvar nnheader-callback-function nil) @@ -662,8 +661,12 @@ the line could be found." ;; without inserting extra newline. (fill-region-as-paragraph begin (1+ (point)))))) +(declare-function message-remove-header "message" + (header &optional is-regexp first reverse)) + (defun nnheader-replace-header (header new-value) "Remove HEADER and insert the NEW-VALUE." + (require 'message) (save-excursion (save-restriction (nnheader-narrow-to-headers) @@ -781,8 +784,7 @@ If FULL, translate everything." ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt - cygwin))) + (memq system-type '(windows-nt cygwin))) ;; This is needed on NT and stuff, because ;; file-name-nondirectory is not enough to split ;; file names, containing ':', e.g. @@ -820,19 +822,22 @@ The first string in ARGS can be a format string." (apply 'format args))) nil) -(defun nnheader-get-report (backend) +(defun nnheader-get-report-string (backend) "Get the most recent report from BACKEND." (condition-case () - (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (nnheader-message 5 "")))) + (format "%s" (symbol-value (intern (format "%s-status-string" + backend)))) + (error ""))) + +(defun nnheader-get-report (backend) + "Get the most recent report from BACKEND." + (nnheader-message 5 (nnheader-get-report-string backend))) (defun nnheader-insert (format &rest args) "Clear the communication buffer and insert FORMAT and ARGS into the buffer. If FORMAT isn't a format string, it and all ARGS will be inserted without formatting." - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (erase-buffer) (if (string-match "%" format) (insert (apply 'format format args)) @@ -992,18 +997,18 @@ find-file-hooks, etc. (defun nnheader-find-file-noselect (&rest args) "Open a file with some variables bound. See `find-file-noselect' for the arguments." - (let* ((format-alist nil) - (auto-mode-alist (mm-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil) - (enable-local-eval nil) - (coding-system-for-read nnheader-file-coding-system) - (version-control 'never) - (ffh (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (val (symbol-value ffh))) + (letf* ((format-alist nil) + (auto-mode-alist (mm-auto-mode-alist)) + ((default-value 'major-mode) 'fundamental-mode) + (enable-local-variables nil) + (after-insert-file-functions nil) + (enable-local-eval nil) + (coding-system-for-read nnheader-file-coding-system) + (version-control 'never) + (ffh (if (boundp 'find-file-hook) + 'find-file-hook + 'find-file-hooks)) + (val (symbol-value ffh))) (set ffh nil) (unwind-protect (apply 'find-file-noselect args) @@ -1074,6 +1079,46 @@ See `find-file-noselect' for the arguments." (truncate nnheader-read-timeout)) 1000)))) +(defun nnheader-update-marks-actions (backend-marks actions) + (dolist (action actions) + (let ((range (nth 0 action)) + (what (nth 1 action)) + (marks (nth 2 action))) + (dolist (mark marks) + (setq backend-marks + (gnus-update-alist-soft + mark + (cond + ((eq what 'add) + (gnus-range-add (cdr (assoc mark backend-marks)) range)) + ((eq what 'del) + (gnus-remove-from-range + (cdr (assoc mark backend-marks)) range)) + ((eq what 'set) + range)) + backend-marks))))) + backend-marks) + +(defmacro nnheader-insert-buffer-substring (buffer &optional start end) + "Copy string from unibyte buffer to multibyte current buffer." + (if (featurep 'xemacs) + `(insert-buffer-substring ,buffer ,start ,end) + `(if enable-multibyte-characters + (insert (with-current-buffer ,buffer + (mm-string-to-multibyte + ,(if (or start end) + `(buffer-substring (or ,start (point-min)) + (or ,end (point-max))) + '(buffer-string))))) + (insert-buffer-substring ,buffer ,start ,end)))) + +(defvar nnheader-last-message-time '(0 0)) +(defun nnheader-message-maybe (&rest args) + (let ((now (current-time))) + (when (> (float-time (time-subtract now nnheader-last-message-time)) 1) + (setq nnheader-last-message-time now) + (apply 'nnheader-message args)))) + (when (featurep 'xemacs) (require 'nnheaderxm)) @@ -1081,5 +1126,4 @@ See `find-file-noselect' for the arguments." (provide 'nnheader) -;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202 ;;; nnheader.el ends here