home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / gnus-hide.el < prev    next >
Encoding:
Text File  |  1991-06-19  |  28.4 KB  |  905 lines
  1. ; Path: dg-rtp!rock.concert.net!mcnc!stanford.edu!agate!ucbvax!van-bc!ubc-cs!unixg.ubc.ca!brazeau.ucs.ualberta.ca!alberta!cpsc.ucalgary.ca!krawchuk
  2. ; From: krawchuk@cpsc.UCalgary.ca (Bj Krawchuk)
  3. ; Newsgroups: gnu.emacs.sources
  4. ; Subject: gnus-hide.el 1.04
  5. ; Summary: a quote, signature and reference hider
  6. ; Date: 19 Jun 91 18:43:34 GMT
  7. ; Organization: The University of Calgary
  8. ; 
  9. ; 
  10. ; Here's a treat for GNUS users.
  11. ; It is a major enhancement of the old gnus-hide-quote.el.
  12. ; It does quote, signature and reference-line hiding.
  13. ; 
  14. ; Please tell me about any bugs (I know of a couple already)
  15. ; so that I can iron them out for the next version.
  16. ; This version should work for almost all articles, however.
  17. ; Also please offer suggestions (or code!) for future versions. 
  18. ; 
  19. ; Enjoy.
  20. ; 
  21. ; Bj <krawchuk@cpsc.ucalgary.ca>
  22. ; 
  23. ;;;--------------------------------------------------------------------
  24. ;;;
  25. ;;; gnus-hide.el    hide quotes and/or signatures
  26. ;;; v1.04        simplify references
  27. ;;;
  28. ;;; LCD Archive Entry:
  29. ;;; gnus-hide|Bj Krawchuk|krawchuk@cpsc.UCalgary.ca
  30. ;;; |A quote, signature and reference hider for the GNUS news reader
  31. ;;; |91-06-19|1.04|~/misc/gnus-hide.el.Z
  32. ;;;
  33. ;;; improve readability and reduce screen output time 
  34. ;;; (for slow baud rates) by hiding quotes and/or signatures.
  35. ;;;
  36. ;;;
  37. ;;; (Note: this file can be viewed/modified with Awefold 1.0)
  38. ;;;
  39. ;::         QUOTE HIDING
  40. ;;;
  41. ;;; Don't you hate it when an article has pages of quoted text that you've
  42. ;;; already read?  Load this file and you can just type 'h' or '['
  43. ;;; to get rid of it and 'H' or ']' to bring it back.
  44. ;;;
  45. ;;; If someone uses something other than ">" to mark the quoted text, it
  46. ;;; notices that; it can even cope with the kind of stuff that SuperCite
  47. ;;; inserts, and simple indentation (though it tries that as a last resort).
  48. ;;; If it can't figure out what the attribution string is, it prompts for it.
  49. ;;; 'C-uh' will make it prompt anyway, with it's guess as a default.  If a
  50. ;;; SuperCited article has multiple sections like
  51. ;;;
  52. ;;;       FOO> some text, some text
  53. ;;;       FOO> blah blah blah
  54. ;;;       oh yeah?
  55. ;;;       BAR> some text, some text
  56. ;;;       BAR> blah blah blah
  57. ;;;
  58. ;;; you can generally make both sections go away just by typing 'h' twice.
  59. ;;; Also, if two blocks of text to be elided are seperated only by blank
  60. ;;; lines, the blank lines are hidden as well.
  61. ;;;
  62. ;;;    To hide a quote while in subject mode: type "h" or "[".
  63. ;;;     To show everything including quotes and signature: type "H" or "]"
  64. ;;;
  65. ;;; Quote hiding can also be done automatically on selecting an article.
  66. ;;;     (see .emacs setup section below)
  67. ;;;     You may temporarily turn autohiding off by typing "'" or "C-cC-r"
  68. ;:|
  69. ;;;
  70. ;::         SIGNATURE HIDING
  71. ;;;
  72. ;;;    Can't stand long and ugly signatures? Hate seeing the 
  73. ;;;    same signatures over and over again? Hate scrolling 
  74. ;;;    the screen with <SPC> only to find a signature on the 
  75. ;;;    next page? TRY SIGNATURE HIDING!
  76. ;;;
  77. ;;;    o Hide signatures when they can be identified
  78. ;;;    o Useful for reading articles for people with long signatures
  79. ;;;      especially at low baud rates.
  80. ;;;    o Useful even at high baud rates to avoid the need for
  81. ;;;      extra scrolling and to aid readability.
  82. ;;;     o Will hide most signatures
  83. ;;;
  84. ;;;    To hide a signature while in subject mode: type "S" or "{"
  85. ;;;     To show everything including quotes and signature: type "H" or "]"
  86. ;;;
  87. ;;; Signature hiding can also be done automatically on selecting an article.
  88. ;;;     (see .emacs setup section below)
  89. ;:|
  90. ;;;
  91. ;::        REFERENCE SIMPLIFICATION
  92. ;;;
  93. ;;; Can't stand those ugly reference lines? Don't understand what 
  94. ;;; they mean anyway? Use reference simplification.
  95. ;;;
  96. ;;; Simply type "C-cC-r" or "}" in subject mode, and all those long 
  97. ;;; reference lines will be simplified.
  98. ;;; For example, 
  99. ;;;    In article < ... > foo@goo.edu (Jawn Dough) writes:
  100. ;;; will be simplified to:
  101. ;;;    (Jawn Dough) writes:
  102. ;;; 
  103. ;;; Reference hiding can also be done automatically on selecting an article.
  104. ;;;     (see .emacs setup section below)
  105. ;:|
  106. ;;;
  107. ;::         LIMITATIONS
  108. ;;;
  109. ;;;    o sometimes quote hiding and signature hiding will be overzealous
  110. ;;;      and hide stuff you really didn't want to hide. The user must
  111. ;;;      type "H" then, and put up with the quoting and signature 
  112. ;;;      for that article. This is particularly the case when 
  113. ;;;      gnus-hide-hookified-be-aggressive is set to t.
  114. ;;;
  115. ;;;    o Signature hiding may occasionally not recognize some things
  116. ;;;      that look like signatures. (Paragraphs with street addresses
  117. ;;;      without email addresses, for example).
  118. ;;;
  119. ;;;    o Reference simplification is not reversible. Reselecting the 
  120. ;;;      article will restore the original reference lines. (If using
  121. ;;;      autohiding -- hookified simplification -- first you will have to
  122. ;;;      toggle the autohiding by pressing "'", the apostrophe key.
  123. ;;;
  124. ;:|
  125. ;;;    
  126. ;::         .emacs startup
  127. ;;;
  128. ;:: Hooks
  129. ;;;
  130. ;;; To automatically load gnus-hide when starting gnus, 
  131. ;;; put this into your .emacs::
  132. ;;; (setq gnus-Startup-hook 
  133. ;;;   '(lambda ()
  134. ;;;    (require 'gnus-hide)))
  135. ;;;
  136. ;;; If you want gnus to do quote hiding automatically when you select
  137. ;;; an article:
  138. ;;; (setq  gnus-Article-prepare-hook 'gnus-Article-hide-quote)
  139. ;;;
  140. ;;; If you want gnus to do signature hiding automatically when you select
  141. ;;; an article:
  142. ;;; (setq  gnus-Article-prepare-hook 'gnus-Article-hide-sig)
  143. ;;;
  144. ;;; If you want gnus to do reference hiding automatically when you select
  145. ;;; an article:
  146. ;;; (setq  gnus-Article-prepare-hook 'gnus-Article-simplify-references)
  147. ;;;
  148. ;;; To use a couple or all three of these, put the names in a list like this:
  149. ;;;
  150. ;;; (setq gnus-Article-prepare-hook 
  151. ;;;    '(gnus-Article-hide-quote 
  152. ;;;      gnus-Article-hide-sig
  153. ;;;      gnus-Article-simplify-references))
  154. ;;;
  155. ;:|
  156. ;:: Variables
  157. ;;;
  158. ;;; -- To use aggressive quote prefixes in gnus-Article-hide-quote
  159. ;;;     (setq gnus-hide-hookified-be-aggressive t)
  160. ;;;
  161. ;;; -- To turn off aggressive signature hiding:
  162. ;;;     (setq gnus-hide-sig-aggressively nil)
  163. ;;;
  164. ;;; -- If you want to save "hidden articles", 
  165. ;;;     (setq gnus-save-article-prepare-hook nil)
  166. ;;;
  167. ;;;    (By default, it does unhiding, and most people won't want to
  168. ;;;     change this behavior.)
  169. ;;;
  170. ;;; -- To YANK Unhidden while followup posting or replying,
  171. ;;;     (setq mail-yank-hooks 'gnus-hide-yank-original-unhide)
  172. ;;;     (autoload 'gnus-hide-yank-original-unhide "gnus-hide" "" t)
  173. ;;;
  174. ;;;    I use supercite as well, so I use:
  175. ;;;     (setq mail-yank-hooks '(gnus-hide-yank-original-unhide 
  176. ;;;                sc-cite-original))
  177. ;;;
  178. ;;; -- To do automatic quote hiding only on followups:
  179. ;;;    (setq gnus-autohide-only-on-followup t)
  180. ;;;
  181. ;;; -- To not show the first line of a hidden quote
  182. ;;;    (setq gnus-hide-show-first-line nil)
  183. ;;;
  184. ;;; -- To not place the ellipsis on a newline (when gnus-hide-show-first-line
  185. ;;;    is set to nil), ie. place it on the same line as the reference line.
  186. ;;;    (setq gnus-hide-place-ellipsis-on-newline nil)
  187. ;;; 
  188. ;;; Other customizable variables are available for more experienced users...
  189. ;;;
  190. ;:|
  191. ;:|
  192. ;;;
  193. ;::         AUTHORS and HISTORY
  194. ;;;
  195. ;;;  14-dec-90    Tim Lambert <lambert@spectrum.cs.unsw.oz.au>
  196. ;;;        o Created gnus-hide-quote.el
  197. ;;;  27-jan-91    Jamie Zawinski <jwz@lucid.com>
  198. ;;;        o Made it automatic.
  199. ;;;   1-jun-91  Brent J. Krawchuk <krawchuk@cpsc.ucalgary.ca>
  200. ;;;             o renamed to gnus-hide.el
  201. ;;;        o autohiding (use of article prepare hook)
  202. ;;;             o signature hiding functions
  203. ;;;        o reference hiding functions
  204. ;;;        o made into awefold 1.0 file
  205. ;;;        Tim Lambert, J. Zawinski, Dave Brennan and Dan Jacobson
  206. ;;;        o added/improved code, suggestions, bug fixes
  207. ;;;
  208. ;;;  Feel free to contact the authors to make suggestions, or bug fixes.
  209. ;;;
  210. ;:|
  211. ;;;    
  212. ;;;--------------------------------------------------------------------
  213. (require 'gnus)
  214.  
  215. ;::        KEY DEFINITIONS
  216.  
  217. (define-key gnus-Subject-mode-map "S"    'gnus-Subject-hide-sig)
  218. (define-key gnus-Subject-mode-map "h"    'gnus-Subject-hide-quote)
  219. (define-key gnus-Subject-mode-map "H"    'gnus-Subject-unhide)
  220. (define-key gnus-Subject-mode-map "\C-c\C-r" 'gnus-Subject-simplify-references)
  221. (define-key gnus-Subject-mode-map "{"    'gnus-Subject-hide-sig)
  222. (define-key gnus-Subject-mode-map "}"    'gnus-Subject-simplify-references)
  223. (define-key gnus-Subject-mode-map "["    'gnus-Subject-hide-quote)
  224. (define-key gnus-Subject-mode-map "]"    'gnus-Subject-unhide)
  225. (define-key gnus-Subject-mode-map "'"      'gnus-hide-autohide-toggle)
  226.  
  227. ;:|
  228.  
  229. ;::         QUOTE HIDING FUNCTIONS
  230.  
  231. ;:: Quote Prefixes
  232.  
  233. (defvar gnus-possible-quote-prefixes
  234.     '("^[^ \t\n\(A-Z#%;]"    ;; first, search for ">", "}", etc.
  235.       "^[ \t]+[^ \t\n\(A-Z#%;]"    ;; then that with leading whitespace.
  236.                 ;; these don't use #%; because of shar files
  237.                       ;; and postscript and lisp code...
  238.       "^[ \t]*[A-Z]+[]}>[{<-]"  ;; then, SuperCite: "FOO> ", "  Yow>", etc.
  239.       )
  240.   "Regexps to search for to identify quoted-text attributions.
  241. These regexps should match the initial subsequence of the line that is the
  242. attribution prefix.  They are ordered; regexps which are less ambiguous and 
  243. less likely to produce mismatches should come first.  The entire buffer will 
  244. be searched for two or more consecutive lines which match the first element 
  245. of this list, then the second, and so on.  The initial subsequence of the 
  246. two lines which first match is returned. Regular quote hiding also
  247. uses gnus-aggressive-quote-prefixes, unlike hookified quote hiding 
  248. which, by default, does not.")
  249.  
  250. (defvar gnus-hide-hookified-be-aggressive nil
  251.   "Variable to determine if hooked calling of gnus-hide-Article-quote
  252. should use aggressive quote prefixes. If set to t, aggressive 
  253. prefixes will be used.
  254. Default: nil")
  255.  
  256.     
  257. (defvar gnus-aggressive-quote-prefixes
  258.     '("^[ \t]+"            ;;  simple indentation
  259.       "^[\(#%;]"        ;; "comment" chars...
  260.      )
  261.  "Regexps for last-resort hiding. By default, these are not 
  262. used in hookified calling (gnus-Article-hide-{quote/sig}).
  263. See gnus-hide-hookified-be-aggressive and gnus-possible-quote-prefixes.")
  264.  
  265.  
  266. (defun gnus-identify-quote-prefix (use-aggressive)
  267.   "Figure out what the current message uses for attribution.  See the
  268. documentation for gnus-possible-quote-prefixes."
  269.   (save-excursion
  270.    (save-restriction
  271.     (gnus-find-sig-position)
  272.     (if (not (= (point) (point-min)))
  273.     (narrow-to-region (point-min) (point)))
  274.     (goto-char (point-min))
  275.     (search-forward "\n\n" nil t)
  276.     (let ((match nil)
  277.       (start (point))
  278.       (rest (if use-aggressive 
  279.             (append gnus-possible-quote-prefixes
  280.                 gnus-aggressive-quote-prefixes)
  281.             gnus-possible-quote-prefixes)))
  282.       (while (and rest (not match))
  283.     (goto-char start)
  284.     (let ((regexp (car rest)))
  285.       (while (not (or match (eobp)))
  286.         (if (re-search-forward regexp nil 0)
  287.         (save-excursion
  288.           (beginning-of-line)
  289.           (let ((prefix (buffer-substring (point) (match-end 0))))
  290.             (forward-line 1)
  291.             (if (looking-at (regexp-quote prefix))
  292.             (setq match prefix)))))
  293.         (forward-line 1)))
  294.     (setq rest (cdr rest)))
  295.       match))))
  296.  
  297.  
  298. ;:|
  299. ;:: Hide Quote Routines
  300.  
  301. (defvar gnus-autohide-only-on-followup nil
  302.   "When set to t, the first articles in threads will not be hidden.")
  303.  
  304.  
  305. (defvar gnus-hide-show-first-line t
  306.   "When set to t (default), the first line of a quote is not
  307. hidden, to give some context.")
  308.  
  309. (defvar gnus-hide-place-ellipsis-on-newline t
  310.   "If t, put ellipsis on new line when gnus-hide-show-first-line is nil")
  311.  
  312.  
  313. (defun gnus-Article-is-followup ()
  314.   "Is current article a followup?"
  315.   (string-match "^[Rr][Ee][:\^] "
  316.         (gnus-fetch-field "Subject")))
  317.  
  318. (defun gnus-Article-hide-quote (&optional prefix-string)
  319.   "Hide quotations in current article.
  320. For use with gnus-Article-prepare-hook."
  321.   (if     gnus-hide-autohide-toggle
  322.   (progn
  323.   (setq prefix-string (or prefix-string 
  324.               (and (or (not gnus-autohide-only-on-followup)
  325.                    (gnus-Article-is-followup))
  326.               (gnus-identify-quote-prefix 
  327.                     gnus-hide-hookified-be-aggressive))))
  328.     (if prefix-string
  329.     (progn
  330.       (message "Hiding text beginning with \"%s\"..." prefix-string)
  331.       (save-excursion
  332.         (goto-char (point-min))
  333.         (let ((buffer-read-only nil)
  334.           (quote-regexp (concat "\n*" (regexp-quote prefix-string))))
  335.           (gnus-hide-quote-internal quote-regexp)
  336.           (set-buffer-modified-p nil))
  337.         (setq selective-display t)
  338.         )
  339.         (message "Hiding text beginning with \"%s\"... done." 
  340.          prefix-string))))))
  341.  
  342.  
  343. (defun gnus-Subject-hide-quote (&optional prefix-string)
  344.   "Hide quotations in current article."
  345.   (interactive (list
  346.          (let* ((default (gnus-eval-in-buffer-window 
  347.                    gnus-Article-buffer
  348.                    (gnus-identify-quote-prefix t)))
  349.             (string (if (or current-prefix-arg (not default))
  350.                     (read-from-minibuffer
  351.                       (concat
  352.                     "String that starts quotation lines"
  353.                     (if default
  354.                         (concat " \(default \"" 
  355.                             default "\"\)"))
  356.                     ": "))
  357.                     default)))
  358.            (if (string= "" string)
  359.                (or default (error "You tell me, buckaroo."))
  360.                string))))
  361.   (if (string= prefix-string "") (error "empty string"))
  362.   (let ((gnus-hide-autohide-toggle t))
  363.   (gnus-eval-in-buffer-window gnus-Article-buffer
  364.                   (gnus-Article-hide-quote prefix-string)))
  365. )
  366.  
  367.       
  368. (defun gnus-hide-quote-internal (prefix)
  369.   (let ((search-pattern (concat "\n+" prefix))
  370.     (looking-at-pattern (concat "^" prefix)))
  371.     (save-excursion
  372.       (save-restriction
  373.     (widen)
  374.     (goto-char (point-min))
  375.     (and (search-forward "\n\n" nil t)
  376.          (forward-char -1))
  377.     (while (re-search-forward search-pattern nil t)
  378.       (if gnus-hide-show-first-line
  379.         (forward-line 1)
  380.         (progn 
  381.         (goto-char (match-beginning 0))
  382.         (if gnus-hide-place-ellipsis-on-newline
  383.            (progn (forward-char 1)    ; skip first-newline
  384.              (if (looking-at prefix) ; already
  385.             (insert "\n"))))    ; add a new newline
  386.  
  387.         ; eat up leading newlines
  388.         (while (looking-at "\n")
  389.              (delete-char 1)
  390.              (insert "\^M"))))
  391.  
  392.  
  393.       (while (looking-at prefix)
  394.         (delete-char -1)
  395.         (insert "\^M")
  396.         (forward-line 1)))))))
  397.  
  398.  
  399.  
  400.  
  401. ;:|
  402.  
  403. ;:|
  404.  
  405. ;::         SIGNATURE HIDING FUNCTIONS
  406.  
  407. ;:: Signature Identification
  408.  
  409. (defvar gnus-possible-signature-prefixes
  410.   '(
  411.    "[\n\C-m]--[ \t]*$"          ;; gnus signature type
  412.                  ;; line type (at least 2 fancy chars)
  413.    "[\n\C-m][---=_~\*\$\+\|\^:;\\\/\<]+[---=_~\*\$\+\|\^:;\\\/\<]+[ \t]*$" 
  414.    "[\n\C-m]---"         ;; --- type
  415.    "[\n\C-m]--[A-Za-z ]"     ;; --Name ... type
  416.    "[\n\C-m]-[A-Za-z ]"         ;; -Name ... type
  417.    )
  418.   "Regexps to search for beginning of a signature.
  419.    They are ordered; regexps which are less ambiguous and 
  420.    less likely to produce mismatches should come first. 
  421.    Replace [\n\C-m] for ^ if you wish the sig indicator
  422.    to be shown."
  423. )
  424.  
  425.  
  426. (defvar gnus-hide-sig-aggressively t
  427.   "When set, the last paragraph will be searched 
  428. for an email address. If one is found, assume it is a signature,
  429. and hide it.")
  430.  
  431. (defvar gnus-hide-largest-signature 650
  432.   "The largest size of signature to hide. The larger this number,
  433. the greater the chance that non-signatures will be mistakenly hidden")
  434.  
  435. (defun gnus-find-sig-position ()
  436.   "Move point to start of signature. Moves to point-min if none found."
  437.   (let ((start     (max (progn (goto-char (point-min))
  438.                 (re-search-forward "\n\n" nil t)
  439.                 (point))
  440.              (- (point-max) gnus-hide-largest-signature))))
  441.     (goto-char start)
  442.     (gnus-search-for-sig-start gnus-possible-signature-prefixes start)
  443.      (if (= (point) start)             ; no divider
  444.       (if (not (gnus-last-paragraph-sigp))  ; no addr in last para
  445.           (goto-char (point-min))))
  446.     (point)))
  447.  
  448. (defun gnus-search-for-sig-start (regexp-list start)
  449.    "Loop through gnus-possible-signature-prefixes until 
  450.     a regexp matches or the end of list is found."
  451.     (if regexp-list 
  452.          (if (re-search-forward (car regexp-list) nil t)
  453.                 (goto-char (match-beginning 0))
  454.              (progn (goto-char start)
  455.                  (gnus-search-for-sig-start 
  456.                   (cdr regexp-list) start)))))
  457.  
  458.  
  459. (defun gnus-last-paragraph-point ()
  460.   "Point at start of last paragraph in buffer.
  461. Return nil if a \n\n is not found."
  462.   (save-excursion 
  463.     (goto-char (point-max))
  464.     (re-search-backward "[a-zA-Z]" nil t)    ; skip trailing whitespace
  465.     (if (re-search-backward "\n[\n\t ]*\n" nil t)
  466.         (match-beginning 0)
  467.         nil)))
  468.  
  469. (defun gnus-start-of-article-point ()
  470.  "Point at which article begins."
  471.   (save-excursion 
  472.     (goto-char (point-min))
  473.     (if (re-search-forward "\n\n" nil t)
  474.         (match-beginning 0)
  475.         nil)))
  476.  
  477.  
  478. (defun gnus-last-paragraph-sigp ()
  479.   "Is last paragraph a signature? If so, move point there.
  480. The last paragraph is not considered to be a signature if 
  481. it is the only paragraph in the article."
  482.    (if gnus-hide-sig-aggressively
  483.    (let ((lpp (gnus-last-paragraph-point)))
  484.     (if (not (= lpp (gnus-start-of-article-point)))  ; not only para
  485.     (if lpp  (progn (goto-char lpp) (gnus-address-belowp)))))))
  486.  
  487.  
  488. (defun gnus-address-belowp ()
  489.   "non-nil if there is what looks like an email address below this
  490. point in the buffer (handles internet and uucp addresses)."
  491.   (or    (string-match "[a-zA-Z0-9]+@[---a-zA-Z0-9\.]+[\"\|\)>\n\t ]" ;internet 
  492.        (buffer-substring (point) (point-max)))
  493.     (string-match "\\([a-zA-Z0-9]+\!\\)+[a-zA-Z0-9]+[\n\t ]" ;uucp
  494.        (buffer-substring (point) (point-max)))))
  495.     
  496.  
  497.  
  498. ;:|
  499. ;:: The Signature Hiding Functions
  500.  
  501.  
  502. (defun gnus-Article-hide-sig ()
  503.   "Signature hiding for use with gnus-Article-prepare-hook."
  504.   (if     gnus-hide-autohide-toggle
  505.   (save-excursion
  506.     (let ((buffer-read-only nil))
  507.       (if (not (= 1 (gnus-find-sig-position)))
  508.       (gnus-hide-to-eob))
  509.       (set-buffer-modified-p nil))
  510.     (setq selective-display t))))
  511.  
  512.  
  513. (defun gnus-Subject-hide-sig ()
  514.   "Hide signature."
  515.   (interactive)
  516.   (gnus-eval-in-buffer-window gnus-Article-buffer
  517.     (save-excursion
  518.       (let ((buffer-read-only nil))
  519.     (if (not (= 1 (gnus-find-sig-position)))
  520.         (gnus-hide-to-eob))
  521.         (set-buffer-modified-p nil))
  522.       (setq selective-display t))))
  523.  
  524.  
  525. (defun gnus-hide-to-eob ()
  526.   "Hide all lines to end of buffer."
  527.   (subst-char-in-region (point) (point-max) ?\n ?\C-M))
  528.  
  529.  
  530.  
  531. ;:|
  532.  
  533. ;:|
  534.  
  535. ;::         REFERENCE CLEANING FUNCTIONS
  536.  
  537. (defvar gnus-reference-regexps 
  538.  '(
  539.     "In article \<.*\>.*\("
  540.     "In \<.*\>.*\("
  541.     "On .*T, .*\@.*\("
  542.     "In article \<.*\>.*\n[^>]*\("         ; across 2 lines
  543.     "In \<.*\>.*\n[^>]*\("                  ; "" (no quote > before ()
  544.     "In article \<.*\>[ ,\t\n]*"         ; empty name
  545.     "\>\>\>\>\>.*\n*.*\("                    ; Supercite verbose
  546.     "^[A-Za-z]*\>+[ ]*In.*\("            ; Sc simple    
  547.     "^.*\@.*\(.*\) writes:"            ; no In article.
  548.     "^.*\@.*\(.*\) \/.*\/.* writes:"    ; " In article with date
  549.      )
  550.  "Regexps to match reference lines."
  551. )
  552.  
  553.  
  554. (defun orify-regexp-list (regexps)
  555.  "Convert list of reg expressions to or form."
  556.  (if regexps
  557.  (if (cdr regexps)
  558.     (concat (car regexps) "\\|" (orify-regexp-list (cdr regexps)))
  559.         (car regexps))))
  560.  
  561. (defun gnus-simplify-references ()
  562.   "Create one big or'ed together regexp from a list of regexps."
  563.   (let ((Ref-Regexp (orify-regexp-list gnus-reference-regexps)))
  564.   (goto-char (point-min))
  565.   (while  (re-search-forward Ref-Regexp nil t)
  566.     (gnus-ref-simplify)
  567.     (forward-line 1) 
  568.     (beginning-of-line))))
  569.  
  570.  
  571. (defun gnus-ref-simplify ()
  572.  "Simplify found reference"
  573.  (let    ((MB (match-beginning 0))
  574.      (ME (match-end 0)))
  575.   (goto-char MB)
  576.   (bjk-replace  (if (re-search-forward "^[A-Za-z]*[=:#>]+" ME t)
  577.             (match-end 0)     ; end of quote marker
  578.             MB)
  579.         (if (re-search-forward "(" ME t) 
  580.             (match-beginning 0) 
  581.             ME)            ; can't find a name    
  582.         "")
  583.   ;; hack to get rid of date strings still leftover
  584.   (goto-char MB)
  585.   (if (re-search-forward "\/.*\/" ME t)
  586.       (bjk-replace (match-beginning 0) (match-end 0) ""))
  587.   ;; hack to get rid of newlines in middle of namestring
  588.   (goto-char MB)
  589.   (if (looking-at "([a-zA-Z ]+\n[a-zA-Z ]+)")
  590.     (progn (end-of-line) (delete-char 1) (insert " "))) ))
  591.   
  592.  
  593.  
  594. (defun bjk-replace (Start End String)
  595.  "replace text between Start and End with String"
  596.  (save-excursion
  597.     (delete-region Start End)
  598.     (goto-char  Start)
  599.     (insert String)))
  600.  
  601. (defun gnus-Article-simplify-references ()
  602.  "Simplify all references in current buffer."
  603.  (if gnus-hide-autohide-toggle
  604.  (save-excursion 
  605.   (let ((buffer-read-only nil))
  606.     (gnus-simplify-references)
  607.      (set-buffer-modified-p nil)))))
  608.  
  609.  
  610. (defun gnus-Subject-simplify-references ()
  611.  "Simplify all references in current article."
  612.   (interactive)
  613.   (let ((gnus-hide-autohide-toggle t))    
  614.   (gnus-eval-in-buffer-window gnus-Article-buffer
  615.     (gnus-Article-simplify-references))))
  616.  
  617.  
  618. ;:|
  619.  
  620. ;::         UNHIDE
  621.  
  622.  
  623. (defun gnus-Subject-unhide ()
  624.   "Show signature and quotations in current article."
  625.   (interactive)
  626.   (gnus-eval-in-buffer-window gnus-Article-buffer
  627.       (let ((buffer-read-only nil))
  628.     (subst-char-in-region (point-min) (point-max) ?\C-M ?\n)
  629.     (set-buffer-modified-p nil))))
  630.  
  631.  
  632. (defun gnus-hide-yank-original-unhide ()
  633.  "Unhiding function for use in mail-yank-hooks."
  634.   (let ((buffer-read-only nil))
  635.     (subst-char-in-region (point-min) (point-max) ?\C-M ?\n)
  636.     (set-buffer-modified-p nil)))
  637.  
  638.  
  639. ;:|
  640.  
  641. ;::        TOGGLE
  642. (defvar gnus-hide-autohide-toggle t
  643.  "Only use autohiding functions if t (not nil). This toggle
  644. is changed by the function gnus-hide-autohide-toggle.")
  645.  
  646. (defun gnus-hide-autohide-toggle ()
  647.  "Toggle the autohiding feature. May be useful for 
  648. saving articles that use auto reference simplification."
  649.  (interactive)
  650.  (setq gnus-hide-autohide-toggle (not gnus-hide-autohide-toggle))
  651.  (message (if gnus-hide-autohide-toggle "Autohiding on." "Autohiding off.")))
  652.  
  653.  
  654. ;:|
  655.  
  656. ;::        OVERLOAD FUNCTIONS 
  657. ;;;
  658. ;::    Overload Code 
  659. ;; Code from Barry Warsaw, Supercite 2.2 
  660. ;; (with minor renaming mods for gnus-hide)
  661. ;; ======================================================================
  662. ;; functions which do the overloading
  663. ;; based on code supplied by umerin@tc.nagasaki.go.jp
  664.  
  665. (defvar gnus-hide-overload-functions
  666.   '((mail-yank-original            sc-mail-yank-original) 
  667.     (gnus-Subject-save-in-rmail  gnus-hide-Subject-save-in-rmail)
  668.     (gnus-Subject-save-in-mail      gnus-hide-Subject-save-in-mail)
  669.     (gnus-Subject-save-in-file      gnus-hide-Subject-save-in-file)
  670.     (gnus-Subject-save-in-folder gnus-hide-Subject-save-in-folder)
  671.     )
  672.   "*Functions to be overloaded by gnus-hide.
  673. It is a list of '(original overload)', where original is the original
  674. function symbol, overload is the supercite equivalent function.")
  675.  
  676.  
  677. (defun gnus-hide-overload-functions ()
  678.   "Overload functions defined by the variable gnus-hide-overload-functions.
  679. If the original symbol is not yet bound, it will not be overloaded.
  680. Also, if the symbol has already been overloaded, it will not be
  681. overloaded again."
  682.   (let ((binding nil)
  683.     (overloads gnus-hide-overload-functions))
  684.     (while overloads
  685.       (setq binding (car overloads)
  686.         overloads (cdr overloads))
  687.       (and (fboundp (car binding))
  688.        (not (get (car binding) 'gnus-hide-overloaded))
  689.        (progn
  690.          (fset (car binding) (symbol-function (car (cdr binding))))
  691.          (put (car binding) 'gnus-hide-overloaded 'gnus-hide-overloaded))
  692.        )
  693.       )))
  694.  
  695.  
  696.  
  697. ;:|
  698.  
  699. ;::    Sendmail Overloads 
  700. ;; Code from Barry Warsaw's Supercite 2.2 (with minor mods)
  701. ;; ======================================================================
  702. ;; sendmail.el overload functions. This is the heart of supercite
  703. ;; conformance by packages which rely on distribution emacs elisp. You
  704. ;; should almost always overload this function.
  705.  
  706. (defun sc-mail-yank-original (arg)
  707.   "Supercite version of mail-yank-original.
  708. This function is the workhorse which many packages rely upon to do
  709. citing. It inserts the message being replied to in the reply buffer.
  710. Puts point before the mail headers and mark after body of text.
  711.  
  712. Citation is accomplished by running the hook mail-yank-hooks and is
  713. thus user configurable. Default is to indent each nonblank line ARG
  714. spaces (default 3). Just \\[universal-argument] as argument means
  715. don't indent and don't delete any header fields."
  716.   (interactive "P")
  717.   (if mail-reply-buffer
  718.       (let ((start (point)))
  719.     (delete-windows-on mail-reply-buffer)
  720.     (insert-buffer mail-reply-buffer)
  721.     (if (consp arg)
  722.         nil
  723.       ;; mod 28-Jul-1989 bwarsaw@cen.com
  724.       ;; generalized, hookified citations
  725.       (run-hooks 'mail-yank-hooks))
  726.     (exchange-point-and-mark)
  727.     (if (not (eolp)) (insert ?\n)))))
  728.  
  729. (defvar mail-yank-hooks nil 
  730.   "*Hook to run citation function.
  731. Expects point and mark to be set to the region to cite.")
  732.  
  733.  
  734.  
  735. ;:|
  736.  
  737. ;::    Article Saving Overloads
  738.  
  739.  
  740.  
  741. (defvar gnus-save-article-prepare-hook '(lambda () (gnus-Subject-unhide))
  742.  "Hook to prepare article buffer for saving, (o,C-o)
  743.   eg. undoing things that are done by gnus-article-prepare-hook."
  744. )
  745.  
  746. ;;; The only difference between these and the gnus 3.13 functions
  747. ;;; is the addition of 'gnus-save-article-prepare-hook
  748.  
  749.  
  750. ;:: Rmail Save 
  751. (defun gnus-hide-Subject-save-in-rmail (&optional filename)
  752.   "Append this article to Rmail file.
  753. Optional argument FILENAME specifies file name.
  754. Directory to save to is default to `gnus-article-save-directory' which
  755. is initialized from the SAVEDIR environment variable."
  756.   (interactive)
  757.   (gnus-Subject-select-article
  758.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  759.   (run-hooks 'gnus-save-article-prepare-hook)
  760.   (gnus-eval-in-buffer-window gnus-Article-buffer
  761.     (save-excursion
  762.       (save-restriction
  763.     (widen)
  764.     (let ((default-name
  765.         (funcall gnus-rmail-save-name
  766.              gnus-newsgroup-name
  767.              gnus-current-headers
  768.              gnus-newsgroup-last-rmail
  769.              )))
  770.       (or filename
  771.           (setq filename
  772.             (read-file-name
  773.              (concat "Save article in Rmail file: (default "
  774.                  (file-name-nondirectory default-name)
  775.                  ") ")
  776.              (file-name-directory default-name)
  777.              default-name)))
  778.       (gnus-make-directory (file-name-directory filename))
  779.       (gnus-output-to-rmail filename)
  780.       ;; Remember the directory name to save articles.
  781.       (setq gnus-newsgroup-last-rmail filename)
  782.       )))
  783.     ))
  784.  
  785. ;:|
  786. ;:: Unix Mail Save
  787.  
  788. (defun gnus-Subject-save-in-mail (&optional filename)
  789.   "Append this article to Unix mail file.
  790. Optional argument FILENAME specifies file name.
  791. Directory to save to is default to `gnus-article-save-directory' which
  792. is initialized from the SAVEDIR environment variable."
  793.   (interactive)
  794.   (gnus-Subject-select-article
  795.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  796.   (run-hooks 'gnus-save-article-prepare-hook)
  797.   (gnus-eval-in-buffer-window gnus-Article-buffer
  798.     (save-excursion
  799.       (save-restriction
  800.     (widen)
  801.     (let ((default-name
  802.         (funcall gnus-mail-save-name
  803.              gnus-newsgroup-name
  804.              gnus-current-headers
  805.              gnus-newsgroup-last-mail
  806.              )))
  807.       (or filename
  808.           (setq filename
  809.             (read-file-name
  810.              (concat "Save article in Unix mail file: (default "
  811.                  (file-name-nondirectory default-name)
  812.                  ") ")
  813.              (file-name-directory default-name)
  814.              default-name)))
  815.       (gnus-make-directory (file-name-directory filename))
  816.       (rmail-output filename)
  817.       ;; Remember the directory name to save articles.
  818.       (setq gnus-newsgroup-last-mail filename)
  819.       )))
  820.     ))
  821.  
  822.  
  823. ;:|
  824. ;:: Gnus File Save
  825.  
  826. (defun gnus-hide-Subject-save-in-file (&optional filename)
  827.   "Append this article to file.
  828. Optional argument FILENAME specifies file name.
  829. Directory to save to is default to `gnus-article-save-directory' which
  830. is initialized from the SAVEDIR environment variable."
  831.   (interactive)
  832.   (gnus-Subject-select-article
  833.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  834.   (run-hooks 'gnus-save-article-prepare-hook)
  835.   (gnus-eval-in-buffer-window gnus-Article-buffer
  836.     (save-excursion
  837.       (save-restriction
  838.     (widen)
  839.     (let ((default-name
  840.         (funcall gnus-file-save-name
  841.              gnus-newsgroup-name
  842.              gnus-current-headers
  843.              gnus-newsgroup-last-file
  844.              )))
  845.       (or filename
  846.           (setq filename
  847.             (read-file-name
  848.              (concat "Save article in file: (default "
  849.                  (file-name-nondirectory default-name)
  850.                  ") ")
  851.              (file-name-directory default-name)
  852.              default-name)))
  853.       (gnus-make-directory (file-name-directory filename))
  854.       (gnus-output-to-file filename)
  855.       ;; Remember the directory name to save articles.
  856.       (setq gnus-newsgroup-last-file filename)
  857.       )))
  858.     ))
  859.  
  860. ;:|
  861. ;:: MH Folder Save
  862.  
  863. (defun gnus-hide-Subject-save-in-folder (&optional folder)
  864.   "Save this article to MH folder (using `rcvstore' in MH library).
  865. Optional argument FOLDER specifies folder name."
  866.   (interactive)
  867.   (gnus-Subject-select-article
  868.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  869.   (run-hooks 'gnus-save-article-prepare-hook)
  870.   (gnus-eval-in-buffer-window gnus-Article-buffer
  871.     (save-restriction
  872.       (widen)
  873.       ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
  874.       (mh-find-path)
  875.       (let ((folder
  876.          (or folder
  877.          (mh-prompt-for-folder "Save article in"
  878.                        (funcall gnus-folder-save-name
  879.                         gnus-newsgroup-name
  880.                         gnus-current-headers
  881.                         gnus-newsgroup-last-folder
  882.                         )
  883.                        t
  884.                        )))
  885.         (errbuf (get-buffer-create " *GNUS rcvstore*")))
  886.     (unwind-protect
  887.         (call-process-region (point-min) (point-max)
  888.                  (expand-file-name "rcvstore" mh-lib)
  889.                  nil errbuf nil folder)
  890.       (set-buffer errbuf)
  891.       (if (zerop (buffer-size))
  892.           (message "Article saved in folder: %s" folder)
  893.         (message "%s" (buffer-string)))
  894.       (kill-buffer errbuf)
  895.       (setq gnus-newsgroup-last-folder folder))
  896.     ))
  897.     ))
  898. ;:|
  899. ;:|
  900. ;:|
  901.  
  902. (provide 'gnus-hide)
  903.  
  904. ;:|
  905.