/[emacs]/emacs/lisp/gnus/gnus-cite.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-cite.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9.2.2 by miles, Tue Oct 14 23:34:50 2003 UTC revision 1.9.2.3 by miles, Thu Sep 16 00:12:15 2004 UTC
# Line 1  Line 1 
1  ;;; gnus-cite.el --- parse citations in articles for Gnus  -*- coding: iso-latin-1 -*-  ;;; gnus-cite.el --- parse citations in articles for Gnus
2    
3  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002  ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
4  ;;        Free Software Foundation, Inc.  ;;        Free Software Foundation, Inc.
5    
6  ;; Author: Per Abhiddenware  ;; Author: Per Abhiddenware
# Line 29  Line 29 
29  (eval-when-compile (require 'cl))  (eval-when-compile (require 'cl))
30    
31  (require 'gnus)  (require 'gnus)
 (require 'gnus-art)  
32  (require 'gnus-range)  (require 'gnus-range)
33    (require 'gnus-art)
34    (require 'message)      ; for message-cite-prefix-regexp
35    
36  ;;; Customization:  ;;; Customization:
37    
# Line 40  Line 41 
41    :link '(custom-manual "(gnus)Article Highlighting")    :link '(custom-manual "(gnus)Article Highlighting")
42    :group 'gnus-article)    :group 'gnus-article)
43    
 (defcustom gnus-cite-reply-regexp  
   "^\\(Subject: Re\\|In-Reply-To\\|References\\):"  
   "*If headers match this regexp it is reasonable to believe that  
 article has citations."  
   :group 'gnus-cite  
   :type 'string)  
   
 (defcustom gnus-cite-always-check nil  
   "Check article always for citations.  Set it t to check all articles."  
   :group 'gnus-cite  
   :type '(choice (const :tag "no" nil)  
                  (const :tag "yes" t)))  
   
44  (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"  (defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
45    "Format of opened cited text buttons."    "Format of opened cited text buttons."
46    :group 'gnus-cite    :group 'gnus-cite
# Line 79  Set it to nil to parse all articles." Line 67  Set it to nil to parse all articles."
67    :type '(choice (const :tag "all" nil)    :type '(choice (const :tag "all" nil)
68                   integer))                   integer))
69    
 (defcustom gnus-cite-prefix-regexp  
   ;; The Latin-1 angle quote looks pretty dubious.  -- fx  
   "^[]>»|:}+ ]*[]>»|:}+]\\(.*>»\\)?\\|^.*>"  
   "*Regexp matching the longest possible citation prefix on a line."  
   :group 'gnus-cite  
   :type 'regexp)  
   
70  (defcustom gnus-cite-max-prefix 20  (defcustom gnus-cite-max-prefix 20
71    "Maximum possible length for a citation prefix."    "Maximum possible length for a citation prefix."
72    :group 'gnus-cite    :group 'gnus-cite
73    :type 'integer)    :type 'integer)
74    
75  (defcustom gnus-supercite-regexp  (defcustom gnus-supercite-regexp
76    (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"    (concat "^\\(" message-cite-prefix-regexp "\\)? *"
77            ">>>>> +\"\\([^\"\n]+\\)\" +==")            ">>>>> +\"\\([^\"\n]+\\)\" +==")
78    "*Regexp matching normal Supercite attribution lines.    "*Regexp matching normal Supercite attribution lines.
79  The first grouping must match prefixes added by other packages."  The first grouping must match prefixes added by other packages."
# Line 110  The first regexp group should match the Line 91  The first regexp group should match the
91    :group 'gnus-cite    :group 'gnus-cite
92    :type 'integer)    :type 'integer)
93    
94    ;; Some Microsoft products put in a citation that extends to the
95    ;; remainder of the message:
96    ;;
97    ;;     -----Original Message-----
98    ;;     From: ...
99    ;;     To: ...
100    ;;     Sent: ...   [date, in non-RFC-2822 format]
101    ;;     Subject: ...
102    ;;
103    ;;     Cited message, with no prefixes
104    ;;
105    ;; The four headers are always the same.  But note they are prone to
106    ;; folding without additional indentation.
107    ;;
108    ;; Others use "----- Original Message -----" instead, and properly quote
109    ;; the body using "> ".  This style is handled without special cases.
110    
111  (defcustom gnus-cite-attribution-prefix  (defcustom gnus-cite-attribution-prefix
112    "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----"    "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
113    "*Regexp matching the beginning of an attribution line."    "*Regexp matching the beginning of an attribution line."
114    :group 'gnus-cite    :group 'gnus-cite
115    :type 'regexp)    :type 'regexp)
116    
117  (defcustom gnus-cite-attribution-suffix  (defcustom gnus-cite-attribution-suffix
118    "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$"    "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$"
119    "*Regexp matching the end of an attribution line.    "*Regexp matching the end of an attribution line.
120  The text matching the first grouping will be used as a button."  The text matching the first grouping will be used as a button."
121    :group 'gnus-cite    :group 'gnus-cite
122    :type 'regexp)    :type 'regexp)
123    
124    (defcustom gnus-cite-unsightly-citation-regexp
125      "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
126      "Regexp matching Microsoft-type rest-of-message citations."
127      :group 'gnus-cite
128      :type 'regexp)
129    
130    (defcustom gnus-cite-ignore-quoted-from t
131      "Non-nil means don't regard lines beginning with \">From \" as cited text.
132    Those lines may have been quoted by MTAs in order not to mix up with
133    the envelope From line."
134      :group 'gnus-cite
135      :type 'boolean)
136    
137  (defface gnus-cite-attribution-face '((t  (defface gnus-cite-attribution-face '((t
138                                         (:slant italic)))                                         (:italic t)))
139    "Face used for attribution lines.")    "Face used for attribution lines.")
140    
141  (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face  (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face
# Line 140  It is merged with the face for the cited Line 151  It is merged with the face for the cited
151                                (background light))                                (background light))
152                               (:foreground "MidnightBlue"))                               (:foreground "MidnightBlue"))
153                              (t                              (t
154                               (:slant italic)))                               (:italic t)))
155    "Citation face.")    "Citation face.")
156    
157  (defface gnus-cite-face-2 '((((class color)  (defface gnus-cite-face-2 '((((class color)
# Line 150  It is merged with the face for the cited Line 161  It is merged with the face for the cited
161                                (background light))                                (background light))
162                               (:foreground "firebrick"))                               (:foreground "firebrick"))
163                              (t                              (t
164                               (:slant italic)))                               (:italic t)))
165    "Citation face.")    "Citation face.")
166    
167  (defface gnus-cite-face-3 '((((class color)  (defface gnus-cite-face-3 '((((class color)
# Line 160  It is merged with the face for the cited Line 171  It is merged with the face for the cited
171                                (background light))                                (background light))
172                               (:foreground "dark green"))                               (:foreground "dark green"))
173                              (t                              (t
174                               (:slant italic)))                               (:italic t)))
175    "Citation face.")    "Citation face.")
176    
177  (defface gnus-cite-face-4 '((((class color)  (defface gnus-cite-face-4 '((((class color)
# Line 170  It is merged with the face for the cited Line 181  It is merged with the face for the cited
181                                (background light))                                (background light))
182                               (:foreground "OrangeRed"))                               (:foreground "OrangeRed"))
183                              (t                              (t
184                               (:slant italic)))                               (:italic t)))
185    "Citation face.")    "Citation face.")
186    
187  (defface gnus-cite-face-5 '((((class color)  (defface gnus-cite-face-5 '((((class color)
# Line 180  It is merged with the face for the cited Line 191  It is merged with the face for the cited
191                                (background light))                                (background light))
192                               (:foreground "dark khaki"))                               (:foreground "dark khaki"))
193                              (t                              (t
194                               (:slant italic)))                               (:italic t)))
195    "Citation face.")    "Citation face.")
196    
197  (defface gnus-cite-face-6 '((((class color)  (defface gnus-cite-face-6 '((((class color)
# Line 190  It is merged with the face for the cited Line 201  It is merged with the face for the cited
201                                (background light))                                (background light))
202                               (:foreground "dark violet"))                               (:foreground "dark violet"))
203                              (t                              (t
204                               (:slant italic)))                               (:italic t)))
205    "Citation face.")    "Citation face.")
206    
207  (defface gnus-cite-face-7 '((((class color)  (defface gnus-cite-face-7 '((((class color)
# Line 200  It is merged with the face for the cited Line 211  It is merged with the face for the cited
211                                (background light))                                (background light))
212                               (:foreground "SteelBlue4"))                               (:foreground "SteelBlue4"))
213                              (t                              (t
214                               (:slant italic)))                               (:italic t)))
215    "Citation face.")    "Citation face.")
216    
217  (defface gnus-cite-face-8 '((((class color)  (defface gnus-cite-face-8 '((((class color)
# Line 210  It is merged with the face for the cited Line 221  It is merged with the face for the cited
221                                (background light))                                (background light))
222                               (:foreground "magenta"))                               (:foreground "magenta"))
223                              (t                              (t
224                               (:slant italic)))                               (:italic t)))
225    "Citation face.")    "Citation face.")
226    
227  (defface gnus-cite-face-9 '((((class color)  (defface gnus-cite-face-9 '((((class color)
# Line 220  It is merged with the face for the cited Line 231  It is merged with the face for the cited
231                                (background light))                                (background light))
232                               (:foreground "violet"))                               (:foreground "violet"))
233                              (t                              (t
234                               (:slant italic)))                               (:italic t)))
235    "Citation face.")    "Citation face.")
236    
237  (defface gnus-cite-face-10 '((((class color)  (defface gnus-cite-face-10 '((((class color)
# Line 230  It is merged with the face for the cited Line 241  It is merged with the face for the cited
241                                 (background light))                                 (background light))
242                                (:foreground "medium purple"))                                (:foreground "medium purple"))
243                               (t                               (t
244                                (:slant italic)))                                (:italic t)))
245    "Citation face.")    "Citation face.")
246    
247  (defface gnus-cite-face-11 '((((class color)  (defface gnus-cite-face-11 '((((class color)
# Line 240  It is merged with the face for the cited Line 251  It is merged with the face for the cited
251                                 (background light))                                 (background light))
252                                (:foreground "turquoise"))                                (:foreground "turquoise"))
253                               (t                               (t
254                                (:slant italic)))                                (:italic t)))
255    "Citation face.")    "Citation face.")
256    
257  (defcustom gnus-cite-face-list  (defcustom gnus-cite-face-list
# Line 270  This should make it easier to see who wr Line 281  This should make it easier to see who wr
281    :group 'gnus-cite    :group 'gnus-cite
282    :type 'boolean)    :type 'boolean)
283    
284    ;; This has to go here because its default value depends on
285    ;; gnus-cite-face-list.
286    (defcustom gnus-article-boring-faces (cons 'gnus-signature-face
287                                               gnus-cite-face-list)
288      "List of faces that are not worth reading.
289    If an article has more pages below the one you are looking at, but
290    nothing on those pages is a word of at least three letters that is not
291    in a boring face, then the pages will be skipped."
292      :type '(repeat face)
293      :group 'gnus-article-hiding)
294    
295  ;;; Internal Variables:  ;;; Internal Variables:
296    
297  (defvar gnus-cite-article nil)  (defvar gnus-cite-article nil)
# Line 317  Attribution lines are highlighted with t Line 339  Attribution lines are highlighted with t
339  corresponding citation merged with `gnus-cite-attribution-face'.  corresponding citation merged with `gnus-cite-attribution-face'.
340    
341  Text is considered cited if at least `gnus-cite-minimum-match-count'  Text is considered cited if at least `gnus-cite-minimum-match-count'
342  lines matches `gnus-cite-prefix-regexp' with the same prefix.  lines matches `message-cite-prefix-regexp' with the same prefix.
343    
344  Lines matching `gnus-cite-attribution-suffix' and perhaps  Lines matching `gnus-cite-attribution-suffix' and perhaps
345  `gnus-cite-attribution-prefix' are considered attribution lines."  `gnus-cite-attribution-prefix' are considered attribution lines."
# Line 358  Lines matching `gnus-cite-attribution-su Line 380  Lines matching `gnus-cite-attribution-su
380          (goto-char (point-min))          (goto-char (point-min))
381          (forward-line (1- number))          (forward-line (1- number))
382          (when (re-search-forward gnus-cite-attribution-suffix          (when (re-search-forward gnus-cite-attribution-suffix
383                                   (save-excursion (end-of-line 1) (point))                                   (gnus-point-at-eol)
384                                   t)                                   t)
385            (gnus-article-add-button (match-beginning 1) (match-end 1)            (gnus-article-add-button (match-beginning 1) (match-end 1)
386                                     'gnus-cite-toggle prefix))                                     'gnus-cite-toggle prefix))
# Line 450  If WIDTH (the numerical prefix), use tha Line 472  If WIDTH (the numerical prefix), use tha
472            (narrow-to-region (caar marks) (caadr marks))            (narrow-to-region (caar marks) (caadr marks))
473            (let ((adaptive-fill-regexp            (let ((adaptive-fill-regexp
474                   (concat "^" (regexp-quote (cdar marks)) " *"))                   (concat "^" (regexp-quote (cdar marks)) " *"))
475                  (fill-prefix (cdar marks)))                  (fill-prefix
476                     (if (string= (cdar marks) "") ""
477                       (concat (cdar marks) " ")))
478                    use-hard-newlines)
479              (fill-region (point-min) (point-max)))              (fill-region (point-min) (point-max)))
480            (set-marker (caar marks) nil)            (set-marker (caar marks) nil)
481            (setq marks (cdr marks)))            (setq marks (cdr marks)))
# Line 519  always hide." Line 544  always hide."
544                        (setq beg nil)                        (setq beg nil)
545                    (setq end (point-marker))))))                    (setq end (point-marker))))))
546              (when (and beg end)              (when (and beg end)
547                  (gnus-add-wash-type 'cite)
548                ;; We use markers for the end-points to facilitate later                ;; We use markers for the end-points to facilitate later
549                ;; wrapping and mangling of text.                ;; wrapping and mangling of text.
550                (setq beg (set-marker (make-marker) beg)                (setq beg (set-marker (make-marker) beg)
# Line 558  means show, nil means toggle." Line 584  means show, nil means toggle."
584                (and (> arg 0) (not hidden))                (and (> arg 0) (not hidden))
585                (and (< arg 0) hidden))                (and (< arg 0) hidden))
586        (if hidden        (if hidden
587            (gnus-remove-text-properties-when            (progn
588             'article-type 'cite beg end              ;; Can't remove 'cite from g-a-wash-types here because
589             (cons 'article-type (cons 'cite              ;; multiple citations may be hidden -jas
590                                       gnus-hidden-properties)))              (gnus-remove-text-properties-when
591                 'article-type 'cite beg end
592                 (cons 'article-type (cons 'cite
593                                           gnus-hidden-properties))))
594            (gnus-add-wash-type 'cite)
595          (gnus-add-text-properties-when          (gnus-add-text-properties-when
596           'article-type nil beg end           'article-type nil beg end
597           (cons 'article-type (cons 'cite           (cons 'article-type (cons 'cite
598                                     gnus-hidden-properties))))                                     gnus-hidden-properties))))
599          (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
600            (gnus-set-mode-line 'article))
601        (save-excursion        (save-excursion
602          (goto-char start)          (goto-char start)
603          (gnus-delete-line)          (gnus-delete-line)
# Line 594  cited text with attributions.  When call Line 626  cited text with attributions.  When call
626  variables are ignored.  variables are ignored.
627  See also the documentation for `gnus-article-highlight-citation'."  See also the documentation for `gnus-article-highlight-citation'."
628    (interactive (append (gnus-article-hidden-arg) '(force)))    (interactive (append (gnus-article-hidden-arg) '(force)))
629    (unless (gnus-article-check-hidden-text 'cite arg)    (with-current-buffer gnus-article-buffer
630      (save-excursion      (gnus-delete-wash-type 'cite)
631        (set-buffer gnus-article-buffer)      (unless (gnus-article-check-hidden-text 'cite arg)
632        (gnus-cite-parse-maybe force)        (save-excursion
633        (article-goto-body)          (gnus-cite-parse-maybe force)
634        (let ((start (point))          (article-goto-body)
635              (atts gnus-cite-attribution-alist)          (let ((start (point))
636              (buffer-read-only nil)                (atts gnus-cite-attribution-alist)
637              (inhibit-point-motion-hooks t)                (buffer-read-only nil)
638              (hidden 0)                (inhibit-point-motion-hooks t)
639              total)                (hidden 0)
640          (goto-char (point-max))                total)
641          (gnus-article-search-signature)            (goto-char (point-max))
642          (setq total (count-lines start (point)))            (gnus-article-search-signature)
643          (while atts            (setq total (count-lines start (point)))
           (setq hidden (+ hidden (length (cdr (assoc (cdar atts)  
                                                      gnus-cite-prefix-alist))))  
                 atts (cdr atts)))  
         (when (or force  
                   (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))  
                        (> hidden gnus-cite-hide-absolute)))  
           (setq atts gnus-cite-attribution-alist)  
644            (while atts            (while atts
645              (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))              (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
646                    atts (cdr atts))                                                         gnus-cite-prefix-alist))))
647              (while total                    atts (cdr atts)))
648                (setq hidden (car total)            (when (or force
649                      total (cdr total))                      (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
650                (goto-char (point-min))                           (> hidden gnus-cite-hide-absolute)))
651                (forward-line (1- hidden))              (gnus-add-wash-type 'cite)
652                (unless (assq hidden gnus-cite-attribution-alist)              (setq atts gnus-cite-attribution-alist)
653                  (gnus-add-text-properties              (while atts
654                   (point) (progn (forward-line 1) (point))                (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
655                   (nconc (list 'article-type 'cite)                      atts (cdr atts))
656                          gnus-hidden-properties))))))))))                (while total
657                    (setq hidden (car total)
658                          total (cdr total))
659                    (goto-char (point-min))
660                    (forward-line (1- hidden))
661                    (unless (assq hidden gnus-cite-attribution-alist)
662                      (gnus-add-text-properties
663                       (point) (progn (forward-line 1) (point))
664                       (nconc (list 'article-type 'cite)
665                              gnus-hidden-properties)))))))))
666        (gnus-set-mode-line 'article)))
667    
668  (defun gnus-article-hide-citation-in-followups ()  (defun gnus-article-hide-citation-in-followups ()
669    "Hide cited text in non-root articles."    "Hide cited text in non-root articles."
# Line 663  See also the documentation for `gnus-art Line 698  See also the documentation for `gnus-art
698    
699  (defun gnus-cite-delete-overlays ()  (defun gnus-cite-delete-overlays ()
700    (dolist (overlay gnus-cite-overlay-list)    (dolist (overlay gnus-cite-overlay-list)
701      (when (or (not (gnus-overlay-end overlay))      (ignore-errors
702                (and (>= (gnus-overlay-end overlay) (point-min))        (when (or (not (gnus-overlay-end overlay))
703                     (<= (gnus-overlay-end overlay) (point-max))))                  (and (>= (gnus-overlay-end overlay) (point-min))
704        (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))                       (<= (gnus-overlay-end overlay) (point-max))))
705        (gnus-delete-overlay overlay))))          (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
706            (ignore-errors
707              (gnus-delete-overlay overlay))))))
708    
709  (defun gnus-cite-parse-wrapper ()  (defun gnus-cite-parse-wrapper ()
710    ;; Wrap chopped gnus-cite-parse.    ;; Wrap chopped gnus-cite-parse.
# Line 690  See also the documentation for `gnus-art Line 727  See also the documentation for `gnus-art
727                 (goto-char (point-max))                 (goto-char (point-max))
728                 (gnus-article-search-signature)                 (gnus-article-search-signature)
729                 (point)))                 (point)))
730          alist entry start begin end numbers prefix)          (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)"))
731            alist entry start begin end numbers prefix guess-limit)
732      ;; Get all potential prefixes in `alist'.      ;; Get all potential prefixes in `alist'.
733      (while (< (point) max)      (while (< (point) max)
734        ;; Each line.        ;; Each line.
735        (setq begin (point)        (setq begin (point)
736              end (progn (beginning-of-line 2) (point))              guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
737                end (gnus-point-at-bol 2)
738              start end)              start end)
739        (goto-char begin)        (goto-char begin)
740        ;; Ignore standard Supercite attribution prefix.        ;; Ignore standard Supercite attribution prefix.
741        (when (looking-at gnus-supercite-regexp)        (when (and (< guess-limit (+ begin gnus-cite-max-prefix))
742                     (looking-at gnus-supercite-regexp))
743          (if (match-end 1)          (if (match-end 1)
744              (setq end (1+ (match-end 1)))              (setq end (1+ (match-end 1)))
745            (setq end (1+ begin))))            (setq end (1+ begin))))
746        ;; Ignore very long prefixes.        ;; Ignore very long prefixes.
747        (when (> end (+ (point) gnus-cite-max-prefix))        (when (> end (+ begin gnus-cite-max-prefix))
748          (setq end (+ (point) gnus-cite-max-prefix)))          (setq end (+ begin gnus-cite-max-prefix)))
749        (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)        ;; Ignore quoted envelope From_.
750          (when (and gnus-cite-ignore-quoted-from
751                     (prog2
752                         (setq case-fold-search nil)
753                         (looking-at ">From ")
754                       (setq case-fold-search t)))
755            (setq end (1+ begin)))
756          (while (re-search-forward prefix-regexp (1- end) t)
757          ;; Each prefix.          ;; Each prefix.
758          (setq end (match-end 0)          (setq end (match-end 0)
759                prefix (buffer-substring begin end))                prefix (buffer-substring begin end))
# Line 718  See also the documentation for `gnus-art Line 765  See also the documentation for `gnus-art
765          (goto-char begin))          (goto-char begin))
766        (goto-char start)        (goto-char start)
767        (setq line (1+ line)))        (setq line (1+ line)))
768        ;; Horrible special case for some Microsoft mailers.
769        (goto-char (point-min))
770        (when (re-search-forward gnus-cite-unsightly-citation-regexp max t)
771          (setq begin (count-lines (point-min) (point)))
772          (setq end (count-lines (point-min) max))
773          (setq entry nil)
774          (while (< begin end)
775            (push begin entry)
776            (setq begin (1+ begin)))
777          (push (cons "" entry) alist))
778      ;; We got all the potential prefixes.  Now create      ;; We got all the potential prefixes.  Now create
779      ;; `gnus-cite-prefix-alist' containing the oldest prefix for each      ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
780      ;; line that appears at least gnus-cite-minimum-match-count      ;; line that appears at least `gnus-cite-minimum-match-count'
781      ;; times.  First sort them by length.  Longer is older.      ;; times.  First sort them by length.  Longer is older.
782      (setq alist (sort alist (lambda (a b)      (setq alist (sort alist (lambda (a b)
783                                (> (length (car a)) (length (car b))))))                                (> (length (car a)) (length (car b))))))
# Line 960  See also the documentation for `gnus-art Line 1017  See also the documentation for `gnus-art
1017          (goto-char (point-min))          (goto-char (point-min))
1018          (forward-line (1- number))          (forward-line (1- number))
1019          (cond ((get-text-property (point) 'invisible)          (cond ((get-text-property (point) 'invisible)
1020                   ;; Can't remove 'cite from g-a-wash-types here because
1021                   ;; multiple citations may be hidden -jas
1022                 (remove-text-properties (point) (progn (forward-line 1) (point))                 (remove-text-properties (point) (progn (forward-line 1) (point))
1023                                         gnus-hidden-properties))                                         gnus-hidden-properties))
1024                ((assq number gnus-cite-attribution-alist))                ((assq number gnus-cite-attribution-alist))
1025                (t                (t
1026                   (gnus-add-wash-type 'cite)
1027                 (gnus-add-text-properties                 (gnus-add-text-properties
1028                  (point) (progn (forward-line 1) (point))                  (point) (progn (forward-line 1) (point))
1029                  (nconc (list 'article-type 'cite)                  (nconc (list 'article-type 'cite)
1030                         gnus-hidden-properties))))))))                         gnus-hidden-properties))))
1031            (let ((gnus-article-mime-handle-alist-1
1032                   gnus-article-mime-handle-alist))
1033              (gnus-set-mode-line 'article))))))
1034    
1035  (defun gnus-cite-find-prefix (line)  (defun gnus-cite-find-prefix (line)
1036    ;; Return citation prefix for LINE.    ;; Return citation prefix for LINE.
# Line 990  See also the documentation for `gnus-art Line 1053  See also the documentation for `gnus-art
1053      (while vars      (while vars
1054        (make-local-variable (pop vars)))))        (make-local-variable (pop vars)))))
1055    
1056    (defun gnus-cited-line-p ()
1057      "Say whether the current line is a cited line."
1058      (save-excursion
1059        (beginning-of-line)
1060        (let ((found nil))
1061          (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
1062            (when (string= (buffer-substring (point) (+ (length prefix) (point)))
1063                           prefix)
1064              (setq found t)))
1065          found)))
1066    
1067  (gnus-ems-redefine)  (gnus-ems-redefine)
1068    
1069  (provide 'gnus-cite)  (provide 'gnus-cite)

Legend:
Removed from v.1.9.2.2  
changed lines
  Added in v.1.9.2.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26