home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / gnus / gnus-hide.el < prev    next >
Encoding:
Text File  |  1992-08-04  |  27.4 KB  |  878 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. ;;;
  181. ;;;  Feel free to contact the authors to make suggestions, or bug fixes.
  182. ;;;
  183. ;:|
  184. ;;;    
  185. ;;;--------------------------------------------------------------------
  186. (require 'gnus)
  187.  
  188. ;::        KEY DEFINITIONS
  189.  
  190. (define-key gnus-Subject-mode-map "S"    'gnus-Subject-hide-sig)
  191. (define-key gnus-Subject-mode-map "h"    'gnus-Subject-hide-quote)
  192. (define-key gnus-Subject-mode-map "H"    'gnus-Subject-unhide)
  193. (define-key gnus-Subject-mode-map "\C-c\C-r" 'gnus-Subject-simplify-references)
  194. (define-key gnus-Subject-mode-map "{"    'gnus-Subject-hide-sig)
  195. (define-key gnus-Subject-mode-map "}"    'gnus-Subject-simplify-references)
  196. (define-key gnus-Subject-mode-map "["    'gnus-Subject-hide-quote)
  197. (define-key gnus-Subject-mode-map "]"    'gnus-Subject-unhide)
  198. (define-key gnus-Subject-mode-map "'"      'gnus-hide-autohide-toggle)
  199.  
  200. ;:|
  201.  
  202. ;::         QUOTE HIDING FUNCTIONS
  203.  
  204. ;:: Quote Prefixes
  205.  
  206. (defvar gnus-possible-quote-prefixes
  207.     '("^[^ \t\n\(A-Z#%;]"    ;; first, search for ">", "}", etc.
  208.       "^[ \t]+[^ \t\n\(A-Z#%;]"    ;; then that with leading whitespace.
  209.                 ;; these don't use #%; because of shar files
  210.                       ;; and postscript and lisp code...
  211.       "^[ \t]*[A-Z]+[]}>[{<-]"  ;; then, SuperCite: "FOO> ", "  Yow>", etc.
  212.       )
  213.   "Regexps to search for to identify quoted-text attributions.
  214. These regexps should match the initial subsequence of the line that is the
  215. attribution prefix.  They are ordered; regexps which are less ambiguous and 
  216. less likely to produce mismatches should come first.  The entire buffer will 
  217. be searched for two or more consecutive lines which match the first element 
  218. of this list, then the second, and so on.  The initial subsequence of the 
  219. two lines which first match is returned. Regular quote hiding also
  220. uses gnus-aggressive-quote-prefixes, unlike hookified quote hiding 
  221. which, by default, does not.")
  222.  
  223. (defvar gnus-hide-hookified-be-aggressive nil
  224.   "Variable to determine if hooked calling of gnus-hide-Article-quote
  225. should use aggressive quote prefixes. If set to t, aggressive 
  226. prefixes will be used.
  227. Default: nil")
  228.  
  229.     
  230. (defvar gnus-aggressive-quote-prefixes
  231.     '("^[ \t]+"            ;;  simple indentation
  232.       "^[\(#%;]"        ;; "comment" chars...
  233.      )
  234.  "Regexps for last-resort hiding. By default, these are not 
  235. used in hookified calling (gnus-Article-hide-{quote/sig}).
  236. See gnus-hide-hookified-be-aggressive and gnus-possible-quote-prefixes.")
  237.  
  238.  
  239. (defun gnus-identify-quote-prefix (use-aggressive)
  240.   "Figure out what the current message uses for attribution.  See the
  241. documentation for gnus-possible-quote-prefixes."
  242.   (save-excursion
  243.    (save-restriction
  244.     (gnus-find-sig-position)
  245.     (if (not (= (point) (point-min)))
  246.     (narrow-to-region (point-min) (point)))
  247.     (goto-char (point-min))
  248.     (search-forward "\n\n" nil t)
  249.     (let ((match nil)
  250.       (start (point))
  251.       (rest (if use-aggressive 
  252.             (append gnus-possible-quote-prefixes
  253.                 gnus-aggressive-quote-prefixes)
  254.             gnus-possible-quote-prefixes)))
  255.       (while (and rest (not match))
  256.     (goto-char start)
  257.     (let ((regexp (car rest)))
  258.       (while (not (or match (eobp)))
  259.         (if (re-search-forward regexp nil 0)
  260.         (save-excursion
  261.           (beginning-of-line)
  262.           (let ((prefix (buffer-substring (point) (match-end 0))))
  263.             (forward-line 1)
  264.             (if (looking-at (regexp-quote prefix))
  265.             (setq match prefix)))))
  266.         (forward-line 1)))
  267.     (setq rest (cdr rest)))
  268.       match))))
  269.  
  270.  
  271. ;:|
  272. ;:: Hide Quote Routines
  273.  
  274. (defvar gnus-autohide-only-on-followup nil
  275.   "When set to t, the first articles in threads will not be hidden.")
  276.  
  277.  
  278. (defvar gnus-hide-show-first-line t
  279.   "When set to t (default), the first line of a quote is not
  280. hidden, to give some context.")
  281.  
  282. (defvar gnus-hide-place-ellipsis-on-newline t
  283.   "If t, put ellipsis on new line when gnus-hide-show-first-line is nil")
  284.  
  285.  
  286. (defun gnus-Article-is-followupp ()
  287.   "Is current article a followup?"
  288.   (string-match "^[Rr][Ee][:\^] "
  289.         (gnus-fetch-field "Subject")))
  290.  
  291. (defun gnus-Article-hide-quote (&optional prefix-string)
  292.   "Hide quotations in current article.
  293. For use with gnus-Article-prepare-hook."
  294.   (if     gnus-hide-autohide-toggle
  295.   (progn
  296.   (setq prefix-string (or prefix-string 
  297.               (and (or (not gnus-autohide-only-on-followup)
  298.                    (gnus-Article-is-followup))
  299.               (gnus-identify-quote-prefix 
  300.                     gnus-hide-hookified-be-aggressive))))
  301.     (if prefix-string
  302.     (progn
  303.       (message "Hiding text beginning with \"%s\"..." prefix-string)
  304.       (save-excursion
  305.         (goto-char (point-min))
  306.         (let ((buffer-read-only nil)
  307.           (quote-regexp (concat "\n*" (regexp-quote prefix-string))))
  308.           (gnus-hide-quote-internal quote-regexp)
  309.           (set-buffer-modified-p nil))
  310.         (setq selective-display t)
  311.         )
  312.         (message "Hiding text beginning with \"%s\"... done." 
  313.          prefix-string))))))
  314.  
  315.  
  316. (defun gnus-Subject-hide-quote (&optional prefix-string)
  317.   "Hide quotations in current article."
  318.   (interactive (list
  319.          (let* ((default (gnus-eval-in-buffer-window 
  320.                    gnus-Article-buffer
  321.                    (gnus-identify-quote-prefix t)))
  322.             (string (if (or current-prefix-arg (not default))
  323.                     (read-from-minibuffer
  324.                       (concat
  325.                     "String that starts quotation lines"
  326.                     (if default
  327.                         (concat " \(default \"" 
  328.                             default "\"\)"))
  329.                     ": "))
  330.                     default)))
  331.            (if (string= "" string)
  332.                (or default (error "You tell me, buckaroo."))
  333.                string))))
  334.   (if (string= prefix-string "") (error "empty string"))
  335.   (let ((gnus-hide-autohide-toggle t))
  336.   (gnus-eval-in-buffer-window gnus-Article-buffer
  337.                   (gnus-Article-hide-quote prefix-string)))
  338. )
  339.  
  340.       
  341. (defun gnus-hide-quote-internal (prefix)
  342.   (let ((search-pattern (concat "\n+" prefix))
  343.     (looking-at-pattern (concat "^" prefix)))
  344.     (save-excursion
  345.       (save-restriction
  346.     (widen)
  347.     (goto-char (point-min))
  348.     (and (search-forward "\n\n" nil t)
  349.          (forward-char -1))
  350.     (while (re-search-forward search-pattern nil t)
  351.       (if gnus-hide-show-first-line
  352.         (forward-line 1)
  353.         (progn 
  354.         (goto-char (match-beginning 0))
  355.         (if gnus-hide-place-ellipsis-on-newline
  356.            (progn (forward-char 1)    ; skip first-newline
  357.              (if (looking-at prefix) ; already
  358.             (insert "\n"))))    ; add a new newline
  359.  
  360.         ; eat up leading newlines
  361.         (while (looking-at "\n")
  362.              (delete-char 1)
  363.              (insert "\^M"))))
  364.  
  365.  
  366.       (while (looking-at prefix)
  367.         (delete-char -1)
  368.         (insert "\^M")
  369.         (forward-line 1)))))))
  370.  
  371.  
  372.  
  373.  
  374. ;:|
  375.  
  376. ;:|
  377.  
  378. ;::         SIGNATURE HIDING FUNCTIONS
  379.  
  380. ;:: Signature Identification
  381.  
  382. (defvar gnus-possible-signature-prefixes
  383.   '(
  384.    "[\n\C-m]--[ \t]*$"          ;; gnus signature type
  385.                  ;; line type (at least 2 fancy chars)
  386.    "[\n\C-m][---=_~\*\$\+\|\^:;\\\/\<]+[---=_~\*\$\+\|\^:;\\\/\<]+[ \t]*$" 
  387.    "[\n\C-m]---"         ;; --- type
  388.    "[\n\C-m]--[A-Za-z ]"     ;; --Name ... type
  389.    "[\n\C-m]-[A-Za-z ]"         ;; -Name ... type
  390.    )
  391.   "Regexps to search for beginning of a signature.
  392.    They are ordered; regexps which are less ambiguous and 
  393.    less likely to produce mismatches should come first. 
  394.    Replace [\n\C-m] for ^ if you wish the sig indicator
  395.    to be shown."
  396. )
  397.  
  398.  
  399. (defvar gnus-hide-sig-aggressively t
  400.   "When set, the last paragraph will be searched 
  401. for an email address. If one is found, assume it is a signature,
  402. and hide it.")
  403.  
  404. (defvar gnus-hide-largest-signature 650
  405.   "The largest size of signature to hide. The larger this number,
  406. the greater the chance that non-signatures will be mistakenly hidden")
  407.  
  408. (defun gnus-find-sig-position ()
  409.   "Move point to start of signature. Moves to point-min if none found."
  410.   (let ((start     (max (progn (goto-char (point-min))
  411.                 (re-search-forward "\n\n" nil t)
  412.                 (point))
  413.              (- (point-max) gnus-hide-largest-signature))))
  414.     (goto-char start)
  415.     (gnus-search-for-sig-start gnus-possible-signature-prefixes start)
  416.      (if (= (point) start)             ; no divider
  417.       (if (not (gnus-last-paragraph-sigp))  ; no addr in last para
  418.           (goto-char (point-min))))
  419.     (point)))
  420.  
  421. (defun gnus-search-for-sig-start (regexp-list start)
  422.    "Loop through gnus-possible-signature-prefixes until 
  423.     a regexp matches or the end of list is found."
  424.     (if regexp-list 
  425.          (if (re-search-forward (car regexp-list) nil t)
  426.                 (goto-char (match-beginning 0))
  427.              (progn (goto-char start)
  428.                  (gnus-search-for-sig-start 
  429.                   (cdr regexp-list) start)))))
  430.  
  431.  
  432. (defun gnus-last-paragraph-point ()
  433.   "Point at start of last paragraph in buffer.
  434. Return nil if a \n\n is not found."
  435.   (save-excursion 
  436.     (goto-char (point-max))
  437.     (re-search-backward "[a-zA-Z]" nil t)    ; skip trailing whitespace
  438.     (if (re-search-backward "\n[\n\t ]*\n" nil t)
  439.         (match-beginning 0)
  440.         nil)))
  441.  
  442. (defun gnus-start-of-article-point ()
  443.  "Point at which article begins."
  444.   (save-excursion 
  445.     (goto-char (point-min))
  446.     (if (re-search-forward "\n\n" nil t)
  447.         (match-beginning 0)
  448.         nil)))
  449.  
  450.  
  451. (defun gnus-last-paragraph-sigp ()
  452.   "Is last paragraph a signature? If so, move point there.
  453. The last paragraph is not considered to be a signature if 
  454. it is the only paragraph in the article."
  455.    (if gnus-hide-sig-aggressively
  456.    (let ((lpp (gnus-last-paragraph-point)))
  457.     (if (not (= lpp (gnus-start-of-article-point)))  ; not only para
  458.     (if lpp  (progn (goto-char lpp) (gnus-address-belowp)))))))
  459.  
  460.  
  461. (defun gnus-address-belowp ()
  462.   "non-nil if there is what looks like an email address below this
  463. point in the buffer (handles internet and uucp addresses)."
  464.   (or    (string-match "[a-zA-Z0-9]+@[---a-zA-Z0-9\.]+[\"\|\)>\n\t ]" ;internet 
  465.        (buffer-substring (point) (point-max)))
  466.     (string-match "\\([a-zA-Z0-9]+\!\\)+[a-zA-Z0-9]+[\n\t ]" ;uucp
  467.        (buffer-substring (point) (point-max)))))
  468.     
  469.  
  470.  
  471. ;:|
  472. ;:: The Signature Hiding Functions
  473.  
  474.  
  475. (defun gnus-Article-hide-sig ()
  476.   "Signature hiding for use with gnus-Article-prepare-hook."
  477.   (if     gnus-hide-autohide-toggle
  478.   (save-excursion
  479.     (let ((buffer-read-only nil))
  480.       (if (not (= 1 (gnus-find-sig-position)))
  481.       (gnus-hide-to-eob))
  482.       (set-buffer-modified-p nil))
  483.     (setq selective-display t))))
  484.  
  485.  
  486. (defun gnus-Subject-hide-sig ()
  487.   "Hide signature."
  488.   (interactive)
  489.   (gnus-eval-in-buffer-window gnus-Article-buffer
  490.     (save-excursion
  491.       (let ((buffer-read-only nil))
  492.     (if (not (= 1 (gnus-find-sig-position)))
  493.         (gnus-hide-to-eob))
  494.         (set-buffer-modified-p nil))
  495.       (setq selective-display t))))
  496.  
  497.  
  498. (defun gnus-hide-to-eob ()
  499.   "Hide all lines to end of buffer."
  500.   (subst-char-in-region (point) (point-max) ?\n ?\C-M))
  501.  
  502.  
  503.  
  504. ;:|
  505.  
  506. ;:|
  507.  
  508. ;::         REFERENCE CLEANING FUNCTIONS
  509.  
  510. (defvar gnus-reference-regexps 
  511.  '(
  512.     "In article \<.*\>.*\("
  513.     "In \<.*\>.*\("
  514.     "On .*T, .*\@.*\("
  515.     "In article \<.*\>.*\n[^>]*\("         ; across 2 lines
  516.     "In \<.*\>.*\n[^>]*\("                  ; "" (no quote > before ()
  517.     "In article \<.*\>[ ,\t\n]*"         ; empty name
  518.     "\>\>\>\>\>.*\n*.*\("                    ; Supercite verbose
  519.     "^[A-Za-z]*\>+[ ]*In.*\("            ; Sc simple    
  520.     "^.*\@.*\(.*\) writes:"            ; no In article.
  521.     "^.*\@.*\(.*\) \/.*\/.* writes:"    ; " In article with date
  522.      )
  523.  "Regexps to match reference lines."
  524. )
  525.  
  526.  
  527. (defun orify-regexp-list (regexps)
  528.  "Convert list of reg expressions to or form."
  529.  (if regexps
  530.  (if (cdr regexps)
  531.     (concat (car regexps) "\\|" (orify-regexp-list (cdr regexps)))
  532.         (car regexps))))
  533.  
  534. (defun gnus-simplify-references ()
  535.   "Create one big or'ed together regexp from a list of regexps."
  536.   (let ((Ref-Regexp (orify-regexp-list gnus-reference-regexps)))
  537.   (goto-char (point-min))
  538.   (while  (re-search-forward Ref-Regexp nil t)
  539.     (gnus-ref-simplify)
  540.     (forward-line 1) 
  541.     (beginning-of-line))))
  542.  
  543.  
  544. (defun gnus-ref-simplify ()
  545.  "Simplify found reference"
  546.  (let    ((MB (match-beginning 0))
  547.      (ME (match-end 0)))
  548.   (goto-char MB)
  549.   (bjk-replace  (if (re-search-forward "^[A-Za-z]*[=:#>]+" ME t)
  550.             (match-end 0)     ; end of quote marker
  551.             MB)
  552.         (if (re-search-forward "(" ME t) 
  553.             (match-beginning 0) 
  554.             ME)            ; can't find a name    
  555.         "")
  556.   ;; hack to get rid of date strings still leftover
  557.   (goto-char MB)
  558.   (if (re-search-forward "\/.*\/" ME t)
  559.       (bjk-replace (match-beginning 0) (match-end 0) ""))
  560.   ;; hack to get rid of newlines in middle of namestring
  561.   (goto-char MB)
  562.   (if (looking-at "([a-zA-Z ]+\n[a-zA-Z ]+)")
  563.     (progn (end-of-line) (delete-char 1) (insert " "))) ))
  564.   
  565.  
  566.  
  567. (defun bjk-replace (Start End String)
  568.  "replace text between Start and End with String"
  569.  (save-excursion
  570.     (delete-region Start End)
  571.     (goto-char  Start)
  572.     (insert String)))
  573.  
  574. (defun gnus-Article-simplify-references ()
  575.  "Simplify all references in current buffer."
  576.  (if gnus-hide-autohide-toggle
  577.  (save-excursion 
  578.   (let ((buffer-read-only nil))
  579.     (gnus-simplify-references)
  580.      (set-buffer-modified-p nil)))))
  581.  
  582.  
  583. (defun gnus-Subject-simplify-references ()
  584.  "Simplify all references in current article."
  585.   (interactive)
  586.   (let ((gnus-hide-autohide-toggle t))    
  587.   (gnus-eval-in-buffer-window gnus-Article-buffer
  588.     (gnus-Article-simplify-references))))
  589.  
  590.  
  591. ;:|
  592.  
  593. ;::         UNHIDE
  594.  
  595.  
  596. (defun gnus-Subject-unhide ()
  597.   "Show signature and quotations in current article."
  598.   (interactive)
  599.   (gnus-eval-in-buffer-window gnus-Article-buffer
  600.       (let ((buffer-read-only nil))
  601.     (subst-char-in-region (point-min) (point-max) ?\C-M ?\n)
  602.     (set-buffer-modified-p nil))))
  603.  
  604.  
  605. (defun gnus-hide-yank-original-unhide ()
  606.  "Unhiding function for use in mail-yank-hooks."
  607.   (let ((buffer-read-only nil))
  608.     (subst-char-in-region (point-min) (point-max) ?\C-M ?\n)
  609.     (set-buffer-modified-p nil)))
  610.  
  611.  
  612. ;:|
  613.  
  614. ;::        TOGGLE
  615. (defvar gnus-hide-autohide-toggle t
  616.  "Only use autohiding functions if t (not nil). This toggle
  617. is changed by the function gnus-hide-autohide-toggle.")
  618.  
  619. (defun gnus-hide-autohide-toggle ()
  620.  "Toggle the autohiding feature. May be useful for 
  621. saving articles that use auto reference simplification."
  622.  (interactive)
  623.  (setq gnus-hide-autohide-toggle (not gnus-hide-autohide-toggle))
  624.  (message (if gnus-hide-autohide-toggle "Autohiding on." "Autohiding off.")))
  625.  
  626.  
  627. ;:|
  628.  
  629. ;::        OVERLOAD FUNCTIONS 
  630. ;;;
  631. ;::    Overload Code 
  632. ;; Code from Barry Warsaw, Supercite 2.2 
  633. ;; (with minor renaming mods for gnus-hide)
  634. ;; ======================================================================
  635. ;; functions which do the overloading
  636. ;; based on code supplied by umerin@tc.nagasaki.go.jp
  637.  
  638. (defvar gnus-hide-overload-functions
  639.   '((mail-yank-original            sc-mail-yank-original) 
  640.     (gnus-Subject-save-in-rmail  gnus-hide-Subject-save-in-rmail)
  641.     (gnus-Subject-save-in-mail      gnus-hide-Subject-save-in-mail)
  642.     (gnus-Subject-save-in-file      gnus-hide-Subject-save-in-file)
  643.     (gnus-Subject-save-in-folder gnus-hide-Subject-save-in-folder)
  644.     )
  645.   "*Functions to be overloaded by gnus-hide.
  646. It is a list of '(original overload)', where original is the original
  647. function symbol, overload is the supercite equivalent function.")
  648.  
  649.  
  650. (defun gnus-hide-overload-functions ()
  651.   "Overload functions defined by the variable gnus-hide-overload-functions.
  652. If the original symbol is not yet bound, it will not be overloaded.
  653. Also, if the symbol has already been overloaded, it will not be
  654. overloaded again."
  655.   (let ((binding nil)
  656.     (overloads gnus-hide-overload-functions))
  657.     (while overloads
  658.       (setq binding (car overloads)
  659.         overloads (cdr overloads))
  660.       (and (fboundp (car binding))
  661.        (not (get (car binding) 'gnus-hide-overloaded))
  662.        (progn
  663.          (fset (car binding) (symbol-function (car (cdr binding))))
  664.          (put (car binding) 'gnus-hide-overloaded 'gnus-hide-overloaded))
  665.        )
  666.       )))
  667.  
  668.  
  669.  
  670. ;:|
  671.  
  672. ;::    Sendmail Overloads 
  673. ;; Code from Barry Warsaw's Supercite 2.2 (with minor mods)
  674. ;; ======================================================================
  675. ;; sendmail.el overload functions. This is the heart of supercite
  676. ;; conformance by packages which rely on distribution emacs elisp. You
  677. ;; should almost always overload this function.
  678.  
  679. (defun sc-mail-yank-original (arg)
  680.   "Supercite version of mail-yank-original.
  681. This function is the workhorse which many packages rely upon to do
  682. citing. It inserts the message being replied to in the reply buffer.
  683. Puts point before the mail headers and mark after body of text.
  684.  
  685. Citation is accomplished by running the hook mail-yank-hooks and is
  686. thus user configurable. Default is to indent each nonblank line ARG
  687. spaces (default 3). Just \\[universal-argument] as argument means
  688. don't indent and don't delete any header fields."
  689.   (interactive "P")
  690.   (if mail-reply-buffer
  691.       (let ((start (point)))
  692.     (delete-windows-on mail-reply-buffer)
  693.     (insert-buffer mail-reply-buffer)
  694.     (if (consp arg)
  695.         nil
  696.       ;; mod 28-Jul-1989 bwarsaw@cen.com
  697.       ;; generalized, hookified citations
  698.       (run-hooks 'mail-yank-hooks))
  699.     (exchange-point-and-mark)
  700.     (if (not (eolp)) (insert ?\n)))))
  701.  
  702. (defvar mail-yank-hooks nil 
  703.   "*Hook to run citation function.
  704. Expects point and mark to be set to the region to cite.")
  705.  
  706.  
  707.  
  708. ;:|
  709.  
  710. ;::    Article Saving Overloads
  711.  
  712.  
  713.  
  714. (defvar gnus-save-article-prepare-hook '(lambda () (gnus-Subject-unhide))
  715.  "Hook to prepare article buffer for saving, (o,C-o)
  716.   eg. undoing things that are done by gnus-article-prepare-hook."
  717. )
  718.  
  719. ;;; The only difference between these and the gnus 3.13 functions
  720. ;;; is the addition of 'gnus-save-article-prepare-hook
  721.  
  722.  
  723. ;:: Rmail Save 
  724. (defun gnus-hide-Subject-save-in-rmail (&optional filename)
  725.   "Append this article to Rmail file.
  726. Optional argument FILENAME specifies file name.
  727. Directory to save to is default to `gnus-article-save-directory' which
  728. is initialized from the SAVEDIR environment variable."
  729.   (interactive)
  730.   (gnus-Subject-select-article
  731.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  732.   (run-hooks 'gnus-save-article-prepare-hook)
  733.   (gnus-eval-in-buffer-window gnus-Article-buffer
  734.     (save-excursion
  735.       (save-restriction
  736.     (widen)
  737.     (let ((default-name
  738.         (funcall gnus-rmail-save-name
  739.              gnus-newsgroup-name
  740.              gnus-current-headers
  741.              gnus-newsgroup-last-rmail
  742.              )))
  743.       (or filename
  744.           (setq filename
  745.             (read-file-name
  746.              (concat "Save article in Rmail file: (default "
  747.                  (file-name-nondirectory default-name)
  748.                  ") ")
  749.              (file-name-directory default-name)
  750.              default-name)))
  751.       (gnus-make-directory (file-name-directory filename))
  752.       (gnus-output-to-rmail filename)
  753.       ;; Remember the directory name to save articles.
  754.       (setq gnus-newsgroup-last-rmail filename)
  755.       )))
  756.     ))
  757.  
  758. ;:|
  759. ;:: Unix Mail Save
  760.  
  761. (defun gnus-Subject-save-in-mail (&optional filename)
  762.   "Append this article to Unix mail file.
  763. Optional argument FILENAME specifies file name.
  764. Directory to save to is default to `gnus-article-save-directory' which
  765. is initialized from the SAVEDIR environment variable."
  766.   (interactive)
  767.   (gnus-Subject-select-article
  768.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  769.   (run-hooks 'gnus-save-article-prepare-hook)
  770.   (gnus-eval-in-buffer-window gnus-Article-buffer
  771.     (save-excursion
  772.       (save-restriction
  773.     (widen)
  774.     (let ((default-name
  775.         (funcall gnus-mail-save-name
  776.              gnus-newsgroup-name
  777.              gnus-current-headers
  778.              gnus-newsgroup-last-mail
  779.              )))
  780.       (or filename
  781.           (setq filename
  782.             (read-file-name
  783.              (concat "Save article in Unix mail file: (default "
  784.                  (file-name-nondirectory default-name)
  785.                  ") ")
  786.              (file-name-directory default-name)
  787.              default-name)))
  788.       (gnus-make-directory (file-name-directory filename))
  789.       (rmail-output filename)
  790.       ;; Remember the directory name to save articles.
  791.       (setq gnus-newsgroup-last-mail filename)
  792.       )))
  793.     ))
  794.  
  795.  
  796. ;:|
  797. ;:: Gnus File Save
  798.  
  799. (defun gnus-hide-Subject-save-in-file (&optional filename)
  800.   "Append this article to file.
  801. Optional argument FILENAME specifies file name.
  802. Directory to save to is default to `gnus-article-save-directory' which
  803. is initialized from the SAVEDIR environment variable."
  804.   (interactive)
  805.   (gnus-Subject-select-article
  806.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  807.   (run-hooks 'gnus-save-article-prepare-hook)
  808.   (gnus-eval-in-buffer-window gnus-Article-buffer
  809.     (save-excursion
  810.       (save-restriction
  811.     (widen)
  812.     (let ((default-name
  813.         (funcall gnus-file-save-name
  814.              gnus-newsgroup-name
  815.              gnus-current-headers
  816.              gnus-newsgroup-last-file
  817.              )))
  818.       (or filename
  819.           (setq filename
  820.             (read-file-name
  821.              (concat "Save article in file: (default "
  822.                  (file-name-nondirectory default-name)
  823.                  ") ")
  824.              (file-name-directory default-name)
  825.              default-name)))
  826.       (gnus-make-directory (file-name-directory filename))
  827.       (gnus-output-to-file filename)
  828.       ;; Remember the directory name to save articles.
  829.       (setq gnus-newsgroup-last-file filename)
  830.       )))
  831.     ))
  832.  
  833. ;:|
  834. ;:: MH Folder Save
  835.  
  836. (defun gnus-hide-Subject-save-in-folder (&optional folder)
  837.   "Save this article to MH folder (using `rcvstore' in MH library).
  838. Optional argument FOLDER specifies folder name."
  839.   (interactive)
  840.   (gnus-Subject-select-article
  841.    (not (null gnus-save-all-headers)) gnus-save-all-headers)
  842.   (run-hooks 'gnus-save-article-prepare-hook)
  843.   (gnus-eval-in-buffer-window gnus-Article-buffer
  844.     (save-restriction
  845.       (widen)
  846.       ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
  847.       (mh-find-path)
  848.       (let ((folder
  849.          (or folder
  850.          (mh-prompt-for-folder "Save article in"
  851.                        (funcall gnus-folder-save-name
  852.                         gnus-newsgroup-name
  853.                         gnus-current-headers
  854.                         gnus-newsgroup-last-folder
  855.                         )
  856.                        t
  857.                        )))
  858.         (errbuf (get-buffer-create " *GNUS rcvstore*")))
  859.     (unwind-protect
  860.         (call-process-region (point-min) (point-max)
  861.                  (expand-file-name "rcvstore" mh-lib)
  862.                  nil errbuf nil folder)
  863.       (set-buffer errbuf)
  864.       (if (zerop (buffer-size))
  865.           (message "Article saved in folder: %s" folder)
  866.         (message "%s" (buffer-string)))
  867.       (kill-buffer errbuf)
  868.       (setq gnus-newsgroup-last-folder folder))
  869.     ))
  870.     ))
  871. ;:|
  872. ;:|
  873. ;:|
  874.  
  875. (provide 'gnus-hide)
  876.  
  877. ;:|
  878.