home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / alt / lucidem / help / 317 < prev   
Encoding:
Text File  |  1992-08-21  |  7.4 KB  |  220 lines

  1. Path: sparky!uunet!mcsun!corton!loria!news.loria.fr!bosch
  2. From: bosch@loria.fr (Guido Bosch)
  3. Newsgroups: alt.lucid-emacs.help
  4. Subject: Re: Menu and mouse support for News ?
  5. Message-ID: <BOSCH.92Aug21131728@moebius.loria.fr>
  6. Date: 21 Aug 92 11:17:28 GMT
  7. References: <SSURHODE.92Aug19142124@suma1.susssys1.rdg.ac.uk>
  8. Sender: news@news.loria.fr
  9. Reply-To: Guido BOSCH <bosch@loria.fr>
  10. Distribution: alt
  11. Organization: INRIA-Lorraine / CRIN, Nancy, France
  12. Lines: 205
  13. In-reply-to: ssurhode@susssys1.rdg.ac.uk's message of 19 Aug 92 13:21:24 GMT
  14.  
  15. In article <SSURHODE.92Aug19142124@suma1.susssys1.rdg.ac.uk> ssurhode@susssys1.rdg.ac.uk (Paul Rhodes) writes:
  16.  
  17.  > Has anyone written some lucid emacs specific code for use with gnus. I
  18.  > like the menu/mouse support someone posted for VM, and am looking for
  19.  > something similar. Is there an FTP site that has all the lucid
  20.  > specific code on it ???? or is it a case of just looking thru the
  21.  > alt.lucid-emacs.help archives ????
  22.  
  23. Here is what I'm using for GNUS.
  24.  
  25.     Enjoy,
  26.         Guido
  27.  
  28.  
  29. ------------------------- gnus-lucid.el ---------------------------
  30. ;;; Mouse and font support for GNUS running in Lucid GNU Emacs
  31. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  32.  
  33. ;; This file is part of GNU Emacs.
  34.  
  35. ;; GNU Emacs is free software; you can redistribute it and/or modify
  36. ;; it under the terms of the GNU General Public License as published by
  37. ;; the Free Software Foundation; either version 2, or (at your option)
  38. ;; any later version.
  39.  
  40. ;; GNU Emacs is distributed in the hope that it will be useful,
  41. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  42. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  43. ;; GNU General Public License for more details.
  44.  
  45. ;; You should have received a copy of the GNU General Public License
  46. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  47. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  48.  
  49.  
  50. ;; Put different fonts on articles 
  51. (add-hook 'gnus-Select-article-hook 'gnus-fontify-headers)
  52.  
  53.  
  54. ;;; Right button pops up a menu of commands in Newsgroup and Subject buffers.
  55. ;;; Middle button selects indicated newsgroup or article.
  56.  
  57. (defvar gnus-Group-menu
  58.   '("GNUS Group Commands"
  59.     ["Select Newsgroup" gnus-Group-read-group t]
  60.     ["Unsubscribe Newsgroup" gnus-Group-unsubscribe-current-group t]
  61.     ["Get New News" gnus-Group-get-new-news t]
  62.     "----"
  63.     ["Mark Newsgroup as Read" gnus-Group-catch-up t]
  64.     ["Mark All Newsgroups as Read" gnus-Group-catch-up-all t]
  65.     ["Show All Newsgroups" gnus-Group-list-all-groups t]
  66.     ["Show Subscribed Nonempty Newsgroups" gnus-Group-list-groups t]
  67.     ["Check Bogosity" gnus-Group-check-bogus-groups t]
  68.     "----"
  69.     ["Save .newsrc" gnus-Group-force-update t]
  70.     ["GNUS Manual" gnus-Info-find-node t]
  71.     ["Suspend GNUS" gnus-Group-suspend t]
  72.     ["Quit GNUS" gnus-Group-exit t]
  73.     ))
  74.  
  75. (defvar gnus-Subject-menu
  76.   '("GNUS Subject Commands"
  77.     ["Select Article / Next Page" gnus-Subject-next-page t]
  78.     ["Prev Page" gnus-Subject-prev-page t]
  79.     ["Select Parent Article" gnus-Subject-refer-parent-article t]
  80.     "----"
  81.     ["Beginning of Article" gnus-Subject-beginning-of-article t]
  82.     ["End of Article" gnus-Subject-end-of-article t]
  83.     ["Show all Headers" gnus-Subject-show-all-headers t]
  84.     ["ROT13 Article" gnus-Subject-caesar-message t]
  85.     ["Save Article to Mail File" gnus-Subject-save-in-mail t]
  86.     "----"
  87.     ["Mail Reply" gnus-Subject-mail-reply t]
  88.     ["Mail Reply (Citing Original)" gnus-Subject-mail-reply-with-original t]
  89.     ["Post Reply" gnus-Subject-post-reply t]
  90.     ["Post Reply (Citing Original)" gnus-Subject-post-reply-with-original t]
  91.     "----"
  92.     ["Mark Article as Read" gnus-Subject-mark-as-read-forward t]
  93.     ["Mark Article as Unread" gnus-Subject-mark-as-unread-backward t]
  94.     ["Mark Similar Subjects as Read" gnus-Subject-kill-same-subject t]
  95.     ["Quit this Newsgroup" gnus-Subject-exit t]
  96.     ["Quit this Newsgroup (mark everything as read)"
  97.      gnus-Subject-catch-up-and-exit t]
  98.     ))
  99.  
  100.  
  101. (defvar gnus-Article-menu 
  102.   '("GNUS Article Commands"
  103.  
  104.     ["Next Page" gnus-Article-next-page t]
  105.     ["Prev Page" gnus-Article-prev-page t]
  106.     ["Pop Article History" gnus-Article-pop-article t]
  107.     ["Refer Article" gnus-Article-refer-article t]
  108.     ["Show Subjects" gnus-Article-show-subjects t]
  109.     ["Gnus Info Find Node" gnus-Info-find-node t]
  110.     ["Describe Briefly" gnus-Article-describe-briefly t]))
  111.  
  112.  
  113.  
  114.  
  115. (defun gnus-Group-menu (e)
  116.   (interactive "@e")
  117.   (popup-menu gnus-Group-menu))
  118.  
  119. (defun gnus-Subject-menu (e)
  120.   (interactive "@e")
  121.   (popup-menu gnus-Subject-menu))
  122.  
  123. (defun gnus-Article-menu (e)
  124.   (interactive "@e")
  125.   (popup-menu gnus-Article-menu))
  126.  
  127. (defun gnus-Group-mouse-read-group (e)
  128.   (interactive "e")
  129.   (mouse-set-point e)
  130.   (beginning-of-line)
  131.   (search-forward ":" nil t)
  132.   ;; (funcall mouse-motion-handler e)
  133.   (gnus-Group-read-group nil))
  134.  
  135. (defun gnus-Subject-mouse-next-page (e)
  136.   (interactive "e")
  137.   (mouse-set-point e)
  138.   (beginning-of-line)
  139.   (search-forward ":" nil t)
  140.   ;; (funcall mouse-motion-handler e)
  141.   (gnus-Subject-next-page nil))
  142.  
  143.  
  144. (define-key gnus-Subject-mode-map 'button2 'gnus-Subject-mouse-next-page)
  145. (define-key gnus-Group-mode-map   'button2 'gnus-Group-mouse-read-group)
  146.  
  147. (define-key gnus-Subject-mode-map 'button3 'gnus-Subject-menu)
  148. (define-key gnus-Group-mode-map   'button3 'gnus-Group-menu)
  149. (define-key gnus-Article-mode-map 'button3 'gnus-Article-menu)
  150.  
  151. ;;; Put message headers in boldface, etc...
  152.  
  153. (defun gnus-fontify-headers ()
  154.   (let* ((current 'italic)
  155.      p)
  156.     (save-excursion
  157.       (set-buffer gnus-Article-buffer)
  158.       (goto-char (point-min))
  159.       (while (and (not (eobp)) (not (looking-at "\n")))
  160.     (cond
  161.      ((looking-at "^[^ \t\n]+[ \t]*:")
  162.       (set-extent-face
  163.        (make-extent (match-beginning 0) (match-end 0))
  164.        'bold)
  165.       (setq p (match-end 0))
  166.       (cond
  167.        ((looking-at "Subject[ \t]*:")
  168.         (setq current 'bold-italic)
  169.         (end-of-line)
  170.         (set-extent-face (make-extent p (point)) current))
  171.        ((looking-at "\\(From\\|Resent-From\\)[ \t]*:")
  172.         (setq current 'bold-italic)
  173.         (goto-char (match-end 0))
  174.         (or (looking-at ".*(\\(.*\\))")
  175.         (looking-at "\\(.*\\)<")
  176.         (looking-at "\\(.*\\)[@%]")
  177.         (looking-at "\\(.*\\)"))
  178.         (end-of-line)
  179.         (set-extent-face (make-extent p (match-beginning 1)) 'italic)
  180.         (set-extent-face (make-extent (match-beginning 1) (match-end 1))
  181.                  current)
  182.         (set-extent-face (make-extent (match-end 1) (point)) 'italic)
  183.         )
  184.        (t
  185.         (setq current 'italic)
  186.         (end-of-line)
  187.         (set-extent-face (make-extent p (point)) current))))
  188.      (t
  189.       (setq p (point))
  190.       (end-of-line)
  191.       (set-extent-face (make-extent p (point)) current)))
  192.     (forward-line 1))
  193.       (while (not (eobp))
  194.     (cond ((looking-at "^[ \t]*[A-Z]*[]}<>|][ \t]*")
  195.            (goto-char (match-end 0))
  196.            (setq current 'italic))
  197.           ((or (looking-at "^In article\\|^In message")
  198.            (looking-at
  199.         "^[^ \t].*\\(writes\\|wrote\\|said\\):\n^[ \t]+[A-Z]*[]}<>|]"))
  200.            (setq current 'bold-italic))
  201.           (t (setq current nil)))
  202.     (cond (current
  203.            (setq p (point))
  204.            (end-of-line)
  205.            (set-extent-face (make-extent p (point)) current)))
  206.     (forward-line 1))
  207.       )))
  208.  
  209.  
  210.  
  211. --
  212. Guido BOSCH, INRIA-Lorraine/CRIN
  213. Institut National de Recherche en Informatique et en Automatique (INRIA)
  214. Centre de Recherche en Informatique de Nancy (CRIN)
  215. Campus scientifique, B.P. 239            
  216. 54506 Vandoeuvre-les-Nancy CEDEX           
  217. Tel.: (+33) 83.91.24.24
  218. Fax.: (+33) 83.41.30.79                    
  219. email: bosch@loria.fr                 
  220.