X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-cite.el;h=57fc2816155255c23624b1e8c2e5df8237b0e0e2;hb=6aa54ac28a20311bdd9655fbecdcbe4bdcea32c1;hp=c8de7a6faaa1decf776981869d4bbbc11dfb0d1f;hpb=30cbdba78e6274a909e56dada62f60423fd639ef;p=gnus diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el index c8de7a6fa..57fc28161 100644 --- a/lisp/gnus-cite.el +++ b/lisp/gnus-cite.el @@ -1,7 +1,6 @@ ;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1995-2015 Free Software Foundation, Inc. ;; Author: Per Abhiddenware @@ -510,6 +509,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (if (and (equal (cdadr m) "") (equal (cdar m) (cdaddr m)) (goto-char (caadr m)) + (looking-at "[ \t]*$") (forward-line 1) (= (point) (caaddr m))) (setcdr m (cdddr m)) @@ -543,9 +543,21 @@ longer than the frame width." (do-fill (not long-lines)) use-hard-newlines) (unless do-fill - (setq do-fill (gnus-article-foldable-buffer))) + (setq do-fill (gnus-article-foldable-buffer (cdar marks)))) + ;; Note: the XEmacs version of `fill-region' inserts a newline + ;; unless the region ends with a newline. (when do-fill - (fill-region (point-min) (point-max)))) + (if (not long-lines) + (fill-region (point-min) (point-max)) + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) + (when (prog1 + (> (current-column) (window-width)) + (forward-line 1)) + (save-restriction + (narrow-to-region (line-beginning-position 0) (point)) + (fill-region (point-min) (point-max)))))))) (set-marker (caar marks) nil) (setq marks (cdr marks))) (when marks @@ -557,32 +569,28 @@ longer than the frame width." gnus-cite-loose-attribution-alist nil gnus-cite-article nil))))) -(defun gnus-article-foldable-buffer () - (goto-char (point-min)) - (while (not (eobp)) - (end-of-line) - (when (> (current-column) (frame-width)) - (setq do-fill t)) - (forward-line 1)) - do-fill) - -(defun gnus-article-natural-long-line-p () - "Return true if the current line is long, and it's natural text." - (save-excursion - (beginning-of-line) - (and - ;; The line is long. - (> (- (line-end-position) (line-beginning-position)) - (frame-width)) - ;; It doesn't start with spaces. - (not (looking-at " ")) - ;; Not cited text. - (let ((line-number (1+ (count-lines (point-min) (point)))) - citep) - (dolist (elem gnus-cite-prefix-alist) - (when (member line-number (cdr elem)) - (setq citep t))) - (not citep))))) +(defun gnus-article-foldable-buffer (prefix) + (let ((do-fill nil) + columns) + (goto-char (point-min)) + (while (not (eobp)) + (unless (> (length prefix) (- (point-max) (point))) + (forward-char (length prefix))) + (skip-chars-forward " \t") + (unless (eolp) + (let ((elem (assq (current-column) columns))) + (unless elem + (setq elem (cons (current-column) 0)) + (push elem columns)) + (setcdr elem (1+ (cdr elem))))) + (end-of-line) + (when (> (current-column) (window-width)) + (setq do-fill t)) + (forward-line 1)) + (and do-fill + ;; We know know that there are long lines here, but does this look + ;; like code? Check for ragged edges on the left. + (< (length columns) 3)))) (defun gnus-article-hide-citation (&optional arg force) "Toggle hiding of all cited text except attribution lines. @@ -737,28 +745,14 @@ See also the documentation for `gnus-article-highlight-citation'." (gnus-article-search-signature) (setq total (count-lines start (point))) (while atts - (setq hidden (+ hidden (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 hidden) (* gnus-cite-hide-percentage total)) (> hidden gnus-cite-hide-absolute))) - (gnus-add-wash-type 'cite) - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hidden (car total) - total (cdr total)) - (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) - gnus-hidden-properties))))))))) - (gnus-set-mode-line 'article))) + (gnus-article-hide-citation))))))) (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." @@ -792,12 +786,12 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-cite-delete-overlays () (dolist (overlay gnus-cite-overlay-list) (ignore-errors - (when (or (not (gnus-overlay-end overlay)) - (and (>= (gnus-overlay-end overlay) (point-min)) - (<= (gnus-overlay-end overlay) (point-max)))) + (when (or (not (overlay-end overlay)) + (and (>= (overlay-end overlay) (point-min)) + (<= (overlay-end overlay) (point-max)))) (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list)) (ignore-errors - (gnus-delete-overlay overlay)))))) + (delete-overlay overlay)))))) (defun gnus-cite-parse-wrapper () ;; Wrap chopped gnus-cite-parse. @@ -1102,10 +1096,10 @@ See also the documentation for `gnus-article-highlight-citation'." (skip-chars-backward " \t") (setq to (point)) (when (< from to) - (push (setq overlay (gnus-make-overlay from to)) + (push (setq overlay (make-overlay from to nil t)) gnus-cite-overlay-list) - (gnus-overlay-put overlay 'evaporate t) - (gnus-overlay-put overlay 'face face)))))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'face face)))))) (defun gnus-cite-toggle (prefix) (with-current-buffer gnus-article-buffer @@ -1156,18 +1150,6 @@ See also the documentation for `gnus-article-highlight-citation'." (while vars (make-local-variable (pop vars))))) -(defun gnus-cited-line-p () - "Say whether the current line is a cited line." - (save-excursion - (beginning-of-line) - (let ((found nil)) - (dolist (prefix (mapcar 'car gnus-cite-prefix-alist)) - (when (string= (buffer-substring (point) (+ (length prefix) (point))) - prefix) - (setq found t))) - found))) - - ;; Highlighting of different citation levels in message-mode. ;; - message-cite-prefix will be overridden if this is enabled. @@ -1217,17 +1199,13 @@ Returns nil if there is no such line before LIMIT, t otherwise." (autoload 'font-lock-set-defaults "font-lock"))) (define-minor-mode gnus-message-citation-mode - "Toggle `gnus-message-citation-mode' in current buffer. -This buffer local minor mode provides additional font-lock support for -nested citations. -With prefix ARG, turn `gnus-message-citation-mode' on if and only if ARG -is positive. -Automatically turn `font-lock-mode' on when `gnus-message-citation-mode' -is turned on." + "Minor mode providing more font-lock support for nested citations. +When enabled, it automatically turns on `font-lock-mode'." nil ;; init-value "" ;; lighter nil ;; keymap - (when (eq major-mode 'message-mode) + (when (eq major-mode 'message-mode) ;FIXME: Use derived-mode-p. + ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car (if (featurep 'xemacs) (get 'message-mode 'font-lock-defaults) font-lock-defaults))) @@ -1256,8 +1234,10 @@ is turned on." font-lock-keywords nil)) (setq font-lock-set-defaults nil)) (font-lock-set-defaults) - (cond ((symbol-value 'font-lock-mode) - (font-lock-fontify-buffer)) + (cond (font-lock-mode + (if (fboundp 'font-lock-flush) + (font-lock-flush) + (font-lock-fontify-buffer))) (gnus-message-citation-mode (font-lock-mode 1))))) @@ -1273,7 +1253,7 @@ is turned on." (provide 'gnus-cite) ;; Local Variables: -;; coding: iso-8859-1 +;; coding: utf-8 ;; End: ;;; gnus-cite.el ends here