;;; 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
(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))
(setq m (cdr m))))
marks))))
-(defun gnus-article-fill-cited-article (&optional force width)
+(defun gnus-article-fill-cited-long-lines ()
+ (gnus-article-fill-cited-article nil t))
+
+(defun gnus-article-fill-cited-article (&optional width long-lines)
"Do word wrapping in the current article.
-If WIDTH (the numerical prefix), use that text width when filling."
- (interactive (list t current-prefix-arg))
+If WIDTH (the numerical prefix), use that text width when
+filling. If LONG-LINES, only fill sections that have lines
+longer than the frame width."
+ (interactive "P")
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
(fill-prefix
(if (string= (cdar marks) "") ""
(concat (cdar marks) " ")))
+ (do-fill (not long-lines))
use-hard-newlines)
- (fill-region (point-min) (point-max)))
+ (unless do-fill
+ (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
+ (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
gnus-cite-loose-attribution-alist nil
gnus-cite-article nil)))))
-(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.
(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."
(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.
(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
(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.
(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)))
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)))))
(provide 'gnus-cite)
;; Local Variables:
-;; coding: iso-8859-1
+;; coding: utf-8
;; End:
;;; gnus-cite.el ends here
projects / gnus / blobdiff