;;; wl-highlight.el -- Hilight modules for Wanderlust.
-;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
+;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;; Author: Yuuichi Teranishi <teranisi@gohome.org>
;; Keywords: mail, net news
(featurep 'dragdrop))
(require 'wl-dnd))
(require 'wl-vars)
-(require 'product)
-(product-provide (provide 'wl-highlight) (require 'wl-version))
+(provide 'wl-highlight) ; circular dependency
(eval-when-compile
(cond (wl-on-xemacs
(defvar wl-highlight-summary-refiled-regexp " *[0-9]+o")
(defvar wl-highlight-summary-copied-regexp " *[0-9]+O")
(defvar wl-highlight-summary-target-regexp " *[0-9]+\\*")
-;(defvar wl-highlight-summary-thread-top-regexp " *[0-9]+[^0-9][^0-9]../..\(.*\)..:.. \\[")
+;;(defvar wl-highlight-summary-thread-top-regexp " *[0-9]+[^0-9][^0-9]../..\(.*\)..:.. \\[")
(defvar wl-highlight-citation-face-list
'(wl-highlight-message-cited-text-1
(setq fsymbol 'wl-highlight-summary-low-read-face))
((string= temp-mark "+")
(setq fsymbol 'wl-highlight-summary-high-read-face))
- (t (if (= 0 (length indent))
+ (t (if (zerop (length indent))
(setq fsymbol 'wl-highlight-summary-thread-top-face)
(setq fsymbol 'wl-highlight-summary-normal-face))))
(put-text-property 0 (length line) 'face fsymbol line))
(setq fsymbol 'wl-highlight-summary-normal-face)))))
(put-text-property bol eol 'face fsymbol)
(if wl-use-highlight-mouse-line
- (put-text-property bol;(1- (match-end 0))
+ (put-text-property bol
+;;; Use bol instead of (1- (match-end 0))
+;;; (1- (match-end 0))
eol 'mouse-face 'highlight))
-; (put-text-property (match-beginning 3) (match-end 3)
-; 'face 'wl-highlight-thread-indent-face)
+;;; (put-text-property (match-beginning 3) (match-end 3)
+;;; 'face 'wl-highlight-thread-indent-face)
;; Dnd stuff.
(if wl-use-dnd
(wl-dnd-set-drag-starter bol eol)))))
wl-highlight-summary-refiled-regexp matches messages mark as refiled
wl-highlight-summary-copied-regexp matches messages mark as copied
wl-highlight-summary-new-regexp matches new messages
-
-If HACK-SIG is true,then we search backward from END for something that
-looks like the beginning of a signature block, and don't consider that a
-part of the message (this is because signatures are often incorrectly
-interpreted as cited text.)"
+"
(if (< end start)
(let ((s start)) (setq start end end s)))
- (let* ((lines (count-lines start end))
- (too-big (and wl-highlight-max-summary-lines
- (> lines wl-highlight-max-summary-lines)))
- (real-end end)
- gc-message
- e p hend i percent)
+ (let (lines too-big gc-message e p hend i percent)
(save-excursion
- (save-restriction
- (widen)
- (narrow-to-region start end)
- (if (not too-big)
- (save-restriction
- (goto-char start)
- (setq i 0)
- (while (not (eobp))
- (wl-highlight-summary-current-line nil nil wl-summary-scored)
- (when (> lines elmo-display-progress-threshold)
- (setq i (+ i 1))
- (setq percent (/ (* i 100) lines))
- (if (or (eq (% percent 5) 0) (= i lines))
- (elmo-display-progress
- 'wl-highlight-summary "Highlighting..."
- percent)))
- (forward-line 1))
- (message "Highlighting...done")))))))
+ (unless wl-summary-lazy-highlight
+ (setq lines (count-lines start end)
+ too-big (and wl-highlight-max-summary-lines
+ (> lines wl-highlight-max-summary-lines))))
+ (goto-char start)
+ (setq i 0)
+ (while (and (not (eobp))
+ (< (point) end))
+ (wl-highlight-summary-current-line nil nil
+ (or wl-summary-lazy-highlight
+ wl-summary-scored))
+ (when (and (not wl-summary-lazy-highlight)
+ (> lines elmo-display-progress-threshold))
+ (setq i (+ i 1))
+ (setq percent (/ (* i 100) lines))
+ (if (or (zerop (% percent 5)) (= i lines))
+ (elmo-display-progress
+ 'wl-highlight-summary "Highlighting..."
+ percent)))
+ (forward-line 1))
+ (unless wl-summary-lazy-highlight
+ (message "Highlighting...done")))))
+
+(defun wl-highlight-summary-window (&optional win beg)
+ "Highlight summary window.
+This function is defined for `window-scroll-functions'"
+ (if wl-summary-highlight
+ (with-current-buffer (window-buffer win)
+ (wl-highlight-summary (window-start win)
+ (save-excursion
+ (goto-char (window-start win))
+ (forward-line (frame-height))
+ (point)))
+ (set-buffer-modified-p nil))))
(defun wl-highlight-headers (&optional for-draft)
(let ((beg (point-min))
(wl-highlight-message beg end nil)
(unless for-draft
(wl-highlight-message-add-buttons-to-header beg end)
- (and wl-highlight-x-face-func
- (funcall wl-highlight-x-face-func beg end)))
+ (when wl-highlight-x-face-function
+ (funcall wl-highlight-x-face-function beg end)))
(run-hooks 'wl-highlight-headers-hook)))
(defun wl-highlight-message-add-buttons-to-header (start end)
(wl-highlight-message beg end t t))
(defun wl-highlight-signature-search-simple (beg end)
- "Search signature area in the body message between beg and end.
+ "Search signature area in the body message between BEG and END.
Returns start point of signature."
(save-excursion
(goto-char end)
end)))
(defun wl-highlight-signature-search (beg end)
- "Search signature area in the body message between beg and end.
+ "Search signature area in the body message between BEG and END.
Returns start point of signature."
(save-excursion
(goto-char end)
current beg
e p hend)
(if too-big
- nil
+ nil
(save-excursion
(save-restriction
(widen)
;; take off signature
(if (and hack-sig (not too-big))
- (setq end (funcall wl-highlight-signature-search-func
+ (setq end (funcall wl-highlight-signature-search-function
(- end wl-max-signature-size) end)))
(if hack-sig
(put-text-property end (point-max)
;; is sufficient
(if (re-search-forward (format
"^$\\|%s"
- (regexp-quote mail-header-separator))
+ (regexp-quote mail-header-separator))
nil t)
- (narrow-to-region (point-min) (point)))
+ (narrow-to-region (point-min) (match-beginning 0)))
;; highlight only when header is not too-big.
(when (or (null wl-highlight-max-header-size)
(< (point) wl-highlight-max-header-size))
(put-text-property
p hend 'face 'wl-highlight-message-header-contents)))
(goto-char hend))
- ((looking-at mail-header-separator)
- (put-text-property (match-beginning 0) (match-end 0)
- 'face 'wl-highlight-header-separator-face)
- (goto-char (match-end 0)))
;; ignore non-header field name lines
(t (forward-line 1))))))
(let (prefix prefix-face-alist pair end)
(while (not (eobp))
(cond
+ ((looking-at mail-header-separator)
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'wl-highlight-header-separator-face)
+ (goto-char (match-end 0)))
((null wl-highlight-force-citation-header-regexp)
nil)
((looking-at wl-highlight-force-citation-header-regexp)
(cond (current
(setq p (point))
(forward-line 1) ; this is to put the \n in the face too
- (let ();(inhibit-read-only t))
+ (let ()
+;;; ((inhibit-read-only t))
(put-text-property p (or end (point))
'face current)
(setq end nil))
(inhibit-read-only t))
(put-text-property beg end 'mouse-face 'highlight)))
+(require 'product)
+(product-provide (provide 'wl-highlight) (require 'wl-version))
+
;;; wl-highlight.el ends here