;;; gnus-xmas.el --- Gnus functions for XEmacs
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(if (or (featurep 'xface)
(featurep 'xpm))
'gnus-xmas-article-display-xface
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -")
+ "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
"*String or function to be executed to display an X-Face header.
If it is a string, the command will be executed in a sub-shell
asynchronously. The compressed face will be piped to this command."
(- (window-height) 2)))
(top (cond ((< height 4) 0)
((< height 7) 1)
- (t 2)))
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ 2))))
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
(point)))
;; 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)))
(let* ((pos (event-closest-point event))
(data (get-text-property pos 'gnus-data))
(fun (get-text-property pos 'gnus-callback)))
+ (goto-char pos)
(when fun
(funcall fun data))))
(delete-extent extent)
nil)))
-;; Fixed by Christopher Davis <ckd@loiosh.kei.com>.
-(defun gnus-xmas-article-add-button (from to fun &optional data)
- "Create a button between FROM and TO with callback FUN and data DATA."
- (when gnus-article-button-face
- (gnus-overlay-put (gnus-make-overlay from to)
- 'face gnus-article-button-face))
- (gnus-add-text-properties
- from to
- (nconc
- (and gnus-article-mouse-face
- (list 'mouse-face gnus-article-mouse-face))
- (list 'gnus-callback fun)
- (and data (list 'gnus-data data))
- (list 'highlight t))))
-
(defun gnus-xmas-window-top-edge (&optional window)
(nth 1 (window-pixel-edges window)))
(defun gnus-xmas-define ()
(setq gnus-mouse-2 [button2])
+ (setq gnus-mouse-3 [button3])
(setq gnus-widget-button-keymap widget-button-keymap)
(unless (memq 'underline (face-list))
(fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
(fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
(fset 'gnus-article-push-button 'gnus-xmas-article-push-button)
- (fset 'gnus-article-add-button 'gnus-xmas-article-add-button)
(fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge)
(fset 'gnus-read-event-char 'gnus-xmas-read-event-char)
(fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
(fset 'gnus-key-press-event-p 'key-press-event-p)
(fset 'gnus-region-active-p 'region-active-p)
(fset 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
+ (fset 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu)
(add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
(add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
'default-toolbar
nil)
"*If nil, do not use a toolbar.
-If it is non-nil, it must be a toolbar. The five legal values are
+If it is non-nil, it must be a toolbar. The five valid values are
`default-toolbar', `top-toolbar', `bottom-toolbar',
`right-toolbar', and `left-toolbar'."
:type '(choice (const default-toolbar)
[gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
[gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
[gnus-group-kill-group gnus-group-kill-group t "Kill group"]
- [gnus-group-exit gnus-group-exit t "Exit Gnus"]
- )
+ [gnus-group-exit gnus-group-exit t "Exit Gnus"])
"The group buffer toolbar.")
(defvar gnus-summary-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 ()
"Display any XFace headers in the current article."
(save-excursion
(let ((xface-glyph
- (cond ((featurep 'xface)
- (make-glyph (vector 'xface :data
- (concat "X-Face: "
- (buffer-substring beg end)))))
- ((featurep 'xpm)
- (let ((cur (current-buffer)))
- (save-excursion
- (gnus-set-work-buffer)
- (insert (format "%s" (buffer-substring beg end cur)))
- (gnus-xmas-call-region "uncompface")
- (goto-char (point-min))
- (insert "/* Width=48, Height=48 */\n")
- (gnus-xmas-call-region "icontopbm")
- (gnus-xmas-call-region "ppmtoxpm")
- (make-glyph
- (vector 'xpm :data (buffer-string))))))
- (t
- (make-glyph [nothing]))))
+ (cond
+ ((featurep 'xface)
+ (make-glyph (vector 'xface :data
+ (concat "X-Face: "
+ (buffer-substring beg end)))))
+ ((featurep 'xpm)
+ (let ((cur (current-buffer)))
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert (format "%s" (buffer-substring beg end cur)))
+ (gnus-xmas-call-region "uncompface")
+ (goto-char (point-min))
+ (insert "/* Width=48, Height=48 */\n")
+ (gnus-xmas-call-region "icontopbm")
+ (gnus-xmas-call-region "ppmtoxpm")
+ (make-glyph
+ (vector 'xpm :data (buffer-string))))))
+ (t
+ (make-glyph [nothing]))))
(ext (make-extent (progn
(goto-char (point-min))
(re-search-forward "^From:" nil t)
(set-extent-begin-glyph ext xface-glyph)
(set-extent-property ext 'duplicable t))))
-;;(defvar gnus-xmas-pointer-glyph
-;; (progn
-;; (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory
-;; "gnus"))
-;; (let ((file-xpm (expand-file-name "gnus-pointer.xpm"
-;; gnus-xmas-glyph-directory))
-;; (file-xbm (expand-file-name "gnus-pointer.xbm"
-;; gnus-xmas-glyph-directory)))
-;; (make-pointer-glyph
-;; (list (vector 'xpm ':file file-xpm)
-;; (vector 'xbm ':file file-xbm))))))
-
(defvar gnus-xmas-modeline-left-extent
(let ((ext (copy-extent modeline-buffer-id-left-extent)))
-; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
ext))
(defvar gnus-xmas-modeline-right-extent
(let ((ext (copy-extent modeline-buffer-id-right-extent)))
-; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph)
ext))
(defvar gnus-xmas-modeline-glyph
`[xpm :file ,file-xpm])
((featurep 'xbm)
;; Then a not-so-nifty XBM
- [xbm :file ,file-xbm])
+ `[xbm :file ,file-xbm])
;; Then the simple string
(t [string :data "Gnus:"])))))
(set-glyph-face glyph 'modeline-buffer-id)
(gnus-splash)))
(defun gnus-xmas-annotation-in-region-p (b e)
- (map-extents (lambda (e u) t) nil b e nil nil 'mm t))
+ (or (map-extents (lambda (e u) t) nil b e nil nil 'mm t)
+ (if (= b e)
+ (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
+ (text-property-any b e 'gnus-undeletable t))))
+
+(defun gnus-xmas-mime-button-menu (event)
+ "Construct a context-sensitive menu of MIME commands."
+ (interactive "e")
+ (let ((response (get-popup-menu-response
+ `("MIME Part"
+ ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t])
+ gnus-mime-button-commands)))))
+ (set-buffer (event-buffer event))
+ (goto-char (event-point event))
+ (funcall (event-function response) (event-object response))))
(provide 'gnus-xmas)