home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / gnus / gnus-lucid.el < prev    next >
Encoding:
Text File  |  1993-02-17  |  6.3 KB  |  182 lines
  1. ;;; Mouse and font support for GNUS running in Lucid GNU Emacs
  2. ;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. ;;; Right button pops up a menu of commands in Newsgroup and Subject buffers.
  22. ;;; Middle button selects indicated newsgroup or article.
  23.  
  24. (defvar gnus-Subject-menu
  25.   '("GNUS Subject Commands"
  26.     ["Select Article / Next Page" gnus-Subject-next-page t]
  27.     ["Prev Page" gnus-Subject-prev-page t]
  28.     ["Select Parent Article" gnus-Subject-refer-parent-article t]
  29.     "----"
  30.     ["Beginning of Article" gnus-Subject-beginning-of-article t]
  31.     ["End of Article" gnus-Subject-end-of-article t]
  32.     ["Show all Headers" gnus-Subject-show-all-headers t]
  33.     ["ROT13 Article" gnus-Subject-caesar-message t]
  34.     ["Save Article to Mail File" gnus-Subject-save-in-mail t]
  35.     "----"
  36.     ["Mail Reply" gnus-Subject-mail-reply t]
  37.     ["Mail Reply (Citing Original)" gnus-Subject-mail-reply-with-original t]
  38.     ["Post Reply" gnus-Subject-post-reply t]
  39.     ["Post Reply (Citing Original)" gnus-Subject-post-reply-with-original t]
  40.     ["Forward Article" gnus-Subject-mail-forward t]
  41.     "----"
  42.     ["Mark Article as Read" gnus-Subject-mark-as-read-forward t]
  43.     ["Mark Article as Unread" gnus-Subject-mark-as-unread-backward t]
  44.     ["Mark Similar Subjects as Read" gnus-Subject-kill-same-subject t]
  45.     ["Quit this Newsgroup" gnus-Subject-exit t]
  46.     ["Quit this Newsgroup (mark everything as read)"
  47.      gnus-Subject-catch-up-and-exit t]
  48.     ))
  49.  
  50. (defvar gnus-Group-menu
  51.   '("GNUS Group Commands"
  52.     ["Select Newsgroup" gnus-Group-read-group t]
  53.     ["Unsubscribe Newsgroup" gnus-Group-unsubscribe-current-group t]
  54.     ["Get New News" gnus-Group-get-new-news t]
  55.     "----"
  56.     ["Mark Newsgroup as Read" gnus-Group-catch-up t]
  57.     ["Mark All Newsgroups as Read" gnus-Group-catch-up-all t]
  58.     ["Show All Newsgroups" gnus-Group-list-all-groups t]
  59.     ["Show Subscribed Nonempty Newsgroups" gnus-Group-list-groups t]
  60.     ["Check Bogosity" gnus-Group-check-bogus-groups t]
  61.     "----"
  62.     ["Save .newsrc" gnus-Group-force-update t]
  63.     ["GNUS Manual" gnus-Info-find-node t]
  64.     ["Suspend GNUS" gnus-Group-suspend t]
  65.     ["Quit GNUS" gnus-Group-exit t]
  66.     ))
  67.  
  68. (defvar gnus-Article-menu 
  69.   '("GNUS Article Commands"
  70.     ["Next Page" gnus-Article-next-page t]
  71.     ["Previous Page" gnus-Article-prev-page t]
  72.     ["Pop Article History" gnus-Article-pop-article t]
  73.     ["Show Referenced Article" gnus-Article-refer-article t]
  74.     ["Show Subjects" gnus-Article-show-subjects t]))
  75.  
  76. (defun gnus-Subject-menu (e)
  77.   (interactive "e")
  78.   (mouse-set-point e)
  79.   (beginning-of-line)
  80.   (search-forward ":" nil t)
  81.   (popup-menu gnus-Subject-menu))
  82.  
  83. (defun gnus-Group-menu (e)
  84.   (interactive "e")
  85.   (mouse-set-point e)
  86.   (beginning-of-line)
  87.   (search-forward ":" nil t)
  88.   (popup-menu gnus-Group-menu))
  89.  
  90. (defun gnus-Article-menu (e)
  91.   (interactive "@e")
  92.   (popup-menu gnus-Article-menu))
  93.  
  94. (defun gnus-Group-mouse-read-group (e)
  95.   (interactive "e")
  96.   (mouse-set-point e)
  97.   (beginning-of-line)
  98.   (search-forward ":" nil t)
  99.   (gnus-Group-read-group nil))
  100.  
  101. (defun gnus-Subject-mouse-next-page (e)
  102.   (interactive "e")
  103.   (mouse-set-point e)
  104.   (beginning-of-line)
  105.   (search-forward ":" nil t)
  106.   (gnus-Subject-next-page nil))
  107.  
  108. (define-key gnus-Subject-mode-map 'button2 'gnus-Subject-mouse-next-page)
  109. (define-key gnus-Group-mode-map   'button2 'gnus-Group-mouse-read-group)
  110.  
  111. (define-key gnus-Subject-mode-map 'button3 'gnus-Subject-menu)
  112. (define-key gnus-Group-mode-map   'button3 'gnus-Group-menu)
  113. (define-key gnus-Article-mode-map 'button3 'gnus-Article-menu)
  114.  
  115.  
  116. ;;; Put message headers in boldface, etc...
  117.  
  118. (require 'highlight-headers)
  119.  
  120. (defun gnus-fontify-headers ()
  121.   (save-excursion
  122.     (set-buffer gnus-Article-buffer)
  123.     (save-excursion
  124.       (save-restriction
  125.     (widen)
  126.     (highlight-headers (point-min) (point-max) t)))))
  127.  
  128. (make-face 'gnus-underline)
  129. (or (face-differs-from-default-p 'gnus-underline)
  130.     (set-face-underline-p 'gnus-underline t))
  131.  
  132. (defun gnus-hack-underlining ()
  133.   "replaces underscore-backspace with an extent.
  134. Also removes the extra blank lines from the article."
  135.   (save-excursion
  136.     (set-buffer gnus-Article-buffer)
  137.     (goto-char (point-min))
  138.     (while (re-search-forward "\\(\\(_\^H.\\) ?\\)+" nil t)
  139.       (set-extent-face (make-extent (match-beginning 0) (match-end 0))
  140.                'gnus-underline))
  141.     (goto-char (point-min))
  142.     (while (re-search-forward "_\^H" nil t) (replace-match ""))))
  143.  
  144. (defun gnus-hack-clarinews ()
  145.   (if (string-match "^clari\\.*\\|^biz\\.clarinet" gnus-newsgroup-name)
  146.       (save-excursion
  147.     (gnus-hack-underlining)
  148.     (set-buffer gnus-Article-buffer)
  149.     (goto-char (point-min))
  150.         (while (re-search-forward "\n\n\n\n*" nil t)
  151.           (replace-match "\n\n")))))
  152.  
  153. (add-hook 'gnus-Select-article-hook 'gnus-fontify-headers)
  154. (add-hook 'gnus-Article-prepare-hook 'gnus-hack-clarinews)
  155.  
  156.  
  157. ;;; Highlight the line under the mouse in the Newsgroup and Subject buffers.
  158.  
  159. (defun gnus-install-mouse-tracker ()
  160.   (require 'mode-motion)
  161.   (setq mode-motion-hook 'mode-motion-highlight-line))
  162.  
  163. (add-hook 'gnus-Subject-mode-hook 'gnus-install-mouse-tracker)
  164. (add-hook 'gnus-Group-mode-hook   'gnus-install-mouse-tracker)
  165.  
  166.  
  167. ;;; Put the GNUS menus in the menubar
  168.  
  169. (defun gnus-install-menubar ()
  170.   (if (and current-menubar (not (assoc "GNUS" current-menubar)))
  171.       (let ((menu (cond ((eq major-mode 'gnus-Group-mode) gnus-Group-menu)
  172.             ((eq major-mode 'gnus-Subject-mode) gnus-Subject-menu)
  173.             (t (error "not GNUS Group or Subject mode")))))
  174.     (set-buffer-menubar (copy-sequence current-menubar))
  175.     (add-menu nil "GNUS" (cdr menu)))))
  176.  
  177. (add-hook 'gnus-Subject-mode-hook 'gnus-install-menubar)
  178. (add-hook 'gnus-Group-mode-hook   'gnus-install-menubar)
  179.  
  180.  
  181. (provide 'gnus-lucid)
  182.