;;; Mouse and font support for GNUS running in Lucid GNU Emacs
;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Right button pops up a menu of commands in Newsgroup and Summary buffers.
;;; Middle button selects indicated newsgroup or article.
(defvar gnus-summary-menu
'("GNUS Summary Commands"
["Select Article / Next Page" gnus-summary-next-page t]
["Prev Page" gnus-summary-prev-page t]
["Select Parent Article" gnus-summary-refer-parent-article t]
"----"
["Beginning of Article" gnus-summary-beginning-of-article t]
["End of Article" gnus-summary-end-of-article t]
["Show All Headers" gnus-summary-show-all-headers t]
["ROT13 Article" gnus-summary-caesar-message t]
["Save Article to Mail File" gnus-summary-save-in-mail t]
("Sort Articles"
["Sort By Author" gnus-summary-sort-by-author t]
["Sort By Date" gnus-summary-sort-by-date t]
["Sort By Number" gnus-summary-sort-by-number t]
["Sort By Subject" gnus-summary-sort-by-subject t])
"----"
["Mail Reply" gnus-summary-reply t]
["Mail Reply (Citing Original)" gnus-summary-reply-with-original t]
["Post Reply" gnus-summary-followup t]
["Post Reply (Citing Original)" gnus-summary-followup-with-original t]
["Post New Article" gnus-summary-post-news t]
["Forward Article" gnus-summary-mail-forward t]
"----"
["Mark Article as Read" gnus-summary-mark-as-read-forward t]
["Mark Article as Unread" gnus-summary-mark-as-unread-backward t]
["Mark Similar Subjects as Read" gnus-summary-kill-same-subject t]
["Quit this Newsgroup" gnus-summary-exit t]
["Quit this Newsgroup (mark everything as read)"
gnus-summary-catchup-and-exit t]
))
(defvar gnus-group-menu
'("GNUS Group Commands"
["Select Newsgroup" gnus-group-read-group t]
["Unsubscribe Newsgroup" gnus-group-unsubscribe-current-group t]
["Get New News" gnus-group-get-new-news t]
"----"
["Mark Newsgroup as Read" gnus-group-catchup t]
["Mark All Newsgroups as Read" gnus-group-catchup-all t]
["Show All Newsgroups" gnus-group-list-all-groups t]
["Show Subscribed Nonempty Newsgroups" gnus-group-list-groups t]
["Check Bogosity" gnus-group-check-bogus-groups t]
"----"
["Post New Article" gnus-group-post-news t]
"----"
["Save .newsrc" gnus-group-force-update t]
["GNUS Manual" gnus-info-find-node t]
["Suspend GNUS" gnus-group-suspend t]
["Quit GNUS" gnus-group-exit t]
))
(defvar gnus-article-menu
'("GNUS Article Commands"
["Next Page" gnus-article-next-page t]
["Previous Page" gnus-article-prev-page t]
["Pop Article History" gnus-article-pop-article t]
["Show Referenced Article" gnus-article-refer-article t]
["Show Summary" gnus-article-show-summary t]
"----"
["Mail Reply" gnus-summary-reply t]
["Mail Reply (Citing Original)" gnus-summary-reply-with-original t]
["Post Reply" gnus-summary-followup t]
["Post Reply (Citing Original)" gnus-summary-followup-with-original t]
["Forward Article" gnus-summary-mail-forward t]
))
(defun gnus-summary-menu (e)
(interactive "e")
(mouse-set-point e)
(beginning-of-line)
(search-forward ":" nil t)
(popup-menu gnus-summary-menu))
(defun gnus-group-menu (e)
(interactive "e")
(mouse-set-point e)
(beginning-of-line)
(search-forward ":" nil t)
(popup-menu gnus-group-menu))
(defun gnus-article-menu (e)
(interactive "@e")
(popup-menu gnus-article-menu))
(defun gnus-group-mouse-read-group (e)
(interactive "e")
(mouse-set-point e)
(beginning-of-line)
(search-forward ":" nil t)
(gnus-group-read-group nil))
(defun gnus-summary-mouse-next-page (e)
(interactive "e")
(mouse-set-point e)
(beginning-of-line)
(search-forward ":" nil t)
(gnus-summary-next-page nil))
(define-key gnus-summary-mode-map 'button2 'gnus-summary-mouse-next-page)
(define-key gnus-group-mode-map 'button2 'gnus-group-mouse-read-group)
(define-key gnus-summary-mode-map 'button3 'gnus-summary-menu)
(define-key gnus-group-mode-map 'button3 'gnus-group-menu)
(define-key gnus-article-mode-map 'button3 'gnus-article-menu)
;;; Put message headers in boldface, etc...
(require 'highlight-headers)
(defun gnus-fontify-headers ()
(save-excursion
(set-buffer gnus-article-buffer)
(save-excursion
(save-restriction
(widen)
(highlight-headers (point-min) (point-max) t)))))
(make-face 'gnus-underline)
(or (face-differs-from-default-p 'gnus-underline)
(set-face-underline-p 'gnus-underline t))
(defun gnus-hack-underlining ()
"replaces underscore-backspace with an extent.
Also removes the extra blank lines from the article."
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-min))
(while (re-search-forward "\\(\\(_\^H.\\) ?\\)+" nil t)
(set-extent-face (make-extent (match-beginning 0) (match-end 0))
'gnus-underline))
(goto-char (point-min))
(while (re-search-forward "_\^H" nil t) (replace-match ""))))
(defun gnus-hack-clarinews ()
(if (string-match "^clari\\.*\\|^biz\\.clarinet" gnus-newsgroup-name)
(save-excursion
(gnus-hack-underlining)
(set-buffer gnus-article-buffer)
(goto-char (point-min))
(while (re-search-forward "\n\n\n\n*" nil t)
(replace-match "\n\n")))))
(add-hook 'gnus-select-article-hook 'gnus-fontify-headers)
(add-hook 'gnus-article-prepare-hook 'gnus-hack-clarinews)
;;; Fontify the Newsgroups and Summary buffers
;;; Enable this either of these by turning on font-lock-mode:
;;;
;;; (add-hook 'gnus-group-mode-hook 'turn-on-font-lock)
;;; (add-hook 'gnus-summary-mode-hook 'turn-on-font-lock)
;;;
;;; Fontifying the *Newsgroups* buffer makes `gnus-group-list-all-groups'
;;; be awfully slow (about 50 seconds to display 2782 groups on a Sparc10.)
;;; But it's fairly fast for day-to-day use if you only subscribe to a few
;;; hundred newsgroups.
;;;
;;; Fontifying the *Summary* buffer is about the same speed (per line) as
;;; the *Newsgroups* buffer, but since it's rare to ever select more than
;;; a few hundred articles, it's not so bad. (For ~100 articles it only
;;; takes ~2 seconds.)
;;;
;;; Possibly this could be optimized by doing the same sort of trick that
;;; we did with dired-indent-rigidly (that is, inhibit the after-change-
;;; function until the whole buffer has been generated) but preliminary
;;; tests suggest that what this would actually save is negligible.
(defconst gnus-summary-font-lock-keywords
'(
;; This is how you put the article number in another face
;;("^..[^0-9*]*\\([0-9]+\\):"
;; 1 message-highlighted-header-contents)
;; This matches the part between [] after optional something-digits-colon
("^[^[]+\\[\\([^A-Za-z\n]*[0-9]+:\\)?\\([^[\n]*\\)\\]"
2 message-headers)
;; This matches the part after the first ]
("^[^]\n]+\\]\\(.*\\)" 1 message-header-contents)
))
(defconst gnus-group-font-lock-keywords
'(
;; This is how you put the number of articles in another face
;;("^..[^0-9*]*\\([0-9]+\\):" 1 message-headers)
;; This matches the part after the first :
(": \\(.*\\)" 1 message-header-contents)
))
;;; Highlight the line under the mouse in the Newsgroup and Summary buffers.
(defun gnus-install-mouse-tracker ()
(require 'mode-motion)
(setq mode-motion-hook 'mode-motion-highlight-line))
(add-hook 'gnus-summary-mode-hook 'gnus-install-mouse-tracker)
(add-hook 'gnus-group-mode-hook 'gnus-install-mouse-tracker)
;;; Put the GNUS menus in the menubar
(defun gnus-install-menubar ()
(if (and current-menubar (not (assoc "GNUS" current-menubar)))
(let ((menu (cond ((eq major-mode 'gnus-group-mode) gnus-group-menu)
((eq major-mode 'gnus-summary-mode) gnus-summary-menu)
(t (error "not GNUS Group or Summary mode")))))
(set-buffer-menubar (copy-sequence current-menubar))
(add-menu nil "GNUS" (cdr menu)))))
(add-hook 'gnus-summary-mode-hook 'gnus-install-menubar)
(add-hook 'gnus-group-mode-hook 'gnus-install-menubar)
(provide 'gnus-lucid)