X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=65ce31377c2e2357fa16fac7f9dd057eee2453ac;hb=9b741e050b400987d68ff761c6cc3276c932839c;hp=0b7f42f32092c572f8bde26cc04856d81dcbac56;hpb=a2d6af2c24264119c5aff0ef0063733674eef102;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 0b7f42f..65ce313 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,8 +1,13 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 + +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. -;; Author: Per Abhiddenware; you can redistribute it and/or modify +;; Author: Per Abhiddenware + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; 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. @@ -22,10 +27,12 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) (require 'gnus) (require 'gnus-art) (require 'gnus-range) +(require 'message) ; for message-cite-prefix-regexp ;;; Customization: @@ -74,19 +81,13 @@ Set it to nil to parse all articles." :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." :group 'gnus-cite :type 'integer) (defcustom gnus-supercite-regexp - (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" + (concat "^\\(" message-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") "*Regexp matching normal Supercite attribution lines. The first grouping must match prefixes added by other packages." @@ -306,7 +307,7 @@ Attribution lines are highlighted with the same face as the corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' -lines matches `gnus-cite-prefix-regexp' with the same prefix. +lines matches `message-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." @@ -439,7 +440,10 @@ If WIDTH (the numerical prefix), use that text width when filling." (narrow-to-region (caar marks) (caadr marks)) (let ((adaptive-fill-regexp (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix (cdar marks))) + (fill-prefix + (if (string= (cdar marks) "") "" + (concat (cdar marks) " "))) + use-hard-newlines) (fill-region (point-min) (point-max))) (set-marker (caar marks) nil) (setq marks (cdr marks))) @@ -462,19 +466,25 @@ always hide." (gnus-set-format 'cited-closed-text-button t) (save-excursion (set-buffer gnus-article-buffer) - (cond - ((gnus-article-check-hidden-text 'cite arg) - t) - ((gnus-article-text-type-exists-p 'cite) - (let ((buffer-read-only nil)) - (gnus-article-hide-text-of-type 'cite))) - (t - (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - beg end start) + (let ((buffer-read-only nil) + marks + (inhibit-point-motion-hooks t) + (props (nconc (list 'article-type 'cite) + gnus-hidden-properties)) + (point (point-min)) + found beg end start) + (while (setq point + (text-property-any point (point-max) + 'gnus-callback + 'gnus-article-toggle-cited-text)) + (setq found t) + (goto-char point) + (gnus-article-toggle-cited-text + (get-text-property point 'gnus-data) arg) + (forward-line 1) + (setq point (point))) + (unless found + (setq marks (gnus-dissect-cited-text)) (while marks (setq beg nil end nil) @@ -502,11 +512,12 @@ always hide." (setq beg nil) (setq end (point-marker)))))) (when (and beg end) + (gnus-add-wash-type 'cite) ;; 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) + (gnus-add-text-properties-when 'article-type nil beg end props) (goto-char beg) (unless (save-excursion (search-backward "\n\n" nil t)) (insert "\n")) @@ -521,41 +532,56 @@ always hide." (list (cons beg end) start)) (point)) 'article-type 'annotation) - (set-marker beg (point))))))))) + (set-marker beg (point)))))))) -(defun gnus-article-toggle-cited-text (args) - "Toggle hiding the text in REGION." +(defun gnus-article-toggle-cited-text (args &optional arg) + "Toggle hiding the text in REGION. +ARG can be nil or a number. Positive means hide, negative +means show, nil means toggle." (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))) + (text-property-any beg (1- end) 'article-type 'cite)) (inhibit-point-motion-hooks t) buffer-read-only) - (funcall - (if hidden - 'remove-text-properties 'gnus-add-text-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)))) + (when (or (null arg) + (zerop arg) + (and (> arg 0) (not hidden)) + (and (< arg 0) hidden)) + (if hidden + (progn + ;; Can't remove 'cite from g-a-wash-types here because + ;; multiple citations may be hidden -jas + (gnus-remove-text-properties-when + 'article-type 'cite beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties)))) + (gnus-add-wash-type 'cite) + (gnus-add-text-properties-when + 'article-type nil beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties)))) + (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)) + (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. @@ -663,23 +689,26 @@ 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) + (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)")) + alist entry start begin end numbers prefix guess-limit mc-flag) ;; Get all potential prefixes in `alist'. (while (< (point) max) ;; Each line. (setq begin (point) + guess-limit (progn (skip-chars-forward "^> \t\r\n") (point)) end (progn (beginning-of-line 2) (point)) start end) (goto-char begin) ;; Ignore standard Supercite attribution prefix. - (when (looking-at gnus-supercite-regexp) + (when (and (< guess-limit (+ begin gnus-cite-max-prefix)) + (looking-at gnus-supercite-regexp)) (if (match-end 1) (setq end (1+ (match-end 1))) (setq end (1+ begin)))) ;; Ignore very long prefixes. - (when (> end (+ (point) gnus-cite-max-prefix)) - (setq end (+ (point) gnus-cite-max-prefix))) - (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) + (when (> end (+ begin gnus-cite-max-prefix)) + (setq end (+ begin gnus-cite-max-prefix))) + (while (re-search-forward prefix-regexp (1- end) t) ;; Each prefix. (setq end (match-end 0) prefix (buffer-substring begin end)) @@ -908,7 +937,12 @@ See also the documentation for `gnus-article-highlight-citation'." from to overlay) (goto-char (point-min)) (when (zerop (forward-line (1- number))) - (forward-char (length prefix)) + (static-if (or (featurep 'xemacs) + (and (eq emacs-major-version 20) + (>= emacs-minor-version 3)) + (>= emacs-major-version 21)) + (forward-char (length prefix)) + (move-to-column (string-width prefix))) (skip-chars-forward " \t") (setq from (point)) (end-of-line 1) @@ -933,14 +967,20 @@ See also the documentation for `gnus-article-highlight-citation'." (goto-char (point-min)) (forward-line (1- number)) (cond ((get-text-property (point) 'invisible) + ;; Can't remove 'cite from g-a-wash-types here because + ;; multiple citations may be hidden -jas (remove-text-properties (point) (progn (forward-line 1) (point)) gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t + (gnus-add-wash-type 'cite) (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))) + gnus-hidden-properties)))) + (let ((gnus-article-mime-handle-alist-1 + gnus-article-mime-handle-alist)) + (gnus-set-mode-line 'article)))))) (defun gnus-cite-find-prefix (line) ;; Return citation prefix for LINE.