X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=73c4befc8a7b32930bfead78c724d9a68772a301;hb=277cfbcdf4d715e60e84f17f3f1c70c55d26b47a;hp=0a59f65bfb88d441bbc94020e6dafd20866be843;hpb=cf2df8ebaa6d68df930ea8cb43615e13a9f289ea;p=gnus diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index 0a59f65bf..73c4befc8 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,8 +1,13 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus +;;; gnus-cite.el --- parse citations in articles for Gnus -*- coding: iso-latin-1 -*- + ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 ;; 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. @@ -434,7 +439,9 @@ 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) " ")))) (fill-region (point-min) (point-max))) (set-marker (caar marks) nil) (setq marks (cdr marks))) @@ -457,57 +464,63 @@ 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)) + marks (inhibit-point-motion-hooks t) (props (nconc (list 'article-type 'cite) gnus-hidden-properties)) - beg end start) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks + (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) + (while (and marks (string= (cdar marks) "")) + (setq marks (cdr marks))) + (when marks + (setq beg (caar marks))) + (while (and marks (not (string= (cdar marks) ""))) + (setq marks (cdr marks))) + (when marks (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (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)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) + ;; Skip past lines we want to leave visible. + (when (and beg end gnus-cited-lines-visible) + (goto-char beg) + (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)) + (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 - (setq start (point-marker)) - (progn + (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-when 'article-type nil beg end props) + (goto-char beg) + (unless (save-excursion (search-backward "\n\n" nil t)) + (insert "\n")) + (put-text-property + (setq start (point-marker)) + (progn (gnus-article-add-button (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) @@ -515,42 +528,51 @@ always hide." `gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) - 'article-type 'annotation) - (set-marker beg (point))))))))) + 'article-type 'annotation) + (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 + (gnus-remove-text-properties-when + 'article-type 'cite beg end + (cons 'article-type (cons 'cite + gnus-hidden-properties))) + (gnus-add-text-properties-when + 'article-type nil beg end + (cons 'article-type (cons 'cite + 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. @@ -658,23 +680,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) ;; 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 message-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))