+2002-01-25 Josh Huber <huber@alum.wpi.edu>
+
+ * 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 <larsi@gnus.org>
* gnus-mdrtn.el (gnus-moderation-cancel-article): Insert an extra
: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
+2002-01-27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-agent.el (gnus-agent-fetch-articles): Don't save empty articles.
+
+2002-01-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-util.el (gnus-cache-file-contents): Don't use equalp.
+
+2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * mm-url.el (mm-url-predefined-programs): Add w3m.
+ (mm-url-program): Ditto.
+
+2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <zsh@cs.rochester.edu>
+
+ * 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 <larsi@gnus.org>
+
+ * 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 <larsi@gnus.org>
+
+ * nnagent.el (nnagent-retrieve-headers): Use new macro.
+
+ * gnus-util.el (gnus-parse-without-error): New macro.
+
+2002-01-25 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * 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 <jas@extundo.com>
+
+ * pop3.el (pop3-munge-message-separator): Work if no date. From
+ Marius Vollmer <mvo@zagadka.ping.de>.
+
+2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * 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 <huber@alum.wpi.edu>
+
+ * 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 <larsi@gnus.org>
+
+ * gnus-agent.el (gnus-agent-save-alist): Optimized.
+
2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
* dgnushack.el: Commented out the experimental code.
2002-01-24 ShengHuo ZHU <zsh@cs.rochester.edu>
* 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.
(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"))
(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)
(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)))))
(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))
(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
(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)
: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))
(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))
(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."
(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 ()
(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))
(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)
(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
(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
;; 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
;; 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 ()
(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
;;; 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 <zsh@cs.rochester.edu>
(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"))
(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)))))
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"
(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))
: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*"
(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)
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.")
\f
(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
(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."
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.
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))))
;; 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))
;;; 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 <ratinox@peorth.gweep.net>
;; 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)))
+++ /dev/null
-;;; smiley-ems.el --- displaying smiley faces
-
-;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
-
-;; Author: Dave Love <fx@gnu.org>
-;; 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
;;; 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 <hardaker@ece.ucdavis.edu>
-;; Keywords: fun
+;; Author: Dave Love <fx@gnu.org>
+;; Keywords: news mail multimedia
;; This file is part of GNU Emacs.
;;; 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 <jreiss@vt.edu>.
+;;; 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")
- ("\\(:-*[<\e(I+\e(B]+\\)\\W" 1 "FaceAngry.xpm")
- ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
- ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-*[)>}\e(I;\e(B]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(=[)>\e(I;\e(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")
- ("[^^;_]\\(;-*[>)}\e(I;\e(B]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-*[Vv\e(I5\e(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
- '(("\\(:-+[<\e(I+\e(B]+\\)\\W" 1 "FaceAngry.xpm")
- ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
- ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-+[}\e(I;\e(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")
- ("\\(;-+[>)}\e(I;\e(B]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-+[Vv\e(I5\e(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
+2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus.texi (Mail Spool): Addition.
+
2002-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
* emacs-mime.texi (Customization): Added documentation for
@item nnml-marks-file-name
@vindex nnml-marks-file-name
-@sc{\e$B0u\e(B} \e$B%U%!%$%k$NL>A0$G$9!#%G%#%U%)%k%H$O\e(B @file{.marks} \e$B$G$9!#\e(B
+@dfn{\e$B0u\e(B} \e$B%U%!%$%k$NL>A0$G$9!#%G%#%U%)%k%H$O\e(B @file{.marks} \e$B$G$9!#\e(B
+
+@item nnml-use-compressed-files
+@vindex nnml-use-compressed-files
+\e$BHs\e(B-@code{nil} \e$B$@$C$?$i\e(B @code{nnml} \e$B$O05=L$5$l$?%a%C%;!<%8%U%!%$%k$r;H$&\e(B
+\e$B$3$H$r9MN8$KF~$l$^$9!#\e(B
@end table
@findex nnml-generate-nov-databases
@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
projects / elisp / gnus.git- / commitdiff