From: bosch@loria.fr (Guido Bosch)
Newsgroups: alt.lucid-emacs.help
Subject: Re: Menu and mouse support for News ?
Date: 21 Aug 92 11:17:28 GMT
Reply-To: Guido BOSCH <bosch@loria.fr>
Distribution: alt
Organization: INRIA-Lorraine / CRIN, Nancy, France
In-reply-to: ssurhode@susssys1.rdg.ac.uk's message of 19 Aug 92 13:21:24 GMT

In article <SSURHODE.92Aug19142124@suma1.susssys1.rdg.ac.uk> ssurhode@susssys1.rdg.ac.uk (Paul Rhodes) writes:

 > Has anyone written some lucid emacs specific code for use with gnus. I
 > like the menu/mouse support someone posted for VM, and am looking for
 > something similar. Is there an FTP site that has all the lucid
 > specific code on it ???? or is it a case of just looking thru the
 > alt.lucid-emacs.help archives ????

Here is what I'm using for GNUS.

	Enjoy,
		Guido


------------------------- gnus-lucid.el ---------------------------
;;; Mouse and font support for GNUS running in Lucid GNU Emacs
;; Copyright (C) 1992 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.


;; Put different fonts on articles 
(add-hook 'gnus-Select-article-hook 'gnus-fontify-headers)


;;; Right button pops up a menu of commands in Newsgroup and Subject buffers.
;;; Middle button selects indicated newsgroup or article.

(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-catch-up t]
    ["Mark All Newsgroups as Read" gnus-Group-catch-up-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]
    "----"
    ["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-Subject-menu
  '("GNUS Subject Commands"
    ["Select Article / Next Page" gnus-Subject-next-page t]
    ["Prev Page" gnus-Subject-prev-page t]
    ["Select Parent Article" gnus-Subject-refer-parent-article t]
    "----"
    ["Beginning of Article" gnus-Subject-beginning-of-article t]
    ["End of Article" gnus-Subject-end-of-article t]
    ["Show all Headers" gnus-Subject-show-all-headers t]
    ["ROT13 Article" gnus-Subject-caesar-message t]
    ["Save Article to Mail File" gnus-Subject-save-in-mail t]
    "----"
    ["Mail Reply" gnus-Subject-mail-reply t]
    ["Mail Reply (Citing Original)" gnus-Subject-mail-reply-with-original t]
    ["Post Reply" gnus-Subject-post-reply t]
    ["Post Reply (Citing Original)" gnus-Subject-post-reply-with-original t]
    "----"
    ["Mark Article as Read" gnus-Subject-mark-as-read-forward t]
    ["Mark Article as Unread" gnus-Subject-mark-as-unread-backward t]
    ["Mark Similar Subjects as Read" gnus-Subject-kill-same-subject t]
    ["Quit this Newsgroup" gnus-Subject-exit t]
    ["Quit this Newsgroup (mark everything as read)"
     gnus-Subject-catch-up-and-exit t]
    ))


(defvar gnus-Article-menu 
  '("GNUS Article Commands"

    ["Next Page" gnus-Article-next-page t]
    ["Prev Page" gnus-Article-prev-page t]
    ["Pop Article History" gnus-Article-pop-article t]
    ["Refer Article" gnus-Article-refer-article t]
    ["Show Subjects" gnus-Article-show-subjects t]
    ["Gnus Info Find Node" gnus-Info-find-node t]
    ["Describe Briefly" gnus-Article-describe-briefly t]))




(defun gnus-Group-menu (e)
  (interactive "@e")
  (popup-menu gnus-Group-menu))

(defun gnus-Subject-menu (e)
  (interactive "@e")
  (popup-menu gnus-Subject-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)
  ;; (funcall mouse-motion-handler e)
  (gnus-Group-read-group nil))

(defun gnus-Subject-mouse-next-page (e)
  (interactive "e")
  (mouse-set-point e)
  (beginning-of-line)
  (search-forward ":" nil t)
  ;; (funcall mouse-motion-handler e)
  (gnus-Subject-next-page nil))


(define-key gnus-Subject-mode-map 'button2 'gnus-Subject-mouse-next-page)
(define-key gnus-Group-mode-map   'button2 'gnus-Group-mouse-read-group)

(define-key gnus-Subject-mode-map 'button3 'gnus-Subject-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...

(defun gnus-fontify-headers ()
  (let* ((current 'italic)
	 p)
    (save-excursion
      (set-buffer gnus-Article-buffer)
      (goto-char (point-min))
      (while (and (not (eobp)) (not (looking-at "\n")))
	(cond
	 ((looking-at "^[^ \t\n]+[ \t]*:")
	  (set-extent-face
	   (make-extent (match-beginning 0) (match-end 0))
	   'bold)
	  (setq p (match-end 0))
	  (cond
	   ((looking-at "Subject[ \t]*:")
	    (setq current 'bold-italic)
	    (end-of-line)
	    (set-extent-face (make-extent p (point)) current))
	   ((looking-at "\\(From\\|Resent-From\\)[ \t]*:")
	    (setq current 'bold-italic)
	    (goto-char (match-end 0))
	    (or (looking-at ".*(\\(.*\\))")
		(looking-at "\\(.*\\)<")
		(looking-at "\\(.*\\)[@%]")
		(looking-at "\\(.*\\)"))
	    (end-of-line)
	    (set-extent-face (make-extent p (match-beginning 1)) 'italic)
	    (set-extent-face (make-extent (match-beginning 1) (match-end 1))
			     current)
	    (set-extent-face (make-extent (match-end 1) (point)) 'italic)
	    )
	   (t
	    (setq current 'italic)
	    (end-of-line)
	    (set-extent-face (make-extent p (point)) current))))
	 (t
	  (setq p (point))
	  (end-of-line)
	  (set-extent-face (make-extent p (point)) current)))
	(forward-line 1))
      (while (not (eobp))
	(cond ((looking-at "^[ \t]*[A-Z]*[]}<>|][ \t]*")
	       (goto-char (match-end 0))
	       (setq current 'italic))
	      ((or (looking-at "^In article\\|^In message")
		   (looking-at
	    "^[^ \t].*\\(writes\\|wrote\\|said\\):\n^[ \t]+[A-Z]*[]}<>|]"))
	       (setq current 'bold-italic))
	      (t (setq current nil)))
	(cond (current
	       (setq p (point))
	       (end-of-line)
	       (set-extent-face (make-extent p (point)) current)))
	(forward-line 1))
      )))



--
Guido BOSCH, INRIA-Lorraine/CRIN
Institut National de Recherche en Informatique et en Automatique (INRIA)
Centre de Recherche en Informatique de Nancy (CRIN)
Campus scientifique, B.P. 239            
54506 Vandoeuvre-les-Nancy CEDEX       	
Tel.: (+33) 83.91.24.24
Fax.: (+33) 83.41.30.79                	
email: bosch@loria.fr             	
Date: Mon, 17 Aug 1992 18:23:39 +0200
From: Guido.Bosch%loria.fr@lucid.com (Guido Bosch)
Subject: RE: mode-motion package
Reply-To: bosch%loria.fr@lucid.com (Guido BOSCH)
Newsgroups: alt.lucid-emacs.help