X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=998a196d317d15f153b1354dedf14cc817092606;hb=e10fb2a2fd005a4d0b3f4801bde5668424b61af5;hp=c6aefb6a4f6b577308a12afd8d390f3599a2ccb0;hpb=1fe5dcd40dc84880069ffc178924e6d1ae809bea;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index c6aefb6..998a196 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,12 +1,7 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99 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. @@ -52,16 +47,24 @@ article has citations." :type '(choice (const :tag "no" nil) (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. @@ -71,7 +74,7 @@ Set it to nil to parse all articles." integer)) (defcustom gnus-cite-prefix-regexp - "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" + "^[]>»|:}+ ]*[]>»|:}+]\\(.*>»\\)?\\|^.*>" "*Regexp matching the longest possible citation prefix on a line." :group 'gnus-cite :type 'regexp) @@ -100,21 +103,21 @@ The first regexp group should match the Supercite attribution." :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 @@ -281,11 +284,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 +343,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) @@ -367,7 +376,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (while numbers (setq number (pop numbers)) (goto-char (point-min)) - (forward-line number) + (forward-line (1- number)) (push (cons (point-marker) "") marks) (while (and numbers (= (1- number) (car numbers))) @@ -376,8 +385,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 +435,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 +457,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 +473,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,39 +488,71 @@ 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)) + (progn (eval gnus-cited-closed-text-button-line-format-spec) + (point)) `gnus-article-toggle-cited-text - ;; We use markers for the end-points to facilitate later - ;; wrapping and mangling of text. - (cons (set-marker (make-marker) beg) - (set-marker (make-marker) end))) + (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)) + (start (cadr args)) + (hidden + (text-property-any + (car region) (1- (cdr region)) + (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))) + (car region) (cdr region) 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. @@ -523,38 +563,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) @@ -573,6 +613,7 @@ 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) @@ -597,9 +638,7 @@ See also the documentation for `gnus-article-highlight-citation'." (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))) + (article-goto-body) (save-excursion (gnus-cite-parse-attributions)) ;; Try to avoid check citation if there is no reason to believe @@ -866,8 +905,8 @@ 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. + (goto-char (point-min)) + (when (zerop (forward-line (1- number))) (forward-char (length prefix)) (skip-chars-forward " \t") (setq from (point)) @@ -882,6 +921,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) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) (inhibit-point-motion-hooks t) @@ -889,7 +929,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))