+2000-10-03 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/gnus-group.el (gnus-group-get-new-news): Update modeline
+ using `gnus-agent-toggle-plugged' if agent is activated.
+ * lisp/gnus-agent.el (gnus-group-get-new-news): Don't advise it,
+ merge it into gnus-group.el instead.
+
+ * lisp/gnus-offline.el (gnus-offline-after-jobs-done): Use `ding'
+ with `play-sound-file' for XEmacs statically.
+
+ * lisp/gnus-art.el (gnus-article-add-button): Quote
+ `:button-keymap' for Mule 2.3 but it won't work.
+
2000-09-29 Katsumi Yamaoka <yamaoka@jpl.org>
* lisp/message.el (message-ignored-supersedes-headers): Synch with
+2000-10-02 20:14:27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * dgnushack.el (dgnushack-compile): Don't compile dgnushack.el,
+ lpath.el. Don't compile base64.el if there is builtin base64.
+
+2000-10-02 Bj\e,Av\e(Brn Torkelsson <torkel@hpc2n.umu.se>
+
+ * base64.el (Repository): Use featurep for XEmacs test.
+
+2000-10-02 17:38:12 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * nntp.el (nntp-retrieve-data): Don't ignore quit.
+
+2000-10-02 14:43:13 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-article-banner-alist): New variable.
+ (article-strip-banner): Use it.
+ * gnus-cus.el (gnus-group-parameters): Allow symbol.
+
+2000-10-02 Dave Love <fx@gnu.org>
+
+ * smiley-ems.el: New file.
+
+ * gnus-ems.el (gnus-smiley-display): Autoload.
+ (mouse-set-point, set-face-foreground, set-face-background)
+ (x-popup-menu): Don't clobber these.
+ (gnus-article-compface-xbm): New variable.
+ (gnus-article-display-xface): Move graphic test. Use unibyte.
+ Obey gnus-article-compface-xbm. Use pbm, not xbm.
+
+ * mml.el (require): Fix typo.
+ (mml-parse-1): Modify unknown encoding prompt.
+
+ * mail-source.el (mail-sources): Revert to nil.
+
+ * nnmail.el (nnmail-spool-file): Revert previous change.
+
+ * gnus.el: Don't require custom, message.
+ (gnus-message-archive-method): Wrap initializer in progn and
+ require message here.
+
+2000-10-02 Gerd Moellmann <gerd@gnu.org>
+
+ * gnus.el (gnus-mode-line-buffer-identification) [Emacs]: Change
+ image's :ascent to 80. That gives a mode-line which is approx.
+ as tall as the normal one.
+
2000-10-02 08:04:48 ShengHuo ZHU <zsh@cs.rochester.edu>
* webmail.el (webmail-hotmail-list): Fix.
2000-09-28 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- * gnus-art.el (article-strip-banner): elkin@tverd.astro.spbu.ru:
- use gnus-group-find-parameter rather than
- gnus-group-get-parameter, to allow inheritance on the banner.
+ * gnus-art.el (article-strip-banner): Use
+ gnus-group-find-parameter rather than gnus-group-get-parameter, to
+ allow inheritance on the banner.
+ From elkin@tverd.astro.spbu.ru.
2000-09-26 Richard M. Alderson III <alderson@netcom2.netcom.com>
(ignore-errors
(delete-file tempfile)))))
-(if (string-match "XEmacs" emacs-version)
+(if (featurep 'xemacs)
(defalias 'base64-insert-char 'insert-char)
(defun base64-insert-char (char &optional count ignored buffer)
(if (or (null buffer) (eq buffer (current-buffer)))
(defalias 'define-mail-user-agent 'ignore)
(defconst dgnushack-tool-files
- '("dgnushack.el" "dgnuspath.el" "ptexinfmt.el"))
+ '("dgnushack.el" "dgnuspath.el" "lpath.el" "ptexinfmt.el"))
(defconst dgnushack-unexported-files
'("dgnuspath.el" "ptexinfmt.el"))
(condition-case nil
(progn (require 'bbdb) nil)
(error '("gnus-bbdb.el")))
- (if (featurep 'xemacs)
- '("smiley-ems.el")
+ (unless (featurep 'xemacs)
'("gnus-xmas.el" "gnus-picon.el" "messagexmas.el"
"nnheaderxm.el" "smiley.el"))
+ (when (or (featurep 'xemacs) (<= emacs-major-version 20))
+ '("smiley-ems.el"))
(when (and (fboundp 'md5) (subrp (symbol-function 'md5)))
'("md5.el"))))
(while (setq file (pop files))
(gnus-group-send-drafts)
(gnus-agent-fetch-session))
-;;;
-;;; Advice
-;;;
-
-(defadvice gnus-group-get-new-news (after gnus-agent-advice
- activate preactivate)
- "Update modeline."
- (unless (interactive-p)
- (gnus-agent-toggle-plugged gnus-plugged)))
-
(provide 'gnus-agent)
;;; gnus-agent.el ends here
:type '(choice regexp (const nil))
:group 'gnus-article-washing)
+(defcustom gnus-article-banner-alist nil
+ "Banner alist for stripping.
+For example,
+ ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
+ :type '(repeat (cons symbol regexp))
+ :group 'gnus-article-washing)
+
(defcustom gnus-emphasis-alist
(let ((format
"\\(\\s-\\|^\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-,;:\"]\\s-\\|[?!.]+\\s-\\|\\s)\\)")
(widen)
(forward-line -1)
(delete-region (point) (point-max))))
+ ((symbolp banner)
+ (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
+ (while (re-search-forward banner nil t)
+ (delete-region (match-beginning 0) (match-end 0)))))
((stringp banner)
(while (re-search-forward banner nil t)
(delete-region (match-beginning 0) (match-end 0))))))))))
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
(widget-convert-button 'link from to :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap))
+ ;; Quote `:button-keymap' for Mule 2.3
+ ;; but it won't work.
+ ':button-keymap gnus-widget-button-keymap))
;;; Internal functions:
(banner (choice :tag "Banner"
(const signature)
+ symbol
regexp
(const :tag "None" nil)) "\
Regular expression matching banners to be removed from articles.")
(or (fboundp 'mail-file-babyl-p)
(fset 'mail-file-babyl-p 'rmail-file-p))
+(when (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
+ (autoload 'gnus-smiley-display "smiley-ems")) ; override XEmacs version
+
;;; Mule functions.
(eval-and-compile
"Property used for highlighting mouse regions.")))
(eval-and-compile
- (cond
- ((not window-system)
- (let ((funcs '(mouse-set-point set-face-foreground
- set-face-background x-popup-menu)))
- (while funcs
- (unless (fboundp (car funcs))
- (defalias (car funcs) 'ignore))
- (setq funcs (cdr funcs)))))))
-
-(eval-and-compile
(let ((case-fold-search t))
(cond
((string-match "windows-nt\\|os/2\\|emx\\|cygwin32"
(defvar gnus-article-xface-ring-size 6
"Length of the ring used for `gnus-article-xface-ring-internal'.")
+(defvar gnus-article-compface-xbm
+ (when (and (not (featurep 'xemacs)) (>= emacs-major-version 21))
+ (eq 0 (string-match "#define" (shell-command-to-string "uncompface -X"))))
+ "Non-nil means the compface program supports the -X option.
+That produces XBM output.")
+
(defun gnus-article-display-xface (beg end)
"Display an XFace header from between BEG and END in the current article.
Requires support for images in your Emacs and the external programs
-`uncompface', `icontopbm' and `ppmtoxbm'. On a GNU/Linux system these
+`uncompface', and `icontopbm'. On a GNU/Linux system these
might be in packages with names like `compface' or `faces-xface' and
-`netpbm' or `libgr-progs', for instance.
+`netpbm' or `libgr-progs', for instance. See also
+`gnus-article-compface-xbm'.
This function is for Emacs 21+. See `gnus-xmas-article-display-xface'
for XEmacs."
;; It might be worth converting uncompface's output in Lisp.
- (unless gnus-article-xface-ring-internal ; Only load ring when needed.
- (setq gnus-article-xface-ring-internal
- (make-ring gnus-article-xface-ring-size)))
- (save-excursion
- (let* ((cur (current-buffer))
- (data (buffer-substring beg end))
- (image (cdr-safe (assoc data (ring-elements
- gnus-article-xface-ring-internal)))))
- (when (if (fboundp 'display-graphic-p)
- (display-graphic-p))
+ (when (if (fboundp 'display-graphic-p)
+ (display-graphic-p))
+ (unless gnus-article-xface-ring-internal ; Only load ring when needed.
+ (setq gnus-article-xface-ring-internal
+ (make-ring gnus-article-xface-ring-size)))
+ (save-excursion
+ (let* ((cur (current-buffer))
+ (data (buffer-substring beg end))
+ (image (cdr-safe (assoc data (ring-elements
+ gnus-article-xface-ring-internal))))
+ default-enable-multibyte-characters)
(unless image
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (with-temp-buffer
- (insert data)
- (and (eq 0 (call-process-region (point-min) (point-max)
- "uncompface"
- 'delete '(t nil)))
+ (with-temp-buffer
+ (insert data)
+ (and (eq 0 (apply #'call-process-region (point-min) (point-max)
+ "uncompface"
+ 'delete '(t nil) nil
+ (if gnus-article-compface-xbm
+ '("-X"))))
+ (unless gnus-article-compface-xbm
(goto-char (point-min))
(progn (insert "/* Width=48, Height=48 */\n") t)
(eq 0 (call-process-region (point-min) (point-max)
"icontopbm"
- 'delete '(t nil)))
- (eq 0 (call-process-region (point-min) (point-max)
- "pbmtoxbm"
- 'delete '(t nil)))
- ;; Miles Bader says that faces don't look right as
- ;; light on dark.
- (if (eq 'dark (cdr-safe (assq 'background-mode
- (frame-parameters))))
- (setq image (create-image (buffer-string) 'xbm t
- :ascent 'center
- :foreground "black"
- :background "white"))
- (setq image (create-image (buffer-string) 'xbm t
- :ascent 'center))))))
- (ring-insert gnus-article-xface-ring-internal (cons data image))))
- (when image
- (goto-char (point-min))
- (re-search-forward "^From:" nil 'move)
- (insert-image image)))))
+ 'delete '(t nil))))
+ ;; Miles Bader says that faces don't look right as
+ ;; light on dark.
+ (if (eq 'dark (cdr-safe (assq 'background-mode
+ (frame-parameters))))
+ (setq image (create-image (buffer-string) 'pbm t
+ :ascent 'center
+ :foreground "black"
+ :background "white"))
+ (setq image (create-image (buffer-string) 'pbm t
+ :ascent 'center)))))
+ (ring-insert gnus-article-xface-ring-internal (cons data image)))
+ (when image
+ (goto-char (point-min))
+ (re-search-forward "^From:" nil 'move)
+ (insert-image image))))))
(defun-maybe assoc-ignore-case (key alist)
"Like `assoc', but assumes KEY is a string and ignores case when comparing."
(gnus-get-unread-articles arg)))
(gnus-run-hooks 'gnus-after-getting-new-news-hook)
(gnus-group-list-groups (and (numberp arg)
- (max (car gnus-group-list-mode) arg)))))
+ (max (car gnus-group-list-mode) arg))))
+ ;; Update modeline.
+ (when (and gnus-agent (not (interactive-p)))
+ (gnus-agent-toggle-plugged gnus-plugged)))
(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
"Check for newly arrived news in the current group (and the N-1 next groups).
(if (and (eq gnus-offline-news-fetch-method 'nnagent)
gnus-offline-auto-expire)
(gnus-agent-expire))
- (if (and (featurep 'xemacs)
- (fboundp 'play-sound-file))
- (ding nil 'drum)
+ (static-if (featurep 'xemacs)
+ (if (fboundp 'play-sound-file)
+ (ding nil 'drum)
+ (ding))
(ding))
(gnus-group-save-newsrc)
(message "%s" (gnus-offline-gettext 'after-jobs-done-1)))
(eval-when-compile (require 'static))
(require 'gnus-vers)
-(require 'message)
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
(setq gnus-mode-line-image-cache
(find-image
'((:type xpm :file "gnus-pointer.xpm"
- :ascent 100)
+ :ascent 80)
(:type xbm :file "gnus-pointer.xbm"
- :ascent 100))))
+ :ascent 80))))
gnus-mode-line-image-cache)
'help-echo "This is Gnus")
str)
;;; Do the rest.
-(require 'custom)
(require 'gnus-util)
(require 'nnheader)
:type 'gnus-select-method)
(defcustom gnus-message-archive-method
- `(nnfolder
- "archive"
- (nnfolder-directory ,(nnheader-concat message-directory "archive"))
- (nnfolder-active-file
- ,(nnheader-concat message-directory "archive/active"))
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
+ (progn
+ ;; Don't require it at top level to avoid circularity.
+ (require 'message)
+ `(nnfolder
+ "archive"
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t)))
"*Method used for archiving messages you've sent.
This should be a mail method.
"The mail-fetching library."
:group 'gnus)
-(defcustom mail-sources '((file))
+(defcustom mail-sources nil
"*Where the mail backends will look for incoming mail.
This variable is a list of mail source specifiers.
See Info node `(gnus)Mail Source Specifiers'."
(require 'mm-bodies)
(require 'mm-encode)
(require 'mm-decode)
-(eval-when-compile 'cl)
+(eval-when-compile (require 'cl))
(eval-and-compile
(autoload 'message-make-message-id "message")
(when (and (not raw) (memq nil charsets))
(if (or (memq 'unknown-encoding mml-confirmation-set)
(y-or-n-p
- "Warning: You message contains characters with unknown encoding. Really send?"))
+ "Message contains characters with unknown encoding. Really send?"))
(if (setq use-ascii
(or (memq 'use-ascii mml-confirmation-set)
(y-or-n-p "Use ASCII as charset?")))
:group 'nnmail
:type 'boolean)
-(defcustom nnmail-spool-file nil
+(defcustom nnmail-spool-file '((file))
"*Where the mail backends will look for incoming mail.
This variable is a list of mail source specifiers.
This variable is obsolete; `mail-sources' should be used instead."
(t t)))
(error
(nnheader-report 'nntp "Couldn't open connection to %s: %s"
- address err))
- (quit nil)))))
+ address err))))))
(defsubst nntp-send-command (wait-for &rest strings)
"Send STRINGS to server and wait until WAIT-FOR returns."
--- /dev/null
+;;; smiley-ems.el --- displaying smiley faces
+
+;; Copyright (C) 2000 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:
+
+(require 'nnheader)
+
+(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
+ ;; Perhaps :-) should be distinct -- it does appear in the Jargon File.
+ '(("\\([:;]-?)\\)\\W" 1 "smile.pbm")
+ ("\\(:-[/\\]\\)\\W" 1 "wry.pbm")
+ ("\\(:-[({]\\)\\W" 1 "frown.pbm"))
+ "*A list of regexps to map smilies to images.
+The elements are (REGEXP MATCH FILE), where MATCH is the submatch in
+rgexp 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)
+
+(defvar smiley-cached-regexp-alist nil)
+
+(defun smiley-update-cache ()
+ (dolist (elt smiley-regexp-alist)
+ (let* ((data-directory smiley-data-directory)
+ (image (find-image (list (list :type 'pbm
+ :file (nth 2 elt)
+ :ascent 100)))))
+ (if image
+ (push (list (car elt) (cadr elt) image)
+ smiley-cached-regexp-alist)))))
+
+(defvar smiley-active nil
+ "Non-nil means smilies in the buffer will be displayed.")
+(make-variable-buffer-local 'smiley-active)
+
+(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."
+ (interactive "r")
+ (when (and (fboundp 'display-graphic-p)
+ (display-graphic-p))
+ (mapc (lambda (o)
+ (if (eq 'smiley (overlay-get o 'smiley))
+ (delete-overlay o)))
+ (overlays-in start end))
+ (unless smiley-cached-regexp-alist
+ (smiley-update-cache))
+ (save-excursion
+ (let ((beg (or start (point-min)))
+ group overlay image)
+ (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)
+ (when image
+ (setq overlay (make-overlay (match-beginning group)
+ (match-end group)))
+ (overlay-put overlay
+ 'display `(when smiley-active ,@image))
+ (overlay-put overlay 'mouse-face 'highlight)
+ (overlay-put overlay 'smiley t)
+ (overlay-put overlay
+ 'help-echo "mouse-2: toggle smilies in buffer")
+ (overlay-put overlay 'keymap smiley-mouse-map))))))
+ (setq smiley-active t)))
+
+(defun smiley-toggle-buffer (&optional arg)
+ "Toggle displaying smiley faces.
+With arg, turn displaying on if and only if arg is positive."
+ (interactive "P")
+ (if (numberp arg)
+ (setq smiley-active (> arg 0))
+ (setq smiley-active (not smiley-active))))
+
+(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))))
+
+(eval-when-compile (defvar gnus-article-buffer))
+
+(defun gnus-smiley-display (&optional arg)
+ "Display textual emoticaons (\"smilies\") as small graphical icons.
+With arg, turn displaying on if and only if arg is positive."
+ (interactive "P")
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (widen)
+ (article-goto-body)
+ (smiley-region (point-min) (point-max))
+ (if (and (numberp arg) (<= arg 0))
+ (smiley-toggle-buffer arg)))))
+
+(provide 'smiley)
+
+;;; smiley-ems.el ends here
projects / elisp / gnus.git- / commitdiff