* rfc2047.el (rfc2047-fold-region): Don't use the same break twice.
1999-12-14 04:14:44 Katsumi Yamaoka <yamaoka@jpl.org>
* dgnushack.el (last, mapcon, member-if, union): New compiler
macros for emulating cl functions.
1999-12-21 Jan Vroonhof <vroonhof@math.ethz.ch>
* message.el (message-shorten-references): Only cater to broken
INN for news. This caters for broken smtpd.
2000-04-21 18:20:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
* mailcap.el (mailcap-mime-info): Use the first match; not the
last.
* gnus-agent.el (gnus-category-kill): Save the category list.
+1999-12-13 Per Abrahamsen <abraham@dina.kvl.dk>
+
+ * rfc2047.el (rfc2047-fold-region): Don't use the same break twice.
+
+1999-12-14 04:14:44 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * dgnushack.el (last, mapcon, member-if, union): New compiler
+ macros for emulating cl functions.
+
+1999-12-21 Jan Vroonhof <vroonhof@math.ethz.ch>
+
+ * message.el (message-shorten-references): Only cater to broken
+ INN for news. This caters for broken smtpd.
+
+2000-04-21 18:20:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * mailcap.el (mailcap-mime-info): Use the first match; not the
+ last.
+
+ * gnus-agent.el (gnus-category-kill): Save the category list.
+
+2000-04-21 16:41:50 Chris Brierley <brierley@pobox.com>
+
+ * gnus-sum.el (gnus-summary-move-article): Do something or other.
+
+2000-04-21 16:07:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-add-icon): Fixed indentation.
+
+2000-04-21 16:07:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-group.el (gnus-group-add-icon): Fixed indentation.
+
2000-04-21 10:43:16 Shenghuo ZHU <zsh@cs.rochester.edu>
* gnus-group.el (gnus-group-prepare-flat-predicate): New function.
* base64.el: Require cl when compiling.
+2000-01-05 BrYan P. Johnson <beej@mindspring.net>
+
+ * gnus-group.el (gnus-group-line-format-alist): Added %E for
+ eyecandy.
+ (gnus-group-insert-group-line): Now groks %E and inserts icon in
+ group line using gnus-group-add-icon.
+ (gnus-group-icons): Added customize group.
+ (gnus-group-icon-list): Added variable.
+ (gnus-group-glyph-directory): Added variable.
+ (gnus-group-icon-cache): Added variable.
+ (gnus-group-running-xemacs): Added variable.
+ (gnus-group-add-icon): Added function. Add an icon to the current
+ line according to gnus-group-icon-list.
+ (gnus-group-icon-create-glyph): Added function.
+
2000-01-05 17:31:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-sum.el (gnus-summary-select-article): Return whether we
(require 'cl)
+(unless (featurep 'xemacs)
+ (define-compiler-macro last (&whole form x &optional n)
+ (if (and (fboundp 'last)
+ (subrp (symbol-function 'last)))
+ form
+ (if n
+ `(let* ((x ,x)
+ (n ,n)
+ (m 0)
+ (p x))
+ (while (consp p)
+ (incf m)
+ (pop p))
+ (if (<= n 0)
+ p
+ (if (< n m)
+ (nthcdr (- m n) x)
+ x)))
+ `(let ((x ,x))
+ (while (consp (cdr x))
+ (pop x))
+ x))))
+
+ (define-compiler-macro mapcon (&whole form fn seq &rest rest)
+ (if (and (fboundp 'mapcon)
+ (subrp (symbol-function 'mapcon)))
+ form
+ (if rest
+ `(let (res
+ (args (list ,seq ,@rest))
+ p)
+ (while (not (memq nil args))
+ (push (apply ,fn args) res)
+ (setq p args)
+ (while p
+ (setcar p (cdr (pop p)))
+ ))
+ (apply (function nconc) (nreverse res)))
+ `(let (res
+ (arg ,seq))
+ (while arg
+ (push (funcall ,fn arg) res)
+ (setq arg (cdr arg)))
+ (apply (function nconc) (nreverse res))))))
+
+ (define-compiler-macro member-if (&whole form pred list)
+ (if (and (fboundp 'member-if)
+ (subrp (symbol-function 'member-if)))
+ form
+ `(let ((fn ,pred)
+ (seq ,list))
+ (while (and seq
+ (not (funcall fn (car seq))))
+ (pop seq))
+ seq)))
+
+ (define-compiler-macro union (&whole form list1 list2)
+ (if (and (fboundp 'union)
+ (subrp (symbol-function 'union)))
+ form
+ `(let ((a ,list1)
+ (b ,list2))
+ (cond ((null a) b)
+ ((null b) a)
+ ((equal a b) a)
+ (t
+ (or (>= (length a) (length b))
+ (setq a (prog1 b (setq b a))))
+ (while b
+ (or (memq (car b) a)
+ (push (car b) a))
+ (pop b))
+ a)))))
+ )
+
;; If we are building w3 in a different directory than the source
;; directory, we must read *.el from source directory and write *.elc
;; into the building directory. For that, we define this function
(let ((info (assq category gnus-category-alist))
(buffer-read-only nil))
(gnus-delete-line)
- (gnus-category-write)
- (setq gnus-category-alist (delq info gnus-category-alist))))
+ (setq gnus-category-alist (delq info gnus-category-alist))
+ (gnus-category-write)))
(defun gnus-category-copy (category to)
"Copy the current category."
val elem)
(gnus-run-hooks 'gnus-part-display-hook)
(while (setq elem (pop alist))
- (setq val (symbol-value (car elem)))
+ (setq val
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (symbol-value (car elem))))
(when (and (or (consp val)
treated-type)
(gnus-treat-predicate val)
%n Select from where (string)
%z A string that look like `<%s:%n>' if a foreign select method is used
%d The date the group was last entered.
+%E Icon as defined by `gnus-group-icon-list'.
%u User defined specifier. The next character in the format string should
be a letter. Gnus will call the function gnus-user-format-function-X,
where X is the letter following %u. The function will be passed the
:group 'gnus-group-visual
:type 'character)
+(defgroup gnus-group-icons nil
+ "Add Icons to your group buffer. "
+ :group 'gnus-group-visual)
+
+(defcustom gnus-group-icon-list
+ nil
+ "*Controls the insertion of icons into group buffer lines.
+
+Below is a list of `Form'/`File' pairs. When deciding how a
+particular group line should be displayed, each form is evaluated.
+The icon from the file field after the first true form is used. You
+can change how those group lines are displayed by editing the file
+field. The File will either be found in the
+`gnus-group-glyph-directory' or by designating absolute path to the
+file.
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions. Hopefully this will
+change in a future release. For now, you can use the following
+variables in the Lisp expression:
+
+group: The name of the group.
+unread: The number of unread articles in the group.
+method: The select method used.
+mailp: Whether it's a mail group or not.
+newsp: Whether it's a news group or not
+level: The level of the group.
+score: The score of the group.
+ticked: The number of ticked articles."
+ :group 'gnus-group-icons
+ :type '(repeat (cons (sexp :tag "Form") file)))
+
+(defcustom gnus-group-glyph-directory gnus-xmas-glyph-directory
+ "*Directory where gnus group icons are located.
+Defaults to `gnus-xmas-glyph-directory'."
+ :group 'gnus-group-icons
+ :type 'directory)
+
+
;;; Internal variables
(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
(?s gnus-tmp-news-server ?s)
(?n gnus-tmp-news-method ?s)
(?P gnus-group-indentation ?s)
+ (?E gnus-tmp-group-icon ?s)
(?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?m (gnus-group-new-mail gnus-tmp-group) ?c)
(defvar gnus-group-list-mode nil)
+
+(defvar gnus-group-icon-cache nil)
+(defvar gnus-group-running-xemacs (string-match "XEmacs" emacs-version))
+
;;;
;;; Gnus group mode
;;;
?m ? ))
(gnus-tmp-moderated-string
(if (eq gnus-tmp-moderated ?m) "(m)" ""))
+ (gnus-tmp-group-icon "==&&==")
(gnus-tmp-method
(gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ;
(gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
gnus-marked ,gnus-tmp-marked-mark
gnus-indentation ,gnus-group-indentation
gnus-level ,gnus-tmp-level))
- (when (inline (gnus-visual-p 'group-highlight 'highlight))
(forward-line -1)
+ (gnus-group-add-icon)
+ (when (inline (gnus-visual-p 'group-highlight 'highlight))
(gnus-run-hooks 'gnus-group-update-hook)
(forward-line))
;; Allow XEmacs to remove front-sticky text properties.
(gnus-group-remove-excess-properties)))
+(defun gnus-group-add-icon ()
+ "Add an icon to the current line according to `gnus-group-icon-list'."
+ (let* ((p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point))))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (when (search-forward "==&&==" nil t)
+ (let* ((group (gnus-group-group-name))
+ (entry (gnus-group-entry group))
+ (unread (if (numberp (car entry)) (car entry) 0))
+ (active (gnus-active group))
+ (total (if active (1+ (- (cdr active) (car active))) 0))
+ (info (nth 2 entry))
+ (method (gnus-server-get-method group (gnus-info-method info)))
+ (marked (gnus-info-marks info))
+ (mailp (memq 'mail (assoc (symbol-name
+ (car (or method gnus-select-method)))
+ gnus-valid-select-methods)))
+ (level (or (gnus-info-level info) gnus-level-killed))
+ (score (or (gnus-info-score info) 0))
+ (ticked (gnus-range-length (cdr (assq 'tick marked))))
+ (group-age (gnus-group-timestamp-delta group))
+ (inhibit-read-only t)
+ (list gnus-group-icon-list)
+ (mystart (match-beginning 0))
+ (myend (match-end 0)))
+ (goto-char (point-min))
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list)))
+ (if list
+ (let* ((file (cdar list))
+ (glyph (gnus-group-icon-create-glyph
+ (buffer-substring mystart myend)
+ file)))
+ (if glyph
+ (progn
+ (mapcar 'delete-annotation (annotations-at myend))
+ (let ((ext (make-extent mystart myend))
+ (ant (make-annotation glyph myend '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)))
+ (delete-region mystart myend)))
+ (delete-region mystart myend))))
+ (widen))
+ (goto-char p)))
+
+(defun gnus-group-icon-create-glyph (substring pixmap)
+ "Create a glyph for insertion into a group line."
+ (and
+ gnus-group-running-xemacs
+ (or
+ (cdr-safe (assoc pixmap gnus-group-icon-cache))
+ (let* ((glyph (make-glyph
+ (list
+ (cons 'x
+ (expand-file-name pixmap gnus-group-glyph-directory))
+ (cons 'mswindows
+ (expand-file-name pixmap gnus-group-glyph-directory))
+ (cons 'tty substring)))))
+ (setq gnus-group-icon-cache
+ (cons (cons pixmap glyph) gnus-group-icon-cache))
+ (set-glyph-face glyph 'default)
+ glyph))))
+
(defun gnus-group-highlight-line ()
"Highlight the current line according to `gnus-group-highlight'."
(let* ((list gnus-group-highlight)
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-group-name-to-method to-newsgroup)))
+ (gnus-group-method to-newsgroup)))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
(unless to-newsgroup
(error "No group name entered"))
(or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
+ (gnus-activate-group to-newsgroup nil nil
+ (gnus-group-method to-newsgroup))
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
(or (and (gnus-request-create-group
- to-newsgroup (gnus-group-name-to-method to-newsgroup))
+ to-newsgroup (gnus-group-method to-newsgroup))
(gnus-activate-group
to-newsgroup nil nil
- (gnus-group-name-to-method to-newsgroup))
+ (gnus-group-method to-newsgroup))
(gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
(setq viewers (cdr viewers)))
(setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
(setq viewer (car passed))))
+ (setq passed (nreverse passed))
(when (and (stringp (cdr (assq 'viewer viewer)))
passed)
(setq viewer (car passed)))
(".cdf" . "application/x-netcdr")
(".cpio" . "application/x-cpio")
(".csh" . "application/x-csh")
+ (".css" . "text/css")
(".dvi" . "application/x-dvi")
(".diff" . "text/x-patch")
(".el" . "application/emacs-lisp")
;; If folding is disallowed, make sure the total length (including
;; the spaces between) will be less than MAXSIZE characters.
- (when message-cater-to-broken-inn
+ ;;
+ ;; Only disallow folding for News messages. At this point the headers
+ ;; have not been generated, thus we use message-this-is-news directly.
+ (when (and message-this-is-news message-cater-to-broken-inn)
(let ((maxsize 988)
(totalsize (+ (apply #'+ (mapcar #'length refs))
(1- count)))
;; Finally, collect the references back into a string and insert
;; it into the buffer.
(let ((refstring (mapconcat #'identity refs " ")))
- (if message-cater-to-broken-inn
+ (if (and message-this-is-news message-cater-to-broken-inn)
(insert (capitalize (symbol-name header)) ": "
refstring "\n")
(message-fill-header header refstring)))))
((and (not break)
(looking-at "=\\?"))
(setq break (point)))
- ((and (looking-at "\\?=")
+ ((and break
+ (looking-at "\\?=")
(> (- (point) (save-excursion (beginning-of-line) (point))) 76))
(goto-char break)
(setq break nil)
projects / gnus / commitdiff