X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=wl%2Fwl-highlight.el;h=bbb0e1fe10781b9cb5188ad14c272fd876e9c850;hb=b9521e198d3bedd260d45af2b00ad9177a097e2e;hp=f323e23e6b31c0afa1ff1d62833512f294a07bc5;hpb=1f14d57546ab3ec1069d0872efb0a086f492db91;p=elisp%2Fwanderlust.git diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index f323e23..bbb0e1f 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,30 +718,16 @@ 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) @@ -757,7 +741,7 @@ (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) @@ -790,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 @@ -828,18 +812,19 @@ (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 + (deactivate-mark nil) (sregexp (concat "^" wl-summary-buffer-number-regexp "\\(.\\)\\(.\\)../..\(.*\)..:.. \\(" wl-highlight-thread-indent-string-regexp "\\)[[<]")) - fregexp fsymbol bol eol matched thread-top looked-at) + fregexp fsymbol bol eol matched thread-top looked-at dest ds) (end-of-line) (setq eol (point)) (beginning-of-line) @@ -862,9 +847,11 @@ ((string= temp-mark "D") (setq fsymbol 'wl-highlight-summary-deleted-face)) ((string= temp-mark "O") - (setq fsymbol 'wl-highlight-summary-copied-face)) + (setq fsymbol 'wl-highlight-summary-copied-face + dest t)) ((string= temp-mark "o") - (setq fsymbol 'wl-highlight-summary-refiled-face))))) + (setq fsymbol 'wl-highlight-summary-refiled-face + dest t))))) (if (not fsymbol) (cond ((and (string= temp-mark "+") @@ -897,6 +884,15 @@ (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)) @@ -908,7 +904,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 @@ -938,7 +934,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) @@ -962,17 +958,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) "Highlight summary between start and end. Faces used: wl-highlight-summary-unread-face unread messages @@ -994,29 +990,28 @@ Variables used: (let ((s start)) (setq start end end s))) (let (lines too-big gc-message e p hend i percent) (save-excursion - (save-match-data - (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")))))) + (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. @@ -1037,47 +1032,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) @@ -1120,7 +1089,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 @@ -1162,9 +1131,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)