cgit.sxemacs.org Git - packages/blob - xemacs-packages/mew/mew/contrib/mew-summary-hl.el

   1 ;; -*- Mode: Emacs-Lisp -*-
   2 ;;  $Id: mew-summary-hl.el,v 1.1 2000-05-23 08:31:16 steveb Exp $
   3 ;;
   4 ;;                                "Hideyuki SHIRAI" <shirai@rdmg.mgcs.mei.co.jp>
   5 ;;
   6 ;;;; Mew Summary buffer \e$B$r\e(B font-lock \e$B$r;H$C$F?'IU$1$9$k\e(B
   7 ;;
   8 ;;;; \e$B;H$$J}\e(B: ~/.emacs \e$B$K=q$$$F$M\e(B
   9 ;;
  10 ;;; \e$B$3$l$,$"$k$HAGE(\e(B (\e$B$H$$$&$+L5$$$HCY$/$F;H$$J*$K$J$i$J$$\e(B)
  11 ;; (cond
  12 ;;  ((locate-library "lazy-shot")       ;; for XEmacs
  13 ;;   (require 'font-lock)
  14 ;;   (add-hook 'font-lock-mode-hook 'turn-on-lazy-shot)
  15 ;;   (setq lazy-shot-verbose nil)
  16 ;;   (setq lazy-shot-stealth-verbose nil))
  17 ;;  ((locate-library "lazy-lock")       ;; for Emacs
  18 ;;   (require 'font-lock)
  19 ;;   (setq font-lock-support-mode 'lazy-lock-mode)))
  20 ;;
  21 ;;; \e$BFbIt$G\e(B window-system \e$B$H$+$NH=Dj$O$7$F$$$^$;$s!#\e(B
  22 ;; (if (and (or window-system (string-match "XEmacs" emacs-version))
  23 ;;          (locate-library "mew-summary-hl"))
  24 ;;     (eval-after-load "mew" '(require 'mew-summary-hl)))
  25 ;;
  26 ;;;; \e$B;HMQ>e$NCm0U\e(B
  27 ;;; XEmacs \e$B$ONI$/$o$+$i$J$$$N$G!"JQ$@$C$?$i65$($F2<$5$$!#\e(B(_ _)
  28 ;;
  29
  30 (eval-when-compile (require 'mew))
  31 (defconst mew-summary-hl-version "mew-summary-hl 0.10")
  32
  33 ;; default \e$B$GBP>]$H$7$F$$$k\e(B ~/.im/Config \e$B$N\e(B 'From' \e$B$O0J2<$NDL$j\e(B
  34 ;;; imget.Form=%+4n %m%d %h:%E %+2KK %-24A %S || %b
  35 ;;; Form=%+4n %m%d/%y %+3KK %-24A %S || %b
  36 ;; PC \e$B$K$h$C$F$O\e(B %+2n \e$B$d\e(B %2Kk \e$B$H$$$&$N$b$"$k$N$G\e(B 'K' \e$B$H\e(B '24' \e$B$G7h$a$&$A\e(B
  37 (defvar mew-summary-hl-start-regex "^ *\\([1-9][0-9]* [^K]+K\\) ")
  38 ;;                                                   ~
  39 ;; \e$B$3$3$N\e(B space \e$B$rK:$l$J$$$G$M!#$3$l$G!"\e(Bmark \e$B$,$"$k$+$J$$$+H=Dj$7$F$$$^$9!#\e(B
  40 (defvar mew-summary-hl-from-width 24)
  41 (defvar mew-summary-hl-ml " *\\([\[(][^])\n\r]*[\])]\\)")
  42 (defvar mew-summary-hl-subject-regex1 " *\\(.*\\) +\\(\|\|[^\n\r]*\\)")
  43 (defvar mew-summary-hl-subject-regex2 " *\\([^\n\r]*\\)")
  44 ;; \e$B",\e(B \e$B:G8e$,\e(B '|' \e$B$G=*$k$H%@%a$@$1$I$40&7I\e(B
  45
  46 ;;; Form=%+5n %m%d %-14A %S || %b
  47 ;; \e$B$H$$$&\e(B IM \e$B$N\e(B default \e$B$@$C$?$i!"$3$s$J46$8!)\e(B
  48 ;; (setq mew-summary-hl-start-regex "^ *\\([1-9][0-9]* [^/]*[0-9]+/[0-9]+\\) ")
  49 ;; (setq mew-summary-hl-from-width 14)
  50 ;; \e$B$"$H$O<+J,$N4D6-$K9g$o$;$F2<$5$$!#\e(B(_ _)
  51
  52 ;; face \e$B$N=qBN$H?'$O$*9%$_$GJQ$($h$&!#\e(B
  53 ;; \e$B$3$N@_Dj$@$H\e(B http://www.netlaputa.ne.jp/~hshirai/Image/summary1.png
  54 ;; \e$B$N$h$&$K$J$j$^$9!#\e(B
  55 (defvar mew-sumamry-hl-face-list '("num" "from" "to" "ml" "subject" "body"))
  56
  57 (defvar mew-summary-hl-face-num-type 'italic)
  58 (defvar mew-summary-hl-face-num-color "Maroon")
  59
  60 (defvar mew-summary-hl-face-from-type 'bold)
  61 (defvar mew-summary-hl-face-from-color "Purple")
  62
  63 (defvar mew-summary-hl-face-to-type 'bold-italic)
  64 (defvar mew-summary-hl-face-to-color "DarkOrange3")
  65
  66 (defvar mew-summary-hl-face-ml-type 'italic)
  67 (defvar mew-summary-hl-face-ml-color "DarkGreen")
  68
  69 (defvar mew-summary-hl-face-subject-type 'bold)
  70 (defvar mew-summary-hl-face-subject-color "DarkGreen")
  71
  72 (defvar mew-summary-hl-face-body-type 'italic)
  73 (defvar mew-summary-hl-face-body-color "Grey50")
  74
  75 ;; MUE/MHC \e$B$J$I$N?'$E$1MQ4X?t$rDj5A$9$k\e(B
  76 (defvar mew-summary-hl-external-function nil)
  77
  78 ;; hook \e$B$NDI2C\e(B
  79 (add-hook 'mew-summary-mode-hook 'mew-summary-hl-enable)
  80 (add-hook 'mew-virtual-mode-hook 'mew-summary-hl-enable)
  81 (add-hook 'mew-summary-inc-sentinel-hook 'mew-summary-hl-block)
  82 (add-hook 'mew-summary-scan-sentinel-hook 'mew-summary-hl-block)
  83
  84 (if (locate-library "mew-refile-view")
  85     ;; \e$B$H$j$"$($:!#\e(B
  86     (add-hook 'mew-refile-view-mode-hook (lambda () (font-lock-mode 0))))
  87
  88 ;; \e$B<+A0$G$d$k$+$i\e(B nil \e$B$K$9$k\e(B
  89 (setq mew-use-highlight-mark nil)
  90
  91 (defun mew-summary-hl-enable ()
  92   (make-local-variable 'font-lock-fontify-buffer-function)
  93   (make-local-variable 'font-lock-fontify-region-function)
  94   (setq font-lock-fontify-buffer-function 'mew-summary-hl-buffer)
  95   (setq font-lock-fontify-region-function 'mew-summary-hl-region)
  96   (font-lock-mode 1))
  97
  98 (cond
  99  ((fboundp 'font-lock-fontify-block)
 100   (fset 'mew-summary-hl-block (symbol-function 'font-lock-fontify-block)))
 101  (t
 102   ;; \e$B$$$$2C8:$@$1$I\e(B XEmacs \e$BMQ\e(B
 103   (defun mew-summary-hl-block ()
 104     (font-lock-mode 1))))
 105
 106 (defun mew-summary-hl-buffer ()
 107   "Mew summary buffer highlight with font-lock-mode."
 108   (interactive)
 109   (mew-summary-hl-region (point-min) (point-max)))
 110
 111 (defun mew-summary-hl-region (beg end &optional loudly)
 112   "Mew summary region highlight with font-lock-mode."
 113   (interactive "r")
 114   (if (or (eq major-mode 'mew-summary-mode)
 115           (eq major-mode 'mew-virtual-mode))
 116       (mew-elet
 117        (goto-char beg)
 118        (beginning-of-line)
 119        (setq beg (point))
 120        (remove-text-properties beg end '(face nil))
 121        (while (< (point) end)
 122          (cond
 123           ;; \e$BIaDL$N9T\e(B
 124           ((looking-at mew-summary-hl-start-regex)
 125            (put-text-property (match-beginning 1) (match-end 1)
 126                               'face 'mew-summary-hl-face-num)
 127            (goto-char (match-end 0))
 128            (if (looking-at "To:")
 129                ;; \e$B<+J,$N%a!<%k\e(B
 130                (put-text-property (point)
 131                                   (progn (move-to-column
 132                                           (+ (current-column)
 133                                              mew-summary-hl-from-width))
 134                                          (point))
 135                                   'face 'mew-summary-hl-face-to)
 136              ;; \e$BB>$N?M$N%a!<%k\e(B
 137              (put-text-property (point)
 138                                 (progn (move-to-column
 139                                         (+ (current-column)
 140                                            mew-summary-hl-from-width))
 141                                        (point))
 142                                 'face 'mew-summary-hl-face-from))
 143            (if (not (looking-at mew-summary-hl-ml))
 144                ()
 145              ;; [mew-dist 0123] \e$B$d\e(B (pgp-users 1234) \e$B$,$"$C$?\e(B
 146              (put-text-property (match-beginning 1) (match-end 1)
 147                                 'face 'mew-summary-hl-face-ml)
 148              (goto-char (match-end 0)))
 149            (if (not (looking-at mew-summary-hl-subject-regex1))
 150                (if (looking-at mew-summary-hl-subject-regex2)
 151                    (put-text-property (match-beginning 1) (match-end 1)
 152                                       'face 'mew-summary-hl-face-subject))
 153              ;; || \e$B$N$"$H$N\e(B body \e$B$,$"$C$?\e(B
 154              (put-text-property (match-beginning 1) (match-end 1)
 155                                 'face 'mew-summary-hl-face-subject)
 156              (put-text-property (match-beginning 2) (match-end 2)
 157                                 'face 'mew-summary-hl-face-body)))
 158           ;; mark \e$B$,IU$$$F$$$k9T\e(B
 159           ((looking-at (concat mew-summary-message-regex "\\([^ ]\\)"))
 160            (let (face)
 161              (setq face (cdr (assoc (string-to-char (mew-match 2))
 162                                     mew-highlight-mark-keywords)))
 163              (if face
 164                  (put-text-property (point) (progn (end-of-line) (point))
 165                                     'face face)
 166                ;; multipart part 2
 167                (put-text-property (point) (progn (end-of-line) (point))
 168                                   'face 'mew-summary-hl-face-num))))
 169           ;; \e$B$=$NB>$N9T\e(B(\e$BIaDL$N?M$O\e(B multi part \e$B$rE83+$7$?9T\e(B)
 170           (t
 171            (or (and mew-summary-hl-external-function
 172                     ;; MUE \e$B$N\e(B subject \e$B9T$d\e(B MHC \e$B$N\e(B Virtual folder \e$B$N?'$E$1$r$9$k\e(B
 173                     ;; \e$B?'$E$1BP>]9T$G$J$+$C$?$i\e(B 'nil' \e$B$rJV$7$F$b$i$&\e(B
 174                     (funcall mew-summary-hl-external-function))
 175                (put-text-property (point) (progn (end-of-line) (point))
 176                                   'face 'mew-summary-hl-face-num))))
 177          (forward-line)))))
 178
 179 (defun mew-summary-hl-setup ()
 180   (let ((flist mew-sumamry-hl-face-list)
 181         fname type color)
 182     (mapcar
 183      '(lambda (face)
 184         (setq type (intern-soft
 185                     (concat "mew-summary-hl-face-" face "-type")))
 186         (setq color (intern-soft
 187                      (concat "mew-summary-hl-face-" face "-color")))
 188         (setq fname (intern (concat "mew-summary-hl-face-" face)))
 189         (copy-face (symbol-value type) fname)
 190         (set-face-foreground fname (symbol-value color)))
 191      flist)))
 192
 193 ;; load \e$B$7$?$H$-$K\e(B face \e$B$r:n$C$F$7$^$&!#\e(B
 194 (mew-summary-hl-setup)
 195
 196 (provide 'mew-summary-hl)
 197
 198 ;; ends here.