From 4ef9468798334f7bafc5ab73bb246a3a5878de3a Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 28 Jan 2002 00:07:14 +0000 Subject: [PATCH] Synch with Oort Gnus. --- contrib/ChangeLog | 6 + contrib/gpg.el | 2 +- lisp/ChangeLog | 98 ++++++++++- lisp/dgnushack.el | 4 +- lisp/gnus-agent.el | 94 +++++----- lisp/gnus-art.el | 19 +- lisp/gnus-ems.el | 2 +- lisp/gnus-sum.el | 95 ++++------ lisp/gnus-util.el | 28 +++ lisp/mm-url.el | 5 +- lisp/mml2015.el | 6 +- lisp/nnagent.el | 21 ++- lisp/nnheader.el | 19 ++ lisp/nnmail.el | 8 + lisp/nnml.el | 45 ++--- lisp/pop3.el | 6 +- lisp/smiley-ems.el | 159 ----------------- lisp/smiley.el | 490 +++++++++++----------------------------------------- texi/ChangeLog | 4 + texi/gnus-ja.texi | 7 +- texi/gnus.texi | 7 +- 21 files changed, 434 insertions(+), 691 deletions(-) delete mode 100644 lisp/smiley-ems.el diff --git a/contrib/ChangeLog b/contrib/ChangeLog index 9f58afd..fc27e8c 100644 --- a/contrib/ChangeLog +++ b/contrib/ChangeLog @@ -1,3 +1,9 @@ +2002-01-25 Josh Huber + + * gpg.el (gpg-command-decrypt): Enable the status-fd command line + option to gpg when decrypting so `mml2015-mailcrypt-decrypt' can + parse and display the output. + 2002-01-01 Lars Magne Ingebrigtsen * gnus-mdrtn.el (gnus-moderation-cancel-article): Insert an extra diff --git a/contrib/gpg.el b/contrib/gpg.el index c87dc64..a747594 100644 --- a/contrib/gpg.el +++ b/contrib/gpg.el @@ -340,7 +340,7 @@ endings; the input data shall be treated as binary." :group 'gpg-commands) (defcustom gpg-command-decrypt - '(gpg . ("--decrypt" "--batch" "--passphrase-fd=0")) + '(gpg . ("--status-fd" "2" "--decrypt" "--batch" "--passphrase-fd=0")) "Command to decrypt a message. The invoked program has to read the passphrase from standard input, followed by the encrypted message. It writes the decrypted diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6aec60c..dcca939 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,99 @@ +2002-01-27 ShengHuo ZHU + + * gnus-agent.el (gnus-agent-fetch-articles): Don't save empty articles. + +2002-01-27 Lars Magne Ingebrigtsen + + * gnus-util.el (gnus-cache-file-contents): Don't use equalp. + +2002-01-26 Lars Magne Ingebrigtsen + + * nnheader.el (nnheader-insert-nov-file): Increased cutoff to + 32K. + + * gnus-sum.el (gnus-summary-expire-articles): Clean up. + + * nnmail.el (nnmail-article-group): Decode headers before running + split rules over them. + (nnmail-mail-splitting-charset): New variable. + + * smiley.el: Replaced with smiley-ems.el. + +2002-01-26 ShengHuo ZHU + + * mm-url.el (mm-url-predefined-programs): Add w3m. + (mm-url-program): Ditto. + +2002-01-26 Lars Magne Ingebrigtsen + + * nnml.el (nnml-use-compressed-files): New variable. + (nnml-filenames-are-evil): Removed. + (nnml-current-group-article-to-file-alist): Don't use. + (nnml-update-file-alist): Inhibit. + (nnml-article-to-file): Use new var. + +2002-01-26 ShengHuo ZHU + + * gnus-util.el (gnus-parse-without-error): Add edebug-form-spec. + + * nnagent.el (nnagent-retrieve-headers): loop until eobp. + +2002-01-26 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-load-alist): Use new caching + function. + + * gnus-util.el (gnus-cache-file-contents): New function. + + * gnus-agent.el (gnus-agent-file-loading-cache): New variable. + (gnus-agent-load-alist): Use it. + + * nnagent.el (nnagent-retrieve-headers): Use optimized function. + + * nnheader.el (nnheader-insert-nov-file): New function. + + * gnus-util.el (gnus-parse-without-error): Correct the loop. + + * gnus-sum.el (gnus-dependencies-add-header): Use in-reply-to if + there are no references. + (gnus-extract-message-id-from-in-reply-to): New function. + (gnus-nov-parse-line): Use in-reply-to if there are no + references. + +2002-01-25 Lars Magne Ingebrigtsen + + * nnagent.el (nnagent-retrieve-headers): Use new macro. + + * gnus-util.el (gnus-parse-without-error): New macro. + +2002-01-25 ShengHuo ZHU + + * gnus-art.el (gnus-article-wash-html-with-w3m): Call w3m-region. + (gnus-article-wash-function): use locate-library to decide which + to use. + +2002-01-25 Simon Josefsson + + * pop3.el (pop3-munge-message-separator): Work if no date. From + Marius Vollmer . + +2002-01-25 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-save-alist): Fix. + + * nnagent.el (nnagent-retrieve-headers): Must have cut too much by + mistake. Reinstated lost code. + +2002-01-25 Josh Huber + + * mml2015.el (mml2015-mailcrypt-decrypt): Display a signature if + one exists in the case of an encrypted message with an internal + signature. + +2002-01-25 Lars Magne Ingebrigtsen + + * gnus-agent.el (gnus-agent-save-alist): Optimized. + 2002-01-25 Katsumi Yamaoka * dgnushack.el: Commented out the experimental code. @@ -40,7 +136,7 @@ 2002-01-24 ShengHuo ZHU * gnus-agent.el (gnus-agent-request-article): Make sure it is not - empty file. + an empty file. * nnweb.el (url): Ignore errors when request url. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index acb0c4c..55e67e3 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -502,10 +502,10 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again. (message "No bbdb: %s %s (ignored)" code (locate-library "bbdb")) '("gnus-bbdb.el"))) (unless (featurep 'xemacs) - '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el" "smiley.el")) + '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")) (when (and (not (featurep 'xemacs)) (<= emacs-major-version 20)) - '("smiley-ems.el")) + '("smiley.el")) (when (and (fboundp 'base64-decode-string) (subrp (symbol-function 'base64-decode-string))) '("base64.el")) diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 48322d5..77b47bd 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -155,6 +155,7 @@ If this is `ask' the hook will query the user." (defvar gnus-agent-file-name nil) (defvar gnus-agent-send-mail-function nil) (defvar gnus-agent-file-coding-system 'raw-text) +(defvar gnus-agent-file-loading-cache nil) ;; Dynamic variables (defvar gnus-headers) @@ -958,32 +959,33 @@ the actual number of articles toggled is returned." (while pos (narrow-to-region (cdar pos) (or (cdadr pos) (point-max))) (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (when (search-backward "\nXrefs: " nil t) - ;; Handle crossposting. - (skip-chars-forward "^ ") - (skip-chars-forward " ") - (setq crosses nil) - (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +") - (push (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (buffer-substring (match-beginning 2) - (match-end 2))) - crosses) - (goto-char (match-end 0))) - (gnus-agent-crosspost crosses (caar pos)))) - (goto-char (point-min)) - (if (not (re-search-forward "^Message-ID: *<\\([^>\n]+\\)>" nil t)) - (setq id "No-Message-ID-in-article") - (setq id (buffer-substring (match-beginning 1) (match-end 1)))) - (write-region-as-coding-system - gnus-agent-file-coding-system - (point-min) (point-max) - (concat dir (number-to-string (caar pos))) nil 'silent) - (when (setq elem (assq (caar pos) gnus-agent-article-alist)) - (setcdr elem t)) - (gnus-agent-enter-history - id (or crosses (list (cons group (caar pos)))) date) + (unless (eobp) ;; Don't save empty articles. + (when (search-forward "\n\n" nil t) + (when (search-backward "\nXrefs: " nil t) + ;; Handle cross posting. + (skip-chars-forward "^ ") + (skip-chars-forward " ") + (setq crosses nil) + (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) +") + (push (cons (buffer-substring (match-beginning 1) + (match-end 1)) + (buffer-substring (match-beginning 2) + (match-end 2))) + crosses) + (goto-char (match-end 0))) + (gnus-agent-crosspost crosses (caar pos)))) + (goto-char (point-min)) + (if (not (re-search-forward + "^Message-ID: *<\\([^>\n]+\\)>" nil t)) + (setq id "No-Message-ID-in-article") + (setq id (buffer-substring (match-beginning 1) (match-end 1)))) + (write-region-as-coding-system + gnus-agent-file-coding-system (point-min) (point-max) + (concat dir (number-to-string (caar pos))) nil 'silent) + (when (setq elem (assq (caar pos) gnus-agent-article-alist)) + (setcdr elem t)) + (gnus-agent-enter-history + id (or crosses (list (cons group (caar pos)))) date)) (widen) (pop pos))) (gnus-agent-save-alist group))))) @@ -1135,23 +1137,35 @@ the actual number of articles toggled is returned." (defun gnus-agent-load-alist (group &optional dir) "Load the article-state alist for GROUP." - (setq gnus-agent-article-alist - (gnus-agent-read-file - (if dir - (expand-file-name ".agentview" dir) - (gnus-agent-article-name ".agentview" group))))) + (let ((file)) + (setq gnus-agent-article-alist + (gnus-cache-file-contents + (if dir + (expand-file-name ".agentview" dir) + (gnus-agent-article-name ".agentview" group)) + 'gnus-agent-file-loading-cache + 'gnus-agent-read-file)))) (defun gnus-agent-save-alist (group &optional articles state dir) "Save the article-state alist for GROUP." - (let ((file-name-coding-system nnmail-pathname-coding-system) - (pathname-coding-system nnmail-pathname-coding-system) - print-level print-length item) - (dolist (art articles) - (if (setq item (memq art gnus-agent-article-alist)) - (setcdr item state) - (push (cons art state) gnus-agent-article-alist))) - (setq gnus-agent-article-alist - (sort gnus-agent-article-alist 'car-less-than-car)) + (let* ((file-name-coding-system nnmail-pathname-coding-system) + (pathname-coding-system nnmail-pathname-coding-system) + (prev (cons nil gnus-agent-article-alist)) + (all prev) + print-level print-length item article) + (while (setq article (pop articles)) + (while (and (cdr prev) + (< (caadr prev) article)) + (setq prev (cdr prev))) + (cond + ((not (cdr prev)) + (setcdr prev (list (cons article state)))) + ((> (caadr prev) article) + (setcdr prev (cons (cons article state) (cdr prev)))) + ((= (caadr prev) article) + (setcdr (cadr prev) state))) + (setq prev (cdr prev))) + (setq gnus-agent-article-alist (cdr all)) (with-temp-file (if dir (expand-file-name ".agentview" dir) (gnus-agent-article-name ".agentview" group)) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index a0d1e62..d162fa4 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1135,7 +1135,7 @@ See Info node `(gnus)Customizing Articles' and Info node (gnus-image-type-available-p 'xpm) (gnus-image-type-available-p 'pbm))) "If non-nil, gnus uses `smiley-mule' for displaying smileys rather than -`smiley-ems'. It defaults to t when Emacs 20 or earlier is running. +`smiley'. It defaults to t when Emacs 20 or earlier is running. `smiley-mule' is boundled in BITMAP-MULE package. You can set it to t even if you are using Emacs 21+. It has no effect on XEmacs." :group 'gnus-article-various @@ -1153,7 +1153,7 @@ even if you are using Emacs 21+. It has no effect on XEmacs." (defvar gnus-article-smiley-mule-loaded-p nil "Internal variable used to say whether `smiley-mule' is loaded (whether -smiley functions are not overridden by `smiley-ems').") +smiley functions are not overridden by `smiley').") (defcustom gnus-treat-display-smileys (if (or (and (featurep 'xemacs) @@ -1283,7 +1283,11 @@ It is a string, such as \"PGP\". If nil, ask user." :type 'string :group 'mime-security) -(defcustom gnus-article-wash-function 'gnus-article-wash-html-with-w3 +(defcustom gnus-article-wash-function + (cond ((locate-library "w3") + 'gnus-article-wash-html-with-w3) + ((locate-library "w3m") + 'gnus-article-wash-html-with-w3m)) "Function used for converting HTML into text." :type '(radio (function-item gnus-article-wash-html-with-w3) (function-item gnus-article-wash-html-with-w3m)) @@ -1896,7 +1900,7 @@ unfolded." (when (and (>= emacs-major-version 21) (not gnus-article-should-use-smiley-mule) gnus-article-smiley-mule-loaded-p) - (load "smiley-ems" nil t) + (load "smiley" nil t) (setq gnus-article-smiley-mule-loaded-p nil)) (when (and gnus-article-should-use-smiley-mule (not gnus-article-smiley-mule-loaded-p)) @@ -2287,9 +2291,10 @@ If READ-CHARSET, ask for a coding system." (defun gnus-article-wash-html-with-w3m () "Wash the current buffer with w3m." - (shell-command-on-region - (point) (point-max) "w3m -T text/html" t t)) - + (mm-setup-w3m) + (w3m-region (point) (point-max)) + (setq mm-w3m-minor-mode t)) + (defun article-hide-list-identifiers () "Remove list identifies from the Subject header. The `gnus-list-identifiers' variable specifies what to do." diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el index 6f30ec4..8a4d70a 100644 --- a/lisp/gnus-ems.el +++ b/lisp/gnus-ems.el @@ -50,7 +50,7 @@ (if (or (featurep 'xemacs) (>= emacs-major-version 21)) - (autoload 'smiley-region "smiley-ems") + (autoload 'smiley-region "smiley") (autoload 'smiley-region "smiley-mule")) (defun gnus-kill-all-overlays () diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 6b0c027..fc50a4e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3605,7 +3605,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header nil))) (when header - ;; First check if that we are not creating a References loop. + ;; First check that we are not creating a References loop. (setq ref (gnus-parent-id (mail-header-references header))) (while (and ref (setq ref-dep (intern-soft ref dependencies)) @@ -3627,6 +3627,11 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (set ref-dep (list nil (symbol-value id-dep))))) header)) +(defun gnus-extract-message-id-from-in-reply-to (string) + (if (string-match "<[^>]+>" string) + (substring string (match-beginning 0) (match-end 0)) + nil)) + (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) (mail-parse-charset gnus-newsgroup-charset) @@ -3703,7 +3708,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (gnus-point-at-eol)) (buffer (current-buffer)) - header) + header references in-reply-to) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect @@ -3730,39 +3735,16 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (widen)) + (when (and (string= references "") + (setq in-reply-to (mail-header-extra header)) + (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to)))) + (mail-header-set-references + header (gnus-extract-message-id-from-in-reply-to in-reply-to))) + (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (gnus-dependencies-add-header header dependencies force-new))) -(defsubst gnus-nov-parse-line-1 (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - number ; number - (nnheader-nov-field) ; subject - (nnheader-nov-field) ; from - (nnheader-nov-field) ; date - (nnheader-nov-read-message-id) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines - (unless (eobp) - (nnheader-nov-field)) ; Xref - (nnheader-nov-parse-extra)))) ; extra - - (widen)) - (gnus-dependencies-add-header header dependencies force-new))) - (defun gnus-build-get-header (id) "Look through the buffer of NOV lines and find the header to ID. Enter this line into the dependencies hash table, and return @@ -5538,29 +5520,24 @@ Return a list of headers that match SEQUENCE (see ;; 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 (or sequence allp) - (not (eobp))) - (setq number (read cur)) - (when (not allp) - (while (and sequence - (< (car sequence) number)) - (setq sequence (cdr sequence)))) - (when (and (or allp - (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)) + (gnus-parse-without-error + (while (and (or sequence allp) + (not (eobp))) + (setq number (read cur)) + (when (not allp) + (while (and sequence + (< (car sequence) number)) + (setq sequence (cdr sequence)))) + (when (and (or allp + (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))) ;; 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 @@ -8814,12 +8791,10 @@ This will be the case if the article has both been mailed and posted." ;; really expired articles as nonexistent. (unless (eq es expirable) ;If nothing was expired, we don't mark. (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable)))))) + (dolist (article expirable) + (when (and (not (memq article es)) + (gnus-data-find article)) + (gnus-summary-mark-article article gnus-canceled-mark)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 4edf01f..84303c1 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -1307,6 +1307,34 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (and (featurep 'xemacs) t))) +(put 'gnus-parse-without-error 'lisp-indent-function 0) +(put 'gnus-parse-without-error 'edebug-form-spec '(body)) + +(defmacro gnus-parse-without-error (&rest body) + "Allow continuing onto the next line even if an error occurs." + `(while (not (eobp)) + (condition-case () + (progn + ,@body + (goto-char (point-max))) + (error + (gnus-error 4 "Invalid data on line %d" + (count-lines (point-min) (point))) + (forward-line 1))))) + +(defun gnus-cache-file-contents (file variable function) + "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION." + (let ((time (nth 5 (file-attributes file))) + contents value) + (if (or (null (setq value (symbol-value variable))) + (not (equal (car value) file)) + (not (equal (nth 1 value) time))) + (progn + (setq contents (funcall function file)) + (set variable (list file time contents)) + contents) + (nth 2 value)))) + (provide 'gnus-util) ;;; gnus-util.el ends here diff --git a/lisp/mm-url.el b/lisp/mm-url.el index 2ab90f1..74b4858 100644 --- a/lisp/mm-url.el +++ b/lisp/mm-url.el @@ -1,5 +1,5 @@ ;;; mm-url.el --- a wrapper of url functions/commands for Gnus -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu @@ -51,18 +51,21 @@ (defvar mm-url-predefined-programs '((wget "wget" "-q" "-O" "-") + (w3m "w3m" "-dump_source") (lynx "lynx" "-source") (curl "curl"))) (defcustom mm-url-program (cond ((exec-installed-p "wget") 'wget) + ((executable-find "w3m") 'w3m) ((exec-installed-p "lynx") 'lynx) ((exec-installed-p "curl") 'curl) (t "GET")) "The url grab program." :type '(choice (symbol :tag "wget" wget) + (symbol :tag "w3m" w3m) (symbol :tag "lynx" lynx) (symbol :tag "curl" curl) (string :tag "other")) diff --git a/lisp/mml2015.el b/lisp/mml2015.el index b86a2e1..9001685 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -127,7 +127,11 @@ by you.") (setq handles (mm-dissect-buffer t))) (mm-destroy-parts handle) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") + mm-security-handle 'gnus-info + (concat "OK" + (let ((sig (with-current-buffer mml2015-result-buffer + (mml2015-gpg-extract-signature-details)))) + (concat ", Signer: " sig)))) (if (listp (car handles)) handles (list handles))))) diff --git a/lisp/nnagent.el b/lisp/nnagent.el index 5bdc1e6..a94a8fa 100644 --- a/lisp/nnagent.el +++ b/lisp/nnagent.el @@ -133,16 +133,25 @@ arts n) (save-excursion (gnus-agent-load-alist group) - (setq arts (gnus-set-difference articles + (setq arts (gnus-set-difference articles (mapcar 'car gnus-agent-article-alist))) (set-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents file) + (nnheader-insert-nov-file file (car articles)) (goto-char (point-min)) - ;; This loop is just for the `condition-case' -- if reading bugs - ;; out on a line, it'll still continue on to the next line. So - ;; this look is normally just executed once. - + (gnus-parse-without-error + (while (and arts (not (eobp))) + (setq n (read (current-buffer))) + (when (> n (car arts)) + (beginning-of-line)) + (while (and arts (> n (car arts))) + (insert (format + "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" + (car arts) (car arts))) + (pop arts)) + (when (and arts (= n (car arts))) + (pop arts)) + (forward-line 1))) (while arts (insert (format "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n" diff --git a/lisp/nnheader.el b/lisp/nnheader.el index a00d718..34143f6 100644 --- a/lisp/nnheader.el +++ b/lisp/nnheader.el @@ -1332,6 +1332,25 @@ find-file-hooks, etc. (insert-file-contents-as-coding-system nnheader-file-coding-system filename visit beg end replace))) +(defun nnheader-insert-nov-file (file first) + (let ((size (nth 7 (file-attributes file))) + (cutoff (* 32 1024))) + (if (< size cutoff) + ;; If the file is small, we just load it. + (nnheader-insert-file-contents file) + ;; We start on the assumption that FIRST is pretty recent. If + ;; not, we just insert the rest of the file as well. + (let (current) + (nnheader-insert-file-contents file nil (- size cutoff) size) + (goto-char (point-min)) + (delete-region (point) (or (search-forward "\n" nil 'move) (point))) + (setq current (ignore-errors (read (current-buffer)))) + (if (and (numberp current) + (< current first)) + t + (delete-region (point-min) (point-max)) + (nnheader-insert-file-contents file)))))) + (defun nnheader-find-file-noselect (&rest args) (let ((format-alist nil) (auto-mode-alist (nnheader-auto-mode-alist)) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index 8e0838d..fbef618 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -477,6 +477,11 @@ parameter. It should return nil, `warn' or `delete'." :group 'nnmail :type 'integer) +(defcustom nnmail-mail-splitting-charset nil + "Default charset to be used when splitting incoming mail." + :group 'nnmail + :type 'symbol) + ;;; Internal variables. (defvar nnmail-article-buffer " *nnmail incoming*" @@ -994,6 +999,9 @@ FUNC will be called with the group name to determine the article number." (erase-buffer) ;; Copy the headers into the work buffer. (insert-buffer-substring obuf beg end) + ;; Decode MIME headers and charsets. + (mime-decode-header-in-region (point-min) (point-max) + nnmail-mail-splitting-charset) ;; Fold continuation lines. (goto-char (point-min)) (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) diff --git a/lisp/nnml.el b/lisp/nnml.el index 7f411b0..425b206 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -77,17 +77,14 @@ corresponding marks file (usually named `.marks' in the nnml group directory, but see `nnml-marks-file-name') for the group. Then the marks file will be regenerated properly by Gnus.") -(defvoo nnml-filenames-are-evil t - "If non-nil, Gnus will not assume that the articles file name -is the same as the article number listed in the nov database. This -variable should be set if any of the files are compressed.") - (defvoo nnml-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") (defvoo nnml-inhibit-expiry nil "If non-nil, inhibit expiry.") +(defvoo nnml-use-compressed-files nil + "If non-nil, allow using compressed message files.") @@ -308,7 +305,8 @@ variable should be set if any of the files are compressed.") (setq articles (gnus-sorted-intersection articles active-articles)) (while (and articles is-old) - (if (and (setq article (nnml-article-to-file (setq number (pop articles)))) + (if (and (setq article (nnml-article-to-file + (setq number (pop articles)))) (setq mod-time (nth 5 (file-attributes article))) (nnml-deletable-article-p group number) (setq is-old (nnmail-expired-article-p group mod-time force @@ -523,16 +521,19 @@ variable should be set if any of the files are compressed.") (defun nnml-article-to-file (article) (nnml-update-file-alist) (let (file) - (if (setq file (cdr (assq article nnml-article-file-alist))) + (if (setq file + (if nnml-use-compressed-files + (cdr (assq article nnml-article-file-alist)) + (number-to-string article))) (expand-file-name file nnml-current-directory) - (if (not nnheader-directory-files-is-safe) - ;; Just to make sure nothing went wrong when reading over NFS -- - ;; check once more. - (when (file-exists-p - (setq file (expand-file-name (number-to-string article) - nnml-current-directory))) - (nnml-update-file-alist t) - file))))) + (when (not nnheader-directory-files-is-safe) + ;; Just to make sure nothing went wrong when reading over NFS -- + ;; check once more. + (when (file-exists-p + (setq file (expand-file-name (number-to-string article) + nnml-current-directory))) + (nnml-update-file-alist t) + file))))) (defun nnml-deletable-article-p (group article) "Say whether ARTICLE in GROUP can be deleted." @@ -868,10 +869,11 @@ variable should be set if any of the files are compressed.") t)) (defun nnml-update-file-alist (&optional force) - (when (or (not nnml-article-file-alist) - force) - (setq nnml-article-file-alist - (nnml-current-group-article-to-file-alist)))) + (when nnml-use-compressed-files + (when (or (not nnml-article-file-alist) + force) + (setq nnml-article-file-alist + (nnml-current-group-article-to-file-alist))))) (defun nnml-directory-articles (dir) "Return a list of all article files in a directory. @@ -900,7 +902,6 @@ Use the nov database for that directory if available." Use the nov database for the current group if available." (if (or gnus-nov-is-evil nnml-nov-is-evil - nnml-filenames-are-evil (not (file-exists-p (expand-file-name nnml-nov-file-name nnml-current-directory)))) @@ -908,8 +909,8 @@ Use the nov database for the current group if available." ;; build list from .overview if available (save-excursion (let ((alist nil) - art - (buffer (nnml-get-nov-buffer nnml-current-group))) + (buffer (nnml-get-nov-buffer nnml-current-group)) + art) (set-buffer buffer) (goto-char (point-min)) (while (not (eobp)) diff --git a/lisp/pop3.el b/lisp/pop3.el index 2c2136b..826e6ed 100644 --- a/lisp/pop3.el +++ b/lisp/pop3.el @@ -1,6 +1,6 @@ ;;; pop3.el --- Post Office Protocol (RFC 1460) interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 ;; Free Software Foundation, Inc. ;; Author: Richard L. Pieri @@ -373,7 +373,9 @@ If NOW, use that time instead." ;; should be ;; Tue Jul 9 09:04:21 1996 (setq date - (cond ((string-match "[A-Z]" (nth 0 date)) + (cond ((not date) + "Tue Jan 1 00:00:0 1900") + ((string-match "[A-Z]" (nth 0 date)) (format "%s %s %s %s %s" (nth 0 date) (nth 2 date) (nth 1 date) (nth 4 date) (nth 3 date))) diff --git a/lisp/smiley-ems.el b/lisp/smiley-ems.el deleted file mode 100644 index a81ba7b..0000000 --- a/lisp/smiley-ems.el +++ /dev/null @@ -1,159 +0,0 @@ -;;; smiley-ems.el --- displaying smiley faces - -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. - -;; Author: Dave Love -;; Keywords: news mail multimedia - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; A re-written, simplified version of Wes Hardaker's XEmacs smiley.el -;; which might be merged back to smiley.el if we get an assignment for -;; that. We don't have assignments for the images smiley.el uses, but -;; I'm not sure we need that degree of rococoness and defaults like a -;; yellow background. Also, using PBM means we can display the images -;; more generally. -- fx - -;;; Test smileys: :-) :-\ :-( :-/ - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'nnheader) -(require 'gnus-art) - -(defgroup smiley nil - "Turn :-)'s into real images." - :group 'gnus-visual) - -;; Maybe this should go. -(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies") - "*Location of the smiley faces files." - :type 'directory - :group 'smiley) - -;; The XEmacs version has a baroque, if not rococo, set of these. -(defcustom smiley-regexp-alist - '(("\\(:-?)\\)\\W" 1 "smile") - ("\\(;-?)\\)\\W" 1 "blink") - ("\\(:-]\\)\\W" 1 "forced") - ("\\(8-)\\)\\W" 1 "braindamaged") - ("\\(:-|\\)\\W" 1 "indifferent") - ("\\(:-[/\\]\\)\\W" 1 "wry") - ("\\(:-(\\)\\W" 1 "sad") - ("\\(:-{\\)\\W" 1 "frown")) - "*A list of regexps to map smilies to images. -The elements are (REGEXP MATCH FILE), where MATCH is the submatch in -regexp to replace with IMAGE. IMAGE is the name of a PBM file in -`smiley-data-directory'." - :type '(repeat (list regexp - (integer :tag "Regexp match number") - (string :tag "Image name"))) - :set (lambda (symbol value) - (set-default symbol value) - (smiley-update-cache)) - :initialize 'custom-initialize-default - :group 'smiley) - -(defcustom gnus-smiley-file-types - (let ((types (list "pbm"))) - (when (gnus-image-type-available-p 'xpm) - (push "xpm" types)) - types) - "*List of suffixes on picon file names to try." - :type '(repeat string) - :group 'smiley) - -(defvar smiley-cached-regexp-alist nil) - -(defun smiley-update-cache () - (dolist (elt (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - (let ((types gnus-smiley-file-types) - file type) - (while (and (not file) - (setq type (pop types))) - (unless (file-exists-p - (setq file (expand-file-name (concat (nth 2 elt) "." type) - smiley-data-directory))) - (setq file nil))) - (when type - (let ((image (gnus-create-image file (intern type) nil - :ascent 'center))) - (when image - (push (list (car elt) (cadr elt) image) - smiley-cached-regexp-alist))))))) - -(defvar smiley-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [down-mouse-2] 'ignore) ; override widget - (define-key map [mouse-2] - 'smiley-mouse-toggle-buffer) - map)) - -(defun smiley-region (start end) - "Replace in the region `smiley-regexp-alist' matches with corresponding images. -A list of images is returned." - (interactive "r") - (when (gnus-graphic-display-p) - (unless smiley-cached-regexp-alist - (smiley-update-cache)) - (save-excursion - (let ((beg (or start (point-min))) - group image images string) - (dolist (entry smiley-cached-regexp-alist) - (setq group (nth 1 entry) - image (nth 2 entry)) - (goto-char beg) - (while (re-search-forward (car entry) end t) - (setq string (match-string group)) - (goto-char (match-end group)) - (delete-region (match-beginning group) (match-end group)) - (when image - (push image images) - (gnus-add-wash-type 'smiley) - (gnus-add-image 'smiley image) - (gnus-put-image image string)))) - images)))) - -(defun smiley-toggle-buffer (&optional arg) - "Toggle displaying smiley faces in article buffer. -With arg, turn displaying on if and only if arg is positive." - (interactive "P") - (gnus-with-article-buffer - (if (if (numberp arg) - (> arg 0) - (not (memq 'smiley gnus-article-wash-types))) - (smiley-region (point-min) (point-max)) - (gnus-delete-images 'smiley)))) - -(defun smiley-mouse-toggle-buffer (event) - "Toggle displaying smiley faces. -With arg, turn displaying on if and only if arg is positive." - (interactive "e") - (save-excursion - (save-window-excursion - (mouse-set-point event) - (smiley-toggle-buffer)))) - -(provide 'smiley) - -;;; smiley-ems.el ends here diff --git a/lisp/smiley.el b/lisp/smiley.el index 737f7f0..ffc3bdf 100644 --- a/lisp/smiley.el +++ b/lisp/smiley.el @@ -1,10 +1,9 @@ ;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 -;; Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. -;; Author: Wes Hardaker -;; Keywords: fun +;; Author: Dave Love +;; Keywords: news mail multimedia ;; This file is part of GNU Emacs. @@ -25,418 +24,137 @@ ;;; Commentary: -;; -;; comments go here. -;; +;; A re-written, simplified version of Wes Hardaker's XEmacs smiley.el +;; which might be merged back to smiley.el if we get an assignment for +;; that. We don't have assignments for the images smiley.el uses, but +;; I'm not sure we need that degree of rococoness and defaults like a +;; yellow background. Also, using PBM means we can display the images +;; more generally. -- fx -;;; Test smileys: :-] :-o :-) ;-) :-\ :-| :-d :-P 8-| :-( - -;; To use: -;; (require 'smiley) -;; (setq gnus-treat-display-smileys t) - -;; The smilies were drawn by Joe Reiss . +;;; Test smileys: :-) :-\ :-( :-/ ;;; Code: (eval-when-compile (require 'cl)) -(require 'custom) - -(eval-and-compile - (when (featurep 'xemacs) - (require 'annotations) - (require 'messagexmas))) +(require 'nnheader) +(require 'gnus-art) (defgroup smiley nil "Turn :-)'s into real images." :group 'gnus-visual) -;; FIXME: Where is the directory when using Emacs? -(defcustom smiley-data-directory - (if (featurep 'xemacs) - (message-xmas-find-glyph-directory "smilies") - "/usr/local/lib/xemacs/xemacs-packages/etc/smilies") +;; Maybe this should go. +(defcustom smiley-data-directory (nnheader-find-etc-directory "smilies") "*Location of the smiley faces files." :type 'directory :group 'smiley) -;; Notice the subtle differences in the regular expressions in the -;; two alists below. - -(defcustom smiley-deformed-regexp-alist - '(("\\(\\^_\\^;;;\\)\\W" 1 "WideFaceAse3.xbm") - ("\\(\\^_\\^;;\\)\\W" 1 "WideFaceAse2.xbm") - ("\\(\\^_\\^;\\)\\W" 1 "WideFaceAse1.xbm") - ("\\(\\^_\\^\\)\\W" 1 "WideFaceSmile.xbm") - ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(:-*[<(I+(B]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-*[)>}(I;(B]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(=[)>(I;(B]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") - ("[^.0-9]\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") - ("[^^;_]\\(;-*[>)}(I;(B]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-*[Vv(I5(B]\\)\\W" 1 "FaceWry.xpm") - ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) - "*Normal and deformed faces for smilies." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) - -(defcustom smiley-nosey-regexp-alist - '(("\\(:-+[<(I+(B]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-+[}(I;(B]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") - ("\\(=[)]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm") - ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-+[>)}(I;(B]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-+[Vv(I5(B]\\)\\W" 1 "FaceWry.xpm") - ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") - ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) - "*Smileys with noses. These get less false matches." +;; The XEmacs version has a baroque, if not rococo, set of these. +(defcustom smiley-regexp-alist + '(("\\(:-?)\\)\\W" 1 "smile") + ("\\(;-?)\\)\\W" 1 "blink") + ("\\(:-]\\)\\W" 1 "forced") + ("\\(8-)\\)\\W" 1 "braindamaged") + ("\\(:-|\\)\\W" 1 "indifferent") + ("\\(:-[/\\]\\)\\W" 1 "wry") + ("\\(:-(\\)\\W" 1 "sad") + ("\\(:-{\\)\\W" 1 "frown")) + "*A list of regexps to map smilies to images. +The elements are (REGEXP MATCH FILE), where MATCH is the submatch in +regexp to replace with IMAGE. IMAGE is the name of a PBM file in +`smiley-data-directory'." :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) - -(defcustom smiley-regexp-alist smiley-deformed-regexp-alist - "*A list of regexps to map smilies to real images. -Defaults to the contents of `smiley-deformed-regexp-alist'. -An alternative is `smiley-nosey-regexp-alist' that matches less -aggressively. -If this is a symbol, take its value." - :type '(radio (variable-item smiley-deformed-regexp-alist) - (variable-item smiley-nosey-regexp-alist) - symbol - (repeat (list regexp - (integer :tag "Match") - (string :tag "Image")))) - :group 'smiley) - -(defcustom smiley-flesh-color "yellow" - "*Flesh color." - :type 'string - :group 'smiley) - -(defcustom smiley-features-color "black" - "*Features color." - :type 'string + (integer :tag "Regexp match number") + (string :tag "Image name"))) + :set (lambda (symbol value) + (set-default symbol value) + (smiley-update-cache)) + :initialize 'custom-initialize-default :group 'smiley) -(defcustom smiley-tongue-color "red" - "*Tongue color." - :type 'string +(defcustom gnus-smiley-file-types + (let ((types (list "pbm"))) + (when (gnus-image-type-available-p 'xpm) + (push "xpm" types)) + types) + "*List of suffixes on picon file names to try." + :type '(repeat string) :group 'smiley) -(defcustom smiley-circle-color "black" - "*Circle color." - :type 'string - :group 'smiley) - -(defcustom smiley-mouse-face 'highlight - "*Face used for mouse highlighting in the smiley buffer. - -Smiley buttons will be displayed in this face when the cursor is -above them." - :type 'face - :group 'smiley) - -(defvar smiley-glyph-cache nil) - -(defvar smiley-map (make-sparse-keymap "smiley-keys") - "Keymap to toggle smiley states.") - -(define-key smiley-map [(button2)] 'smiley-toggle-extent) -(define-key smiley-map [(button3)] 'smiley-popup-menu) - -(defun smiley-popup-menu (e) - (interactive "e") - (popup-menu - `("Smilies" - ["Toggle This Smiley" (smiley-toggle-extent ,e) t] - ["Toggle All Smilies" (smiley-toggle-extents ,e) t]))) - -(defun smiley-create-glyph (smiley pixmap) - (or - (cdr-safe (assoc pixmap smiley-glyph-cache)) - (let* ((xpm-color-symbols - (and (featurep 'xpm) - (append `(("flesh" ,smiley-flesh-color) - ("features" ,smiley-features-color) - ("tongue" ,smiley-tongue-color)) - xpm-color-symbols))) - (glyph (make-glyph - (list - (cons (if (featurep 'gtk) 'gtk 'x) - (expand-file-name pixmap smiley-data-directory)) - (cons 'mswindows - (expand-file-name pixmap smiley-data-directory)) - (cons 'tty smiley))))) - (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache)) - (set-glyph-face glyph 'default) - glyph))) - -(defun smiley-create-glyph-ems (smiley pixmap) - (condition-case e - (create-image (expand-file-name pixmap smiley-data-directory)) - (error nil))) - +(defvar smiley-cached-regexp-alist nil) + +(defun smiley-update-cache () + (dolist (elt (if (symbolp smiley-regexp-alist) + (symbol-value smiley-regexp-alist) + smiley-regexp-alist)) + (let ((types gnus-smiley-file-types) + file type) + (while (and (not file) + (setq type (pop types))) + (unless (file-exists-p + (setq file (expand-file-name (concat (nth 2 elt) "." type) + smiley-data-directory))) + (setq file nil))) + (when type + (let ((image (gnus-create-image file (intern type) nil + :ascent 'center))) + (when image + (push (list (car elt) (cadr elt) image) + smiley-cached-regexp-alist))))))) + +(defvar smiley-mouse-map + (let ((map (make-sparse-keymap))) + (define-key map [down-mouse-2] 'ignore) ; override widget + (define-key map [mouse-2] + 'smiley-mouse-toggle-buffer) + map)) ;;;###autoload -(defun smiley-region (beg end) - "Smilify the region between point and mark." +(defun smiley-region (start end) + "Replace in the region `smiley-regexp-alist' matches with corresponding images. +A list of images is returned." (interactive "r") - (smiley-buffer (current-buffer) beg end)) - -(defun smiley-toggle-extent (event) - "Toggle smiley at given point." - (interactive "e") - (let* ((ant (event-glyph-extent event)) - (pt (event-closest-point event)) - ext) - (if (annotationp ant) - (when (extentp (setq ext (extent-property ant 'smiley-extent))) - (set-extent-property ext 'invisible nil) - (hide-annotation ant)) - (when pt - (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) - (when (annotationp (setq ant - (extent-property ext 'smiley-annotation))) - (reveal-annotation ant) - (set-extent-property ext 'invisible t))))))) - -;; FIXME:: -(defun smiley-toggle-extent-ems (event) - "Toggle smiley at given point. -Note -- this function hasn't been implemented yet." - (interactive "e") - (error "This function hasn't been implemented yet")) - -(defun smiley-toggle-extents (e) - (interactive "e") - (map-extents - (lambda (e void) - (let (ant) - (if (annotationp (setq ant (extent-property e 'smiley-annotation))) - (if (eq (extent-property e 'invisible) nil) - (progn - (reveal-annotation ant) - (set-extent-property e 'invisible t) - ) - (hide-annotation ant) - (set-extent-property e 'invisible nil))) - nil)) - (event-buffer e))) - -;; FIXME:: -(defun smiley-toggle-extents-ems (e) - (interactive "e") - (error "This function hasn't been implemented yet")) - -;;;###autoload -(defun smiley-buffer (&optional buffer st nd) - (interactive) - (when (featurep '(or x gtk mswindows)) - (save-excursion - (when buffer - (set-buffer buffer)) - (let ((buffer-read-only nil) - (alist (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - (case-fold-search nil) - entry regexp beg group file) - (map-extents - (lambda (e void) - (when (or (extent-property e 'smiley-extent) - (extent-property e 'smiley-annotation)) - (delete-extent e))) - buffer st nd) - (goto-char (or st (point-min))) - (setq beg (point)) - ;; loop through alist - (while (setq entry (pop alist)) - (setq regexp (car entry) - group (cadr entry) - file (caddr entry)) - (goto-char beg) - (while (re-search-forward regexp nd t) - (let* ((start (match-beginning group)) - (end (match-end group)) - (glyph (smiley-create-glyph (buffer-substring start end) - file))) - (when glyph - (mapcar 'delete-annotation (annotations-at end)) - (let ((ext (make-extent start end)) - (ant (make-annotation glyph end 'text))) - ;; set text extent params - (set-extent-property ext 'end-open t) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'invisible t) - (set-extent-property ext 'keymap smiley-map) - (set-extent-property ext 'mouse-face smiley-mouse-face) - (set-extent-property ext 'intangible t) - ;; set annotation params - (set-extent-property ant 'mouse-face smiley-mouse-face) - (set-extent-property ant 'keymap smiley-map) - ;; remember each other - (set-extent-property ant 'smiley-extent ext) - (set-extent-property ext 'smiley-annotation ant) - ;; Help - (set-extent-property - ext 'help-echo - "button2 toggles smiley, button3 pops up menu") - (set-extent-property - ant 'help-echo - "button2 toggles smiley, button3 pops up menu") - (set-extent-property ext 'balloon-help - "Mouse button2 - toggle smiley -Mouse button3 - menu") - (set-extent-property ant 'balloon-help - "Mouse button2 - toggle smiley -Mouse button3 - menu")) - (when (smiley-end-paren-p start end) - (make-annotation ")" end 'text)) - (goto-char end))))))))) - -;; FIXME: No popup menu, no customized color -(defun smiley-buffer-ems (&optional buffer st nd) - (interactive) - (when window-system + (when (gnus-graphic-display-p) + (unless smiley-cached-regexp-alist + (smiley-update-cache)) (save-excursion - (when buffer - (set-buffer buffer)) - (let ((buffer-read-only nil) - (alist (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - (case-fold-search nil) - entry regexp beg group file) - (dolist (overlay (overlays-in (or st (point-min)) - (or nd (point-max)))) - (when (overlay-get overlay 'smiley) - (remove-text-properties (overlay-start overlay) - (overlay-end overlay) '(display)) - (delete-overlay overlay))) - (goto-char (or st (point-min))) - (setq beg (point)) - ;; loop through alist - (while (setq entry (pop alist)) - (setq regexp (car entry) - group (cadr entry) - file (caddr entry)) + (let ((beg (or start (point-min))) + group image images string) + (dolist (entry smiley-cached-regexp-alist) + (setq group (nth 1 entry) + image (nth 2 entry)) (goto-char beg) - (while (re-search-forward regexp nd t) - (let* ((start (match-beginning group)) - (end (match-end group)) - (glyph (smiley-create-glyph nil file)) - (overlay (make-overlay start end))) - (when glyph - (add-text-properties start end - `(display ,glyph)) - (overlay-put overlay 'smiley glyph) - (goto-char end))))))))) - -(defun smiley-end-paren-p (start end) - "Try to guess whether the current smiley is an end-paren smiley." - (save-excursion - (goto-char start) - (when (and (re-search-backward "[()]" nil t) - (eq (char-after) ?\() - (goto-char end) - (or (not (re-search-forward "[()]" nil t)) - (eq (char-after (1- (point))) ?\())) - t))) - -(defun smiley-toggle-buffer (&optional arg buffer st nd) - "Toggle displaying smiley faces. + (while (re-search-forward (car entry) end t) + (setq string (match-string group)) + (goto-char (match-end group)) + (delete-region (match-beginning group) (match-end group)) + (when image + (push image images) + (gnus-add-wash-type 'smiley) + (gnus-add-image 'smiley image) + (gnus-put-image image string)))) + images)))) + +(defun smiley-toggle-buffer (&optional arg) + "Toggle displaying smiley faces in article buffer. With arg, turn displaying on if and only if arg is positive." (interactive "P") - (let (on off) - (map-extents - (lambda (e void) - (let (ant) - (if (annotationp (setq ant (extent-property e 'smiley-annotation))) - (if (eq (extent-property e 'invisible) nil) - (setq off (cons (cons ant e) off)) - (setq on (cons (cons ant e) on))))) - nil) - buffer st nd) - (if (and (not (and (numberp arg) (< arg 0))) - (or (and (numberp arg) (> arg 0)) - (null on))) - (if off - (while off - (reveal-annotation (caar off)) - (set-extent-property (cdar off) 'invisible t) - (setq off (cdr off))) - (smiley-buffer)) - (while on - (hide-annotation (caar on)) - (set-extent-property (cdar on) 'invisible nil) - (setq on (cdr on)))))) - -;; Simply removing all smiley if existing. -;; FIXME: make it work as the one in XEmacs. -(defun smiley-toggle-buffer-ems (&optional arg buffer st nd) + (gnus-with-article-buffer + (if (if (numberp arg) + (> arg 0) + (not (memq 'smiley gnus-article-wash-types))) + (smiley-region (point-min) (point-max)) + (gnus-delete-images 'smiley)))) + +(defun smiley-mouse-toggle-buffer (event) "Toggle displaying smiley faces. With arg, turn displaying on if and only if arg is positive." - (interactive "P") - (save-excursion - (when buffer - (set-buffer buffer)) - (let (found) - (dolist (overlay (overlays-in (or st (point-min)) - (or nd (point-max)))) - (when (overlay-get overlay 'smiley) - (remove-text-properties (overlay-start overlay) - (overlay-end overlay) '(display)) - (setq found t))) - (unless found - (smiley-buffer buffer st nd))))) - -(unless (featurep 'xemacs) - (defalias 'smiley-create-glyph 'smiley-create-glyph-ems) - (defalias 'smiley-toggle-extent 'smiley-toggle-extent-ems) - (defalias 'smiley-toggle-extents 'smiley-toggle-extents-ems) - (defalias 'smiley-buffer 'smiley-buffer-ems) - (defalias 'smiley-toggle-buffer 'smiley-toggle-buffer-ems)) - -(defvar gnus-article-buffer) -;;;###autoload -(defun gnus-smiley-display (&optional arg) - "Display \"smileys\" as small graphical icons. -With arg, turn displaying on if and only if arg is positive." - (interactive "P") + (interactive "e") (save-excursion - (article-goto-body) - (let (buffer-read-only) - (smiley-toggle-buffer arg (current-buffer) (point) (point-max))))) + (save-window-excursion + (mouse-set-point event) + (smiley-toggle-buffer)))) (provide 'smiley) -;; Local Variables: -;; coding: iso-8859-1 -;; End: - ;;; smiley.el ends here diff --git a/texi/ChangeLog b/texi/ChangeLog index b1cd1f8..c6a02ee 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,7 @@ +2002-01-26 Lars Magne Ingebrigtsen + + * gnus.texi (Mail Spool): Addition. + 2002-01-24 Katsumi Yamaoka * emacs-mime.texi (Customization): Added documentation for diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 0f19a97..b6d696a 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -13120,7 +13120,12 @@ rmail box $B$N$?$a$N%"%/%F%#%V%U%!%$%k$NL>A0!#4{DjCM(B @item nnml-marks-file-name @vindex nnml-marks-file-name -@sc{$B0u(B} $B%U%!%$%k$NL>A0$G$9!#%G%#%U%)%k%H$O(B @file{.marks} $B$G$9!#(B +@dfn{$B0u(B} $B%U%!%$%k$NL>A0$G$9!#%G%#%U%)%k%H$O(B @file{.marks} $B$G$9!#(B + +@item nnml-use-compressed-files +@vindex nnml-use-compressed-files +$BHs(B-@code{nil} $B$@$C$?$i(B @code{nnml} $B$O05=L$5$l$?%a%C%;!<%8%U%!%$%k$r;H$&(B +$B$3$H$r9MN8$KF~$l$^$9!#(B @end table @findex nnml-generate-nov-databases diff --git a/texi/gnus.texi b/texi/gnus.texi index 0c7a49a..5bd1018 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -13730,7 +13730,12 @@ default is @code{nil}. @item nnml-marks-file-name @vindex nnml-marks-file-name -The name of the @sc{marks} files. The default is @file{.marks}. +The name of the @dfn{marks} files. The default is @file{.marks}. + +@item nnml-use-compressed-files +@vindex nnml-use-compressed-files +If non-@code{nil}, @code{nnml} will allow using compressed message +files. @end table -- 1.7.10.4