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