From: mcgrant@isl.stanford.edu (Michael C. Grant)
Subject: Cleaning up those ClariNet newsgroups
Organization: Information Systems Laboratory, Stanford University
Date: 26 Jul 92 20:05:20


Thanks to Sami-Jaakko Tikka and Jamie Zawinski, I was able to provide a
decent if slightly inefficient solution to the problem of eliminating the
_^H combinations from ClariNews files... I have included the result at the
bottom of the gnus-lucid.el file which is Jamie sent, in the form of a
gnus-Article-prepare-hook called gnus-fontify-clarinews.

The rest of the file, if you haven't seen it, defines some nice mouse,
font, and menu support for GNUS. The middle button is an action button
(select article/newsgroup), and the right button pops up a menu.

It does make the assumption that the form of the underlining is _^Hx, (i.e.
the underline comes before the character), and it assumes that you want the
resulting text boldfaced. But, heck, I have yet to see exceptions to the
rule, and boldfacing is what newspapers seem to do for the
clari.news.interest.people.column articles, so I figured that was OK.
Besides, it is intended to be a quick hack.

Of course, feel free to use, adjust, modify, and/or discard this code...

Michael C. Grant
mcgrant@rascals.stanford.edu

;; Mouse and font support for GNUS running in Lucid GNU Emacs
;; Copyright (C) 1992 Free Software Foundation, Inc.
;; Original file provided to mcgrant by Jamie Zawinski (jwz@lucid.com)
;; clari-clean added by Michael C. Grant (mcgrant@rascals.stanford.edu)
;; inspired by clari-clean.el by David N. Blank (dnb@meshugge.media.mit.edu)

;; 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.

;;; Highlight the line under the mouse in the Newsgroup and Subject buffers.

(defvar gnus-Subject-mouse-track-extent nil)
(defvar gnus-Group-mouse-track-extent nil)
(defvar gnus-orig-mouse-motion-handler)

(defun gnus-track-mouse (event)
  (funcall gnus-orig-mouse-motion-handler event)
  (let (window buffer point e)
    (if (and (setq window (event-window event))
	     (setq buffer (window-buffer window))
	     (or (eq buffer (get-buffer gnus-Subject-buffer))
		 (eq buffer (get-buffer gnus-Group-buffer)))
	     (setq point (event-point event)))
	(save-excursion
	  (setq e (if (eq buffer (get-buffer gnus-Group-buffer))
		      gnus-Group-mouse-track-extent
		    gnus-Subject-mouse-track-extent))
	  (set-buffer buffer)
	  (goto-char point)
	  (beginning-of-line)
	  (setq point (point))
	  (end-of-line)
	  (if (or (null e)
		  (null (extent-buffer e))
		  (null (buffer-name (extent-buffer e))))
	      (progn
		(set (if (eq buffer (get-buffer gnus-Group-buffer))
			 'gnus-Group-mouse-track-extent
		       'gnus-Subject-mouse-track-extent)
		     (setq e (make-extent point (point))))
		(set-extent-attribute e 'highlight))
	    (set-extent-endpoints e point (point))
	    (highlight-extent e t))))))

(defun gnus-install-mouse-tracker ()
  (if (eq mouse-motion-handler 'gnus-track-mouse)
      nil
    (set (make-local-variable 'gnus-orig-mouse-motion-handler)
	 mouse-motion-handler)
    (set (make-local-variable 'mouse-motion-handler) 'gnus-track-mouse)))

(add-hook 'gnus-Subject-mode-hook 'gnus-install-mouse-tracker)
(add-hook 'gnus-Group-mode-hook   'gnus-install-mouse-tracker)
(add-hook 'gnus-Article-mode-hook 'gnus-install-mouse-tracker)

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

(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-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]
    ))

(defun gnus-Subject-menu (e)
  (interactive "e")
  (mouse-set-point e)
  (beginning-of-line)
  (search-forward ":" nil t)
  (gnus-track-mouse e)
  (popup-menu gnus-Subject-menu))

(defun gnus-Group-menu (e)
  (interactive "e")
  (mouse-set-point e)
  (beginning-of-line)
  (search-forward ":" nil t)
  (gnus-track-mouse e)
  (popup-menu gnus-Group-menu))

(defun gnus-Group-mouse-read-group (e)
  (interactive "e")
  (mouse-set-point e)
  (beginning-of-line)
  (search-forward ":" nil t)
  (gnus-track-mouse 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)
  (gnus-track-mouse 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)


;;; 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))
      (save-restriction
	(widen)
	(let* ((start (point))
	       (end (save-excursion
		      (goto-char (point-max))
		      (re-search-backward "\n--+ *\n" start t)
		      (point))))
	  (while (< (point) end)
	    (cond ((looking-at "^[ \t]*[A-Z]*[]}<>|][ \t]*")
		   (goto-char (match-end 0))
		   (or (save-excursion
			 (beginning-of-line)
			 (let ((case-fold-search nil)) ; aaaaah, unix...
			   (looking-at "^>From ")))
		       (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))))
      )))

(defun gnus-fontify-clarinews ()
;; removes the overstriking attempts in ClariNews articles by replacing them
;; with boldface, and deleting the offending overstrikes.
  "Nuke the underlining via backspaces found in a ClariNews article.
Also removes the extra blank lines from the article."  
  (if (string-match "^clari\\.*" gnus-newsgroup-name)
      (save-excursion
        (set-buffer gnus-Article-buffer)
        (goto-char (point-min))
        (while (re-search-forward "\\(\\(_.\\) ?\\)+" nil t)
          (set-extent-face (make-extent (match-beginning 0) (match-end 0)) 'bold))
        (goto-char (point-min))
        (while (re-search-forward "_" nil t) (replace-match ""))
        ;; Crunch blank lines 
        (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-fontify-clarinews)

(provide 'gnus-lucid)