;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
+ ;; NOFORCE parameter suggested by Daniel Pittman <daniel@danann.net>.
(set-window-start
- window (min bottom (save-excursion (forward-line (- top)) (point)))))
+ window (min bottom (save-excursion (forward-line (- top)) (point)))
+ t))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
(concat (make-string
(max 0 (- ,pad (string-width val))) ?\ )
val))))))
-
- (defun gnus-tilde-max-form (el max-width)
- "Return a form that limits EL to MAX-WIDTH."
- (let ((max (abs max-width)))
- (if (symbolp el)
- (if (< max-width 0)
- `(let ((width (string-width ,el)))
- (gnus-truncate-string ,el width (- width ,max)))
- `(gnus-truncate-string ,el ,max))
- (if (< max-width 0)
- `(let* ((val (eval ,el))
- (width (string-width val)))
- (gnus-truncate-string val width (- width ,max)))
- `(let ((val (eval ,el)))
- (gnus-truncate-string val ,max))))))
-
- (defun gnus-tilde-cut-form (el cut-width)
- "Return a form that cuts CUT-WIDTH off of EL."
- (let ((cut (abs cut-width)))
- (if (symbolp el)
- (if (< cut-width 0)
- `(gnus-truncate-string ,el (- (string-width ,el) ,cut))
- `(gnus-truncate-string ,el (string-width ,el) ,cut))
- (if (< cut-width 0)
- `(let ((val (eval ,el)))
- (gnus-truncate-string val (- (string-width val) ,cut)))
- `(let ((val (eval ,el)))
- (gnus-truncate-string val (string-width val) ,cut))))))
))
;;; XEmacs logo and toolbar.
gnus-summary-catchup t "Catchup"]
[gnus-summary-catchup-and-exit
gnus-summary-catchup-and-exit t "Catchup and exit"]
- [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
- )
+ [gnus-summary-exit gnus-summary-exit t "Exit this summary"])
"The summary buffer toolbar.")
(defvar gnus-summary-mail-toolbar
[gnus-summary-next-unread
gnus-summary-next-unread-article t "Next unread article"]
[gnus-summary-mail-reply gnus-summary-reply t "Reply"]
-; [gnus-summary-mail-get gnus-mail-get t "Message get"]
[gnus-summary-mail-originate gnus-summary-post-news t "Originate"]
[gnus-summary-mail-save gnus-summary-save-article t "Save"]
[gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"]
-; [gnus-summary-mail-delete gnus-summary-delete-article t "Delete message"]
[gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"]
-; [gnus-summary-mail-spell gnus-mail-spell t "Spell"]
-; [gnus-summary-mail-help gnus-mail-help t "Message help"]
[gnus-summary-caesar-message
gnus-summary-caesar-message t "Rot 13"]
[gnus-uu-decode-uu
gnus-summary-catchup t "Catchup"]
[gnus-summary-catchup-and-exit
gnus-summary-catchup-and-exit t "Catchup and exit"]
- [gnus-summary-exit gnus-summary-exit t "Exit this summary"]
- )
+ [gnus-summary-exit gnus-summary-exit t "Exit this summary"])
"The summary buffer mail toolbar.")
(defun gnus-xmas-setup-group-toolbar ()
(goto-char (event-point event))
(funcall (event-function response) (event-object response))))
+(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-xmas-glyph-directory))
+ (cons 'mswindows
+ (expand-file-name pixmap gnus-xmas-glyph-directory))
+ (cons 'tty substring)))))
+ (setq gnus-group-icon-cache
+ (cons (cons pixmap glyph) gnus-group-icon-cache))
+ (set-glyph-face glyph 'default)
+ glyph))))
+
(provide 'gnus-xmas)
;;; gnus-xmas.el ends here