home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #16 / NN_1992_16.iso / spool / alt / lucidem / help / 136 < prev    next >
Encoding:
Text File  |  1992-07-26  |  10.1 KB  |  280 lines
  1. Xref: sparky alt.lucid-emacs.help:136 gnu.emacs.gnus:967
  2. Newsgroups: alt.lucid-emacs.help,gnu.emacs.gnus
  3. Path: sparky!uunet!stanford.edu!EE.Stanford.EDU!sierra!mcgrant
  4. From: mcgrant@isl.stanford.edu (Michael C. Grant)
  5. Subject: Cleaning up those ClariNet newsgroups
  6. Message-ID: <MCGRANT.92Jul26200520@isl.stanford.edu>
  7. Sender: usenet@EE.Stanford.EDU (Usenet)
  8. Organization: Information Systems Laboratory, Stanford University
  9. Date: 26 Jul 92 20:05:20
  10. Lines: 268
  11.  
  12.  
  13. Thanks to Sami-Jaakko Tikka and Jamie Zawinski, I was able to provide a
  14. decent if slightly inefficient solution to the problem of eliminating the
  15. _^H combinations from ClariNews files... I have included the result at the
  16. bottom of the gnus-lucid.el file which is Jamie sent, in the form of a
  17. gnus-Article-prepare-hook called gnus-fontify-clarinews.
  18.  
  19. The rest of the file, if you haven't seen it, defines some nice mouse,
  20. font, and menu support for GNUS. The middle button is an action button
  21. (select article/newsgroup), and the right button pops up a menu.
  22.  
  23. It does make the assumption that the form of the underlining is _^Hx, (i.e.
  24. the underline comes before the character), and it assumes that you want the
  25. resulting text boldfaced. But, heck, I have yet to see exceptions to the
  26. rule, and boldfacing is what newspapers seem to do for the
  27. clari.news.interest.people.column articles, so I figured that was OK.
  28. Besides, it is intended to be a quick hack.
  29.  
  30. Of course, feel free to use, adjust, modify, and/or discard this code...
  31.  
  32. Michael C. Grant
  33. mcgrant@rascals.stanford.edu
  34.  
  35. ;; Mouse and font support for GNUS running in Lucid GNU Emacs
  36. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  37. ;; Original file provided to mcgrant by Jamie Zawinski (jwz@lucid.com)
  38. ;; clari-clean added by Michael C. Grant (mcgrant@rascals.stanford.edu)
  39. ;; inspired by clari-clean.el by David N. Blank (dnb@meshugge.media.mit.edu)
  40.  
  41. ;; This file is part of GNU Emacs.
  42.  
  43. ;; GNU Emacs is free software; you can redistribute it and/or modify
  44. ;; it under the terms of the GNU General Public License as published by
  45. ;; the Free Software Foundation; either version 2, or (at your option)
  46. ;; any later version.
  47.  
  48. ;; GNU Emacs is distributed in the hope that it will be useful,
  49. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  50. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  51. ;; GNU General Public License for more details.
  52.  
  53. ;; You should have received a copy of the GNU General Public License
  54. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  55. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  56.  
  57. ;;; Highlight the line under the mouse in the Newsgroup and Subject buffers.
  58.  
  59. (defvar gnus-Subject-mouse-track-extent nil)
  60. (defvar gnus-Group-mouse-track-extent nil)
  61. (defvar gnus-orig-mouse-motion-handler)
  62.  
  63. (defun gnus-track-mouse (event)
  64.   (funcall gnus-orig-mouse-motion-handler event)
  65.   (let (window buffer point e)
  66.     (if (and (setq window (event-window event))
  67.          (setq buffer (window-buffer window))
  68.          (or (eq buffer (get-buffer gnus-Subject-buffer))
  69.          (eq buffer (get-buffer gnus-Group-buffer)))
  70.          (setq point (event-point event)))
  71.     (save-excursion
  72.       (setq e (if (eq buffer (get-buffer gnus-Group-buffer))
  73.               gnus-Group-mouse-track-extent
  74.             gnus-Subject-mouse-track-extent))
  75.       (set-buffer buffer)
  76.       (goto-char point)
  77.       (beginning-of-line)
  78.       (setq point (point))
  79.       (end-of-line)
  80.       (if (or (null e)
  81.           (null (extent-buffer e))
  82.           (null (buffer-name (extent-buffer e))))
  83.           (progn
  84.         (set (if (eq buffer (get-buffer gnus-Group-buffer))
  85.              'gnus-Group-mouse-track-extent
  86.                'gnus-Subject-mouse-track-extent)
  87.              (setq e (make-extent point (point))))
  88.         (set-extent-attribute e 'highlight))
  89.         (set-extent-endpoints e point (point))
  90.         (highlight-extent e t))))))
  91.  
  92. (defun gnus-install-mouse-tracker ()
  93.   (if (eq mouse-motion-handler 'gnus-track-mouse)
  94.       nil
  95.     (set (make-local-variable 'gnus-orig-mouse-motion-handler)
  96.      mouse-motion-handler)
  97.     (set (make-local-variable 'mouse-motion-handler) 'gnus-track-mouse)))
  98.  
  99. (add-hook 'gnus-Subject-mode-hook 'gnus-install-mouse-tracker)
  100. (add-hook 'gnus-Group-mode-hook   'gnus-install-mouse-tracker)
  101. (add-hook 'gnus-Article-mode-hook 'gnus-install-mouse-tracker)
  102.  
  103.  
  104. ;;; Right button pops up a menu of commands in Newsgroup and Subject buffers.
  105. ;;; Middle button selects indicated newsgroup or article.
  106.  
  107. (defvar gnus-Subject-menu
  108.   '("GNUS Subject Commands"
  109.     ["Select Article / Next Page" gnus-Subject-next-page t]
  110.     ["Prev Page" gnus-Subject-prev-page t]
  111.     ["Select Parent Article" gnus-Subject-refer-parent-article t]
  112.     "----"
  113.     ["Beginning of Article" gnus-Subject-beginning-of-article t]
  114.     ["End of Article" gnus-Subject-end-of-article t]
  115.     ["Show all Headers" gnus-Subject-show-all-headers t]
  116.     ["ROT13 Article" gnus-Subject-caesar-message t]
  117.     ["Save Article to Mail File" gnus-Subject-save-in-mail t]
  118.     "----"
  119.     ["Mail Reply" gnus-Subject-mail-reply t]
  120.     ["Mail Reply (Citing Original)" gnus-Subject-mail-reply-with-original t]
  121.     ["Post Reply" gnus-Subject-post-reply t]
  122.     ["Post Reply (Citing Original)" gnus-Subject-post-reply-with-original t]
  123.     "----"
  124.     ["Mark Article as Read" gnus-Subject-mark-as-read-forward t]
  125.     ["Mark Article as Unread" gnus-Subject-mark-as-unread-backward t]
  126.     ["Mark Similar Subjects as Read" gnus-Subject-kill-same-subject t]
  127.     ["Quit this Newsgroup" gnus-Subject-exit t]
  128.     ["Quit this Newsgroup (mark everything as read)"
  129.      gnus-Subject-catch-up-and-exit t]
  130.     ))
  131.  
  132. (defvar gnus-Group-menu
  133.   '("GNUS Group Commands"
  134.     ["Select Newsgroup" gnus-Group-read-group t]
  135.     ["Unsubscribe Newsgroup" gnus-Group-unsubscribe-current-group t]
  136.     ["Get New News" gnus-Group-get-new-news t]
  137.     "----"
  138.     ["Mark Newsgroup as Read" gnus-Group-catch-up t]
  139.     ["Mark All Newsgroups as Read" gnus-Group-catch-up-all t]
  140.     ["Show All Newsgroups" gnus-Group-list-all-groups t]
  141.     ["Show Subscribed Nonempty Newsgroups" gnus-Group-list-groups t]
  142.     ["Check Bogosity" gnus-Group-check-bogus-groups t]
  143.     "----"
  144.     ["Save .newsrc" gnus-Group-force-update t]
  145.     ["GNUS Manual" gnus-Info-find-node t]
  146.     ["Suspend GNUS" gnus-Group-suspend t]
  147.     ["Quit GNUS" gnus-Group-exit t]
  148.     ))
  149.  
  150. (defun gnus-Subject-menu (e)
  151.   (interactive "e")
  152.   (mouse-set-point e)
  153.   (beginning-of-line)
  154.   (search-forward ":" nil t)
  155.   (gnus-track-mouse e)
  156.   (popup-menu gnus-Subject-menu))
  157.  
  158. (defun gnus-Group-menu (e)
  159.   (interactive "e")
  160.   (mouse-set-point e)
  161.   (beginning-of-line)
  162.   (search-forward ":" nil t)
  163.   (gnus-track-mouse e)
  164.   (popup-menu gnus-Group-menu))
  165.  
  166. (defun gnus-Group-mouse-read-group (e)
  167.   (interactive "e")
  168.   (mouse-set-point e)
  169.   (beginning-of-line)
  170.   (search-forward ":" nil t)
  171.   (gnus-track-mouse e)
  172.   (gnus-Group-read-group nil))
  173.  
  174. (defun gnus-Subject-mouse-next-page (e)
  175.   (interactive "e")
  176.   (mouse-set-point e)
  177.   (beginning-of-line)
  178.   (search-forward ":" nil t)
  179.   (gnus-track-mouse e)
  180.   (gnus-Subject-next-page nil))
  181.  
  182. (define-key gnus-Subject-mode-map 'button2 'gnus-Subject-mouse-next-page)
  183. (define-key gnus-Group-mode-map   'button2 'gnus-Group-mouse-read-group)
  184.  
  185. (define-key gnus-Subject-mode-map 'button3 'gnus-Subject-menu)
  186. (define-key gnus-Group-mode-map   'button3 'gnus-Group-menu)
  187.  
  188.  
  189. ;;; Put message headers in boldface, etc...
  190.  
  191. (defun gnus-fontify-headers ()
  192.   (let* ((current 'italic)
  193.      p)
  194.     (save-excursion
  195.       (set-buffer gnus-Article-buffer)
  196.       (goto-char (point-min))
  197.       (while (and (not (eobp)) (not (looking-at "\n")))
  198.     (cond
  199.      ((looking-at "^[^ \t\n]+[ \t]*:")
  200.       (set-extent-face
  201.        (make-extent (match-beginning 0) (match-end 0))
  202.        'bold)
  203.       (setq p (match-end 0))
  204.       (cond
  205.        ((looking-at "Subject[ \t]*:")
  206.         (setq current 'bold-italic)
  207.         (end-of-line)
  208.         (set-extent-face (make-extent p (point)) current))
  209.        ((looking-at "\\(From\\|Resent-From\\)[ \t]*:")
  210.         (setq current 'bold-italic)
  211.         (goto-char (match-end 0))
  212.         (or (looking-at ".*(\\(.*\\))")
  213.         (looking-at "\\(.*\\)<")
  214.         (looking-at "\\(.*\\)[@%]")
  215.         (looking-at "\\(.*\\)"))
  216.         (end-of-line)
  217.         (set-extent-face (make-extent p (match-beginning 1)) 'italic)
  218.         (set-extent-face (make-extent (match-beginning 1) (match-end 1))
  219.                  current)
  220.         (set-extent-face (make-extent (match-end 1) (point)) 'italic)
  221.         )
  222.        (t
  223.         (setq current 'italic)
  224.         (end-of-line)
  225.         (set-extent-face (make-extent p (point)) current))))
  226.      (t
  227.       (setq p (point))
  228.       (end-of-line)
  229.       (set-extent-face (make-extent p (point)) current)))
  230.     (forward-line 1))
  231.       (save-restriction
  232.     (widen)
  233.     (let* ((start (point))
  234.            (end (save-excursion
  235.               (goto-char (point-max))
  236.               (re-search-backward "\n--+ *\n" start t)
  237.               (point))))
  238.       (while (< (point) end)
  239.         (cond ((looking-at "^[ \t]*[A-Z]*[]}<>|][ \t]*")
  240.            (goto-char (match-end 0))
  241.            (or (save-excursion
  242.              (beginning-of-line)
  243.              (let ((case-fold-search nil)) ; aaaaah, unix...
  244.                (looking-at "^>From ")))
  245.                (setq current 'italic)))
  246.           ((or (looking-at "^In article\\|^In message")
  247.                (looking-at
  248.         "^[^ \t].*\\(writes\\|wrote\\|said\\):\n[ \t]+[A-Z]*[]}<>|]"))
  249.            (setq current 'bold-italic))
  250.           (t (setq current nil)))
  251.         (cond (current
  252.            (setq p (point))
  253.            (end-of-line)
  254.            (set-extent-face (make-extent p (point)) current)))
  255.         (forward-line 1))))
  256.       )))
  257.  
  258. (defun gnus-fontify-clarinews ()
  259. ;; removes the overstriking attempts in ClariNews articles by replacing them
  260. ;; with boldface, and deleting the offending overstrikes.
  261.   "Nuke the underlining via backspaces found in a ClariNews article.
  262. Also removes the extra blank lines from the article."  
  263.   (if (string-match "^clari\\.*" gnus-newsgroup-name)
  264.       (save-excursion
  265.         (set-buffer gnus-Article-buffer)
  266.         (goto-char (point-min))
  267.         (while (re-search-forward "\\(\\(_.\\) ?\\)+" nil t)
  268.           (set-extent-face (make-extent (match-beginning 0) (match-end 0)) 'bold))
  269.         (goto-char (point-min))
  270.         (while (re-search-forward "_" nil t) (replace-match ""))
  271.         ;; Crunch blank lines 
  272.         (while (re-search-forward "\n\n\n\n*" nil t)
  273.           (replace-match "\n\n")))))
  274.  
  275. (add-hook 'gnus-Select-article-hook 'gnus-fontify-headers)
  276. (add-hook 'gnus-Article-prepare-hook 'gnus-fontify-clarinews)
  277.  
  278. (provide 'gnus-lucid)
  279.  
  280.