X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=a2dbe97ccbd38e2dfd5265f4e376a9f6d34ef4a8;hb=3c6a96d019e0fcdf0d35f9d4873f62c1962995ad;hp=67a86a0ef57143b475c0ef9c5c1d764c998a704e;hpb=23d4e4cc4b75c353403b76fc2182384e663d2980;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 67a86a0..a2dbe97 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,12 +1,8 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. -;; Author: Per Abrahamsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify +;; Author: Per Abhiddenware; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. @@ -31,6 +27,8 @@ (require 'gnus-art) (require 'gnus-range) +(eval-when-compile (require 'static)) + ;;; Customization: (defgroup gnus-cite nil @@ -47,37 +45,45 @@ article has citations." :type 'string) (defcustom gnus-cite-always-check nil - "*Check article always for citations. Set it t to check all articles." + "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))) + (const :tag "yes" t))) -(defcustom gnus-cited-text-button-line-format "%(%{[...]%}%)\n" - "*Format of cited text buttons." +(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n" + "Format of opened cited text buttons." + :group 'gnus-cite + :type 'string) + +(defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n" + "Format of closed cited text buttons." :group 'gnus-cite :type 'string) (defcustom gnus-cited-lines-visible nil - "*The number of lines of hidden cited text to remain visible." + "The number of lines of hidden cited text to remain visible. +Or a pair (cons) of numbers which are the number of lines at the top +and bottom of the text, respectively, to remain visible." :group 'gnus-cite :type '(choice (const :tag "none" nil) - integer)) + integer + (cons :tag "Top and Bottom" integer integer))) (defcustom gnus-cite-parse-max-size 25000 - "*Maximum article size (in bytes) where parsing citations is allowed. + "Maximum article size (in bytes) where parsing citations is allowed. Set it to nil to parse all articles." :group 'gnus-cite :type '(choice (const :tag "all" nil) integer)) (defcustom gnus-cite-prefix-regexp - "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" + "^[]>»|:}+ ]*[]>»|:}+]\\(.*>»\\)?\\|^.*>" "*Regexp matching the longest possible citation prefix on a line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-max-prefix 20 - "*Maximum possible length for a citation prefix." + "Maximum possible length for a citation prefix." :group 'gnus-cite :type 'integer) @@ -90,35 +96,35 @@ The first grouping must match prefixes added by other packages." :type 'regexp) (defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" - "*Regexp matching mangled Supercite attribution lines. + "Regexp matching mangled Supercite attribution lines. The first regexp group should match the Supercite attribution." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-minimum-match-count 2 - "*Minimum number of identical prefixes before we believe it's a citation." + "Minimum number of identical prefixes before we believe it's a citation." :group 'gnus-cite :type 'integer) -(defcustom gnus-cite-attribution-prefix - "in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)," +(defcustom gnus-cite-attribution-prefix + "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|-----Original Message-----" "*Regexp matching the beginning of an attribution line." :group 'gnus-cite :type 'regexp) (defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ \t]*$" + "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|-----Original Message-----\\)[ \t]*$" "*Regexp matching the end of an attribution line. The text matching the first grouping will be used as a button." :group 'gnus-cite :type 'regexp) (defface gnus-cite-attribution-face '((t - (:underline t))) + (:italic t))) "Face used for attribution lines.") (defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face - "*Face used for attribution lines. + "Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution." :group 'gnus-cite :type 'face) @@ -235,8 +241,8 @@ It is merged with the face for the cited text belonging to the attribution." (defcustom gnus-cite-face-list '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 - gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 - gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) + gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 + gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) "*List of faces used for highlighting citations. When there are citations from multiple articles in the same message, @@ -246,12 +252,12 @@ This should make it easier to see who wrote what." :type '(repeat face)) (defcustom gnus-cite-hide-percentage 50 - "*Only hide excess citation if above this percentage of the body." + "Only hide excess citation if above this percentage of the body." :group 'gnus-cite :type 'number) (defcustom gnus-cite-hide-absolute 10 - "*Only hide excess citation if above this number of lines in the body." + "Only hide excess citation if above this number of lines in the body." :group 'gnus-cite :type 'integer) @@ -281,11 +287,16 @@ This should make it easier to see who wrote what." ;; PREFIX: Is the citation prefix of the attribution line(s), and ;; TAG: Is a Supercite tag, if any. -(defvar gnus-cited-text-button-line-format-alist +(defvar gnus-cited-opened-text-button-line-format-alist `((?b (marker-position beg) ?d) (?e (marker-position end) ?d) + (?n (count-lines beg end) ?d) (?l (- end beg) ?d))) -(defvar gnus-cited-text-button-line-format-spec nil) +(defvar gnus-cited-opened-text-button-line-format-spec nil) +(defvar gnus-cited-closed-text-button-line-format-alist + gnus-cited-opened-text-button-line-format-alist) +(defvar gnus-cited-closed-text-button-line-format-spec nil) + ;;; Commands: @@ -335,7 +346,8 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps skip (gnus-cite-find-prefix number) face (cdr (assoc prefix face-alist))) ;; Add attribution button. - (goto-line number) + (goto-char (point-min)) + (forward-line (1- number)) (when (re-search-forward gnus-cite-attribution-suffix (save-excursion (end-of-line 1) (point)) t) @@ -357,7 +369,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps "Dissect the article buffer looking for cited text." (save-excursion (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe) + (gnus-cite-parse-maybe nil t) (let ((alist gnus-cite-prefix-alist) prefix numbers number marks m) ;; Loop through citation prefixes. @@ -376,8 +388,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (forward-line (1- number)) (push (cons (point-marker) prefix) marks))) ;; Skip to the beginning of the body. - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (push (cons (point-marker) "") marks) ;; Find the end of the body. (goto-char (point-max)) @@ -427,7 +438,6 @@ If WIDTH (the numerical prefix), use that text width when filling." (fill-column (if width (prefix-numeric-value width) fill-column))) (save-restriction (while (cdr marks) - (widen) (narrow-to-region (caar marks) (caadr marks)) (let ((adaptive-fill-regexp (concat "^" (regexp-quote (cdar marks)) " *")) @@ -450,7 +460,8 @@ See the documentation for `gnus-article-highlight-citation'. If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (append (gnus-article-hidden-arg) (list 'force))) - (gnus-set-format 'cited-text-button t) + (gnus-set-format 'cited-opened-text-button t) + (gnus-set-format 'cited-closed-text-button t) (save-excursion (set-buffer gnus-article-buffer) (cond @@ -465,7 +476,7 @@ always hide." (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) - beg end) + beg end start) (while marks (setq beg nil end nil) @@ -480,35 +491,73 @@ always hide." ;; Skip past lines we want to leave visible. (when (and beg end gnus-cited-lines-visible) (goto-char beg) - (forward-line gnus-cited-lines-visible) + (forward-line (if (consp gnus-cited-lines-visible) + (car gnus-cited-lines-visible) + gnus-cited-lines-visible)) (if (>= (point) end) (setq beg nil) - (setq beg (point-marker)))) + (setq beg (point-marker)) + (when (consp gnus-cited-lines-visible) + (goto-char end) + (forward-line (- (cdr gnus-cited-lines-visible))) + (if (<= (point) beg) + (setq beg nil) + (setq end (point-marker)))))) (when (and beg end) + ;; We use markers for the end-points to facilitate later + ;; wrapping and mangling of text. + (setq beg (set-marker (make-marker) beg) + end (set-marker (make-marker) end)) (gnus-add-text-properties beg end props) (goto-char beg) (unless (save-excursion (search-backward "\n\n" nil t)) (insert "\n")) (put-text-property - (point) + (setq start (point-marker)) (progn (gnus-article-add-button (point) - (progn (eval gnus-cited-text-button-line-format-spec) (point)) - `gnus-article-toggle-cited-text (cons beg end)) + (progn (eval gnus-cited-closed-text-button-line-format-spec) + (point)) + `gnus-article-toggle-cited-text + (list (cons beg end) start)) (point)) 'article-type 'annotation) (set-marker beg (point))))))))) -(defun gnus-article-toggle-cited-text (region) +(defun gnus-article-toggle-cited-text (args) "Toggle hiding the text in REGION." - (let (buffer-read-only) + (let* ((region (car args)) + (beg (car region)) + (end (cdr region)) + (start (cadr args)) + (hidden + (text-property-any + beg (1- end) + (car gnus-hidden-properties) (cadr gnus-hidden-properties))) + (inhibit-point-motion-hooks t) + buffer-read-only) (funcall - (if (text-property-any - (car region) (1- (cdr region)) - (car gnus-hidden-properties) (cadr gnus-hidden-properties)) + (if hidden 'remove-text-properties 'gnus-add-text-properties) - (car region) (cdr region) gnus-hidden-properties))) + beg end gnus-hidden-properties) + (save-excursion + (goto-char start) + (gnus-delete-line) + (put-text-property + (point) + (progn + (gnus-article-add-button + (point) + (progn (eval + (if hidden + gnus-cited-opened-text-button-line-format-spec + gnus-cited-closed-text-button-line-format-spec)) + (point)) + `gnus-article-toggle-cited-text + args) + (point)) + 'article-type 'annotation)))) (defun gnus-article-hide-citation-maybe (&optional arg force) "Toggle hiding of cited text that has an attribution line. @@ -519,38 +568,38 @@ percent and at least `gnus-cite-hide-absolute' lines of the body is cited text with attributions. When called interactively, these two variables are ignored. See also the documentation for `gnus-article-highlight-citation'." - (interactive (list (gnus-article-hidden-arg) 'force)) + (interactive (append (gnus-article-hidden-arg) '(force))) (unless (gnus-article-check-hidden-text 'cite arg) (save-excursion (set-buffer gnus-article-buffer) (gnus-cite-parse-maybe force) - (goto-char (point-min)) - (search-forward "\n\n" nil t) + (article-goto-body) (let ((start (point)) (atts gnus-cite-attribution-alist) (buffer-read-only nil) (inhibit-point-motion-hooks t) - (hiden 0) + (hidden 0) total) (goto-char (point-max)) (gnus-article-search-signature) (setq total (count-lines start (point))) (while atts - (setq hiden (+ hiden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) + (setq hidden (+ hidden (length (cdr (assoc (cdar atts) + gnus-cite-prefix-alist)))) atts (cdr atts))) (when (or force - (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) - (> hiden gnus-cite-hide-absolute))) + (and (> (* 100 hidden) (* gnus-cite-hide-percentage total)) + (> hidden gnus-cite-hide-absolute))) (setq atts gnus-cite-attribution-alist) (while atts (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) atts (cdr atts)) (while total - (setq hiden (car total) + (setq hidden (car total) total (cdr total)) - (goto-line hiden) - (unless (assq hiden gnus-cite-attribution-alist) + (goto-char (point-min)) + (forward-line (1- hidden)) + (unless (assq hidden gnus-cite-attribution-alist) (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) @@ -569,45 +618,42 @@ See also the documentation for `gnus-article-highlight-citation'." ;;; Internal functions: -(defun gnus-cite-parse-maybe (&optional force) - ;; Parse if the buffer has changes since last time. - (if (and (not force) - (equal gnus-cite-article gnus-article-current)) +(defun gnus-cite-parse-maybe (&optional force no-overlay) + "Always parse the buffer." + (gnus-cite-localize) + ;;Reset parser information. + (setq gnus-cite-prefix-alist nil + gnus-cite-attribution-alist nil + gnus-cite-loose-prefix-alist nil + gnus-cite-loose-attribution-alist nil) + (unless no-overlay + (gnus-cite-delete-overlays)) + ;; Parse if not too large. + (if (and gnus-cite-parse-max-size + (> (buffer-size) gnus-cite-parse-max-size)) () - (gnus-cite-localize) - ;;Reset parser information. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil) - (while gnus-cite-overlay-list - (gnus-delete-overlay (pop gnus-cite-overlay-list))) - ;; Parse if not too large. - (if (and (not force) - gnus-cite-parse-max-size - (> (buffer-size) gnus-cite-parse-max-size)) - () - (setq gnus-cite-article (cons (car gnus-article-current) - (cdr gnus-article-current))) - (gnus-cite-parse-wrapper)))) + (setq gnus-cite-article (cons (car gnus-article-current) + (cdr gnus-article-current))) + (gnus-cite-parse-wrapper))) + +(defun gnus-cite-delete-overlays () + (dolist (overlay gnus-cite-overlay-list) + (when (or (not (gnus-overlay-end overlay)) + (and (>= (gnus-overlay-end overlay) (point-min)) + (<= (gnus-overlay-end overlay) (point-max)))) + (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) + (gnus-delete-overlay overlay)))) (defun gnus-cite-parse-wrapper () - ;; Wrap chopped gnus-cite-parse - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (save-excursion - (gnus-cite-parse-attributions)) - ;; Try to avoid check citation if there is no reason to believe - ;; that article has citations - (if (or gnus-cite-always-check - (save-excursion - (re-search-backward gnus-cite-reply-regexp nil t)) - gnus-cite-loose-attribution-alist) - (progn (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions))))) + ;; Wrap chopped gnus-cite-parse. + (article-goto-body) + (let ((inhibit-point-motion-hooks t)) + (save-excursion + (gnus-cite-parse-attributions)) + (save-excursion + (gnus-cite-parse)) + (save-excursion + (gnus-cite-connect-attributions)))) (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. @@ -619,7 +665,7 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char (point-max)) (gnus-article-search-signature) (point))) - alist entry start begin end numbers prefix) + alist entry start begin end numbers prefix mc-flag) ;; Get all potential prefixes in `alist'. (while (< (point) max) ;; Each line. @@ -862,9 +908,14 @@ See also the documentation for `gnus-article-highlight-citation'." (when face (let ((inhibit-point-motion-hooks t) from to overlay) - (goto-line number) - (unless (eobp) ; Sometimes things become confused. - (forward-char (length prefix)) + (goto-char (point-min)) + (when (zerop (forward-line (1- number))) + (static-if (or (featurep 'xemacs) + (and (eq emacs-major-version 20) + (>= emacs-minor-version 3)) + (> emacs-major-version 20));-) + (forward-char (length prefix)) + (move-to-column (string-width prefix))) (skip-chars-forward " \t") (setq from (point)) (end-of-line 1) @@ -878,6 +929,7 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-toggle (prefix) (save-excursion (set-buffer gnus-article-buffer) + (gnus-cite-parse-maybe nil t) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) (inhibit-point-motion-hooks t) @@ -885,7 +937,8 @@ See also the documentation for `gnus-article-highlight-citation'." (while numbers (setq number (car numbers) numbers (cdr numbers)) - (goto-line number) + (goto-char (point-min)) + (forward-line (1- number)) (cond ((get-text-property (point) 'invisible) (remove-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties)) @@ -921,4 +974,8 @@ See also the documentation for `gnus-article-highlight-citation'." (provide 'gnus-cite) +;; Local Variables: +;; coding: iso-8859-1 +;; End: + ;;; gnus-cite.el ends here