X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-highlight.el;h=4391cf5e5691515d601a492dd05acb1c118a3a34;hb=98f38e5383840a86e4ebca5803d505110d0997f8;hp=ec8b5a16cb9e0b245082ce29154ebc359f78c258;hpb=68751f2017308e9e9f8b61eb6c7aa3f7a8d628b7;p=elisp%2Fwanderlust.git diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index ec8b5a1..4391cf5 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -1,4 +1,4 @@ -;;; wl-highlight.el -- Hilight modules for Wanderlust. +;;; wl-highlight.el --- Hilight modules for Wanderlust. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi @@ -40,8 +40,6 @@ (require 'wl-xmas)) (wl-on-emacs21 (require 'wl-e21)) - (wl-on-nemacs - (require 'wl-nemacs)) (t (require 'wl-mule))) (defun-maybe extent-begin-glyph (a)) @@ -720,43 +718,30 @@ wl-highlight-message-cited-text-9 wl-highlight-message-cited-text-10)) -(defmacro defun-hilit (name &rest everything-else) - "Define a function for highlight. Nemacs implementation is set as empty." - (if wl-on-nemacs - (` (defun (, name) nil nil)) - (` (defun (, name) (,@ everything-else))))) - -(defmacro defun-hilit2 (name &rest everything-else) - "Define a function for highlight w/o nemacs." - (if wl-on-nemacs - () ; noop - (` (defun (, name) (,@ everything-else))))) - (defmacro wl-delete-all-overlays () "Delete all momentary overlays." - (if wl-on-nemacs - nil - '(let ((overlays (overlays-in (point-min) (point-max))) - overlay) - (while (setq overlay (car overlays)) - (if (overlay-get overlay 'wl-momentary-overlay) - (delete-overlay overlay)) - (setq overlays (cdr overlays)))))) - -(defun-hilit wl-highlight-summary-displaying () + '(let ((overlays (overlays-in (point-min) (point-max))) + overlay) + (while (setq overlay (car overlays)) + (if (overlay-get overlay 'wl-momentary-overlay) + (delete-overlay overlay)) + (setq overlays (cdr overlays))))) + +(defun wl-highlight-summary-displaying () (interactive) (wl-delete-all-overlays) (let (bol eol ov) (save-excursion + (end-of-line) + (setq eol (point)) (beginning-of-line) (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) (setq ov (make-overlay bol eol)) (overlay-put ov 'face 'wl-highlight-summary-displaying-face) (overlay-put ov 'evaporate t) (overlay-put ov 'wl-momentary-overlay t)))) -(defun-hilit2 wl-highlight-folder-group-line (numbers) +(defun wl-highlight-folder-group-line (numbers) (end-of-line) (let ((eol (point)) bol) @@ -789,7 +774,7 @@ (put-text-property bol (match-end 0) 'face face))) (put-text-property bol eol 'face text-face))))) -(defun-hilit2 wl-highlight-summary-line-string (line mark temp-mark indent) +(defun wl-highlight-summary-line-string (line mark temp-mark indent) (let (fsymbol) (cond ((and (string= temp-mark "+") (member mark (list wl-summary-unread-cached-mark @@ -827,41 +812,33 @@ (if wl-use-highlight-mouse-line (put-text-property 0 (length line) 'mouse-face 'highlight line))) -(defun-hilit2 wl-highlight-summary-current-line (&optional smark regexp temp-too) +(defun wl-highlight-summary-current-line (&optional smark regexp temp-too) (interactive) (save-excursion (let ((inhibit-read-only t) (case-fold-search nil) temp-mark status-mark - (sregexp (concat - "^" - wl-summary-buffer-number-regexp - "\\(.\\)\\(.\\)../..\(.*\)..:.. \\(" - wl-highlight-thread-indent-string-regexp - "\\)[[<]")) - fregexp fsymbol bol eol matched thread-top looked-at) + (deactivate-mark nil) + fregexp fsymbol bol eol matched thread-top looked-at dest ds) + (end-of-line) + (setq eol (point)) (beginning-of-line) (setq bol (point)) - (save-excursion (end-of-line) (setq eol (point))) (if smark (setq status-mark smark) - (setq looked-at (looking-at sregexp)) - (setq status-mark (buffer-substring (match-beginning 2) - (match-end 2)))) + (setq status-mark (wl-summary-persistent-mark))) (when temp-too - (unless looked-at - (setq looked-at (looking-at sregexp))) - (when looked-at - (setq temp-mark (buffer-substring (match-beginning 1) - (match-end 1))) - (cond - ((string= temp-mark "*") - (setq fsymbol 'wl-highlight-summary-temp-face)) - ((string= temp-mark "D") - (setq fsymbol 'wl-highlight-summary-deleted-face)) - ((string= temp-mark "O") - (setq fsymbol 'wl-highlight-summary-copied-face)) - ((string= temp-mark "o") - (setq fsymbol 'wl-highlight-summary-refiled-face))))) + (setq temp-mark (wl-summary-temp-mark)) + (cond + ((string= temp-mark "*") + (setq fsymbol 'wl-highlight-summary-temp-face)) + ((string= temp-mark "D") + (setq fsymbol 'wl-highlight-summary-deleted-face)) + ((string= temp-mark "O") + (setq fsymbol 'wl-highlight-summary-copied-face + dest t)) + ((string= temp-mark "o") + (setq fsymbol 'wl-highlight-summary-refiled-face + dest t)))) (if (not fsymbol) (cond ((and (string= temp-mark "+") @@ -887,13 +864,21 @@ ((string= temp-mark "+") (setq fsymbol 'wl-highlight-summary-high-read-face)) ;; - (t (if (and looked-at - (string= (buffer-substring - (match-beginning 3) - (match-end 3)) "")) + (t (if (null + (wl-thread-entity-get-parent-entity + (wl-thread-get-entity (wl-summary-message-number)))) (setq fsymbol 'wl-highlight-summary-thread-top-face) (setq fsymbol 'wl-highlight-summary-normal-face))))) (put-text-property bol eol 'face fsymbol) + (when dest + (put-text-property (next-single-property-change + (next-single-property-change + bol 'wl-summary-destination + nil eol) + 'wl-summary-destination nil eol) + eol + 'face + 'wl-highlight-refile-destination-face)) (if wl-use-highlight-mouse-line (put-text-property bol ;;; Use bol instead of (1- (match-end 0)) @@ -905,7 +890,7 @@ (if wl-use-dnd (wl-dnd-set-drag-starter bol eol))))) -(defun-hilit2 wl-highlight-folder (start end) +(defun wl-highlight-folder (start end) "Highlight folder between start and end. Faces used: wl-highlight-folder-unknown-face unread messages @@ -935,7 +920,7 @@ Variables used: (wl-highlight-folder-current-line) (forward-line 1))))))) -(defun-hilit2 wl-highlight-folder-path (folder-path) +(defun wl-highlight-folder-path (folder-path) "Highlight current folder path...overlay" (save-excursion (wl-delete-all-overlays) @@ -959,17 +944,17 @@ Variables used: (overlay-put ov 'wl-momentary-overlay t)) (forward-line 1))))) -(defun-hilit2 wl-highlight-refile-destination-string (string) +(defun wl-highlight-refile-destination-string (string) (put-text-property 0 (length string) 'face 'wl-highlight-refile-destination-face string)) -(defun-hilit wl-highlight-summary-all () +(defun wl-highlight-summary-all () "For evaluation" (interactive) (wl-highlight-summary (point-min)(point-max))) -(defun-hilit2 wl-highlight-summary (start end) +(defun wl-highlight-summary (start end &optional lazy) "Highlight summary between start and end. Faces used: wl-highlight-summary-unread-face unread messages @@ -999,17 +984,11 @@ Variables used: (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))) + (when (or (not lazy) + (null (get-text-property (point) 'face))) + (wl-highlight-summary-current-line nil nil + (or wl-summary-lazy-highlight + wl-summary-scored))) (forward-line 1)) (unless wl-summary-lazy-highlight (message "Highlighting...done"))))) @@ -1019,12 +998,11 @@ Variables used: 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)))) + (when (eq major-mode 'wl-summary-mode) + (wl-highlight-summary (window-start win) + (window-end win) + 'lazy) + (set-buffer-modified-p nil))))) (defun wl-highlight-headers (&optional for-draft) (let ((beg (point-min)) @@ -1033,47 +1011,21 @@ This function is defined for `window-scroll-functions'" (point-max)))) (wl-highlight-message beg end nil) (unless for-draft - (wl-highlight-message-add-buttons-to-header beg end) - (when 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))) (run-hooks 'wl-highlight-headers-hook))) -(defun wl-highlight-message-add-buttons-to-header (start end) - (save-excursion - (save-restriction - (narrow-to-region start end) - (let ((case-fold-search t) - (alist wl-highlight-message-header-button-alist) - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - (setq start (match-beginning 0) - end (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - (goto-char start) - (while (re-search-forward (nth 1 entry) end t) - (goto-char (match-end 0)) - (wl-message-add-button - (match-beginning (nth 2 entry)) - (match-end (nth 2 entry)) - (nth 3 entry) (match-string (nth 4 entry)))) - (goto-char end))))))) - (defun wl-highlight-body-all () (wl-highlight-message (point-min) (point-max) t t)) -(defun-hilit wl-highlight-body () +(defun wl-highlight-body () (let ((beg (or (save-excursion (goto-char (point-min)) (re-search-forward "^$" nil t)) (point-min))) (end (point-max))) (wl-highlight-message beg end t))) -(defun-hilit2 wl-highlight-body-region (beg end) +(defun wl-highlight-body-region (beg end) (wl-highlight-message beg end t t)) (defun wl-highlight-signature-search-simple (beg end) @@ -1116,7 +1068,7 @@ Returns start point of signature." (point))) ;; if no separator found, returns end. ))) -(defun-hilit2 wl-highlight-message (start end hack-sig &optional body-only) +(defun wl-highlight-message (start end hack-sig &optional body-only) "Highlight message headers between start and end. Faces used: wl-highlight-message-headers the part before the colon @@ -1158,9 +1110,10 @@ interpreted as cited text.)" (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 + (if (and hack-sig + (not (eq end real-end))) (put-text-property end (point-max) 'face 'wl-highlight-message-signature)) (narrow-to-region start end)