[Mew-dist 11958] mew-sort.el w/o imsort
Masaki KONUMA
masak at example.com
1999年 12月 30日 (木) 23:31:09 JST
Subject: [Mew-dist 11724] Re: mls
A> メッセージのヘッダをなめる imsort、imgrep は C で書きたい。
には反しますが、imsort 相当を elisp で書いてみました。
注意：
o 変数 mew-use-imsort が nil でなければ imsort を使用します。
o 速くなるとは限りません。perl が軽いマシンでは遅くなるはず。
o 正規表現は怪しいです。
-- 小沼雅樹
-------------- next part --------------
diff -u -r ../mew-1.95b16/mew-sort.el ./mew-sort.el
--- ../mew-1.95b16/mew-sort.el Mon Aug 30 12:43:15 1999
+++ ./mew-sort.el Thu Dec 30 22:44:23 1999
@@ -10,8 +10,98 @@
(require 'mew)
+(defun mew-summary-sort-encode-time (s)
+ (and
+ (stringp s)
+ (string-match
+ "\\([0-9]+\\)\\s-+\\(\\w+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\s-*\\([-+]?[0-9]*\\)\\s-*\(?\\(\\w*\\)?"
+ s) ; "Thu, 9 Dec 1999 22:19:32 +0900 (JST)"
+ (let ((year (string-to-number (match-string 3 s)))
+ (tz-num (match-string 8 s)))
+ (encode-time
+ (string-to-number (or (match-string 7 s) "")) ; SECOND
+ (string-to-number (match-string 5 s)) ; MINUTE
+ (string-to-number (match-string 4 s)) ; HOUR
+ (string-to-number (match-string 1 s)) ; DAY
+ (or (cdr (assoc (match-string 2 s)
+ '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4)
+ ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8)
+ ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))))
+ 0) ; MONTH
+ (if (< year 100)
+ (+ year (if (< year 50) 2000 1900))
+ year) ; YEAR
+ (if (string= tz-num "")
+ (or (cdr (assoc (match-string 9 s)
+ '(("PST" . -28800) ("PDT" . -25200) ("MST" . -25200)
+ ("MDT" . -21600) ("CST" . -21600) ("CDT" . -18000)
+ ("EST" . -18000) ("EDT" . -14400) ("AST" . -14400)
+ ("NST" . -10800) ("BST" . 3600) ("MET" . 3600)
+ ("EET" . 7200) ("JST" . 32400))))
+ 0)
+ (setq tz-num (string-to-number tz-num))
+ (* (+ (* (/ tz-num 100) 60) (% tz-num 100)) 60)))))) ; ZONE
+
+(defun mew-summary-sort-index (msgs field mode len)
+ (let ((param (make-vector len nil))
+ (case-fold-search t)
+ (field (concat field ":"))
+ (i 0) v)
+ ;; get field values
+ (while msgs
+ (aset
+ param i
+ (condition-case nil
+ (save-excursion
+ (mew-set-buffer-tmp default-directory)
+ (mew-frwlet mew-cs-autoconv mew-cs-dummy
+ (insert-file-contents
+ (car msgs) nil 0 mew-header-reasonable-size))
+ (setq v (mew-header-get-value field))
+ (cond
+ ((string= field "subject:")
+ (if (and (string= mode "ml")
+ (string-match
+ "^[\[\(]\\([^\]\)]*\\)[\]\)]\\(.*\\)$" v))
+ (let ((ml (match-string 1 v)) (s (match-string 2 v)) n)
+ (if (string-match "^\\(.*\\)[ :,\t]\\(.*\\)$" ml)
+ (setq n (match-string 2 ml) ml (match-string 1 ml)))
+ (string-match "^\\s-*\\(\\(re:\\s-*\\)*\\)\\(.*\\)$" s)
+ (concat ml (match-string 3 s) (match-string 1 s)
+ (and n (format "%08d" (string-to-number n)))))
+ (string-match "^\\s-*\\(\\(re:\\s-*\\)*\\)\\(.*\\)$" v)
+ (concat (match-string 3 v) (match-string 1 v))))
+ ((string= mode "num")
+ (string-match "\\([0-9]+\\)" v)
+ (string-to-number (match-string 1 v)))
+ ((string= mode "date")
+ (or (mew-summary-sort-encode-time v)
+ (mew-file-get-time (car msgs))))
+ (v)
+ ("")))
+ (error (or (cdr (assoc mode '(("date" 0 0) ("num" . 0)))) ""))))
+ (setq msgs (cdr msgs) i (1+ i)))
+ ;; sort index
+ (sort
+ (let ((i len) index) ; (0 1 2 3 ... len-1)
+ (while (> i 0) (setq index (cons (setq i (1- i)) index))) index)
+ (cond ((string= mode "date")
+ (function
+ (lambda (a b)
+ (setq a (aref param a) b (aref param b))
+ (or (< (car a) (car b))
+ (and (= (car a) (car b))
+ (< (car (cdr a)) (car (cdr b))))))))
+ ((string= mode "num")
+ (function
+ (lambda (a b) (< (aref param a) (aref param b)))))
+ (t
+ (function
+ (lambda (a b) (string< (aref param a) (aref param b)))))))))
+
(defun mew-summary-sort-subr (msgs &optional method from)
- (if (not (mew-summary-exclusive-p))
+ (if (or (not (mew-summary-exclusive-p))
+ (not (mew-folder-localp (buffer-name))))
()
(mew-mark-clean)
(let* ((folder (buffer-name))
@@ -22,18 +112,42 @@
(field (car field-mode))
(mode (cdr field-mode))
rbeg)
- (if (not (listp msgs)) (setq msgs (list msgs)))
- (setq mew-summary-buffer-process t)
- (message "Sorting %s by %s (%s mode) ... " folder field mode)
- (apply (function call-process)
- mew-prog-imsort
- nil nil nil
- (concat "--src=" folder)
- (concat "--field=" field)
- (concat "--mode=" mode)
- (append mew-prog-im-arg msgs)) ;; xxx
- (message "Sorting %s by %s ... done" folder field)
- (setq mew-summary-buffer-process nil)
+ (let ((mew-summary-buffer-process t))
+ (message "Sorting %s by %s (%s mode) ... " folder field mode)
+ (if mew-use-imsort
+ (apply (function call-process)
+ mew-prog-imsort
+ nil nil nil
+ (concat "--src=" folder)
+ (concat "--field=" field)
+ (concat "--mode=" mode)
+ (append mew-prog-im-arg
+ (if (listp msgs) msgs (list msgs)))) ;; xxx
+ (let* ((default-directory
+ (file-name-as-directory (mew-expand-folder folder)))
+ (len (length msgs))
+ (sorted-index
+ (vconcat (mew-summary-sort-index msgs field mode len)
+ '(nil)))
+ (msg-paths (vconcat msgs '(nil)))
+ (hole-path (mew-folder-new-message folder t))
+ (i 0) (tmp len) to from)
+ (while (< i len)
+ (cond ((and (not (eq i (aref sorted-index i)))
+ (aref sorted-index i))
+ (aset msg-paths tmp hole-path)
+ (aset sorted-index tmp i)
+ (setq to tmp)
+ (while
+ (progn (setq from (aref sorted-index to))
+ (or (aref sorted-index from) (setq from tmp))
+ (aset sorted-index to nil)
+ (rename-file (aref msg-paths from)
+ (aref msg-paths to))
+ (not (eq (setq to from) tmp))))))
+ (setq i (1+ i))))
+ (mew-touch-folder folder))
+ (message "Sorting %s by %s ... done" folder field))
(if from
(progn (mew-summary-jump-message from)
(setq rbeg (point)))) ;; beginning of region
@@ -58,23 +172,38 @@
"Sort messages in the region according to inputed key."
(interactive "r")
(mew-summary-only
- (let (from to)
- (save-excursion
- (goto-char (min r1 r2))
- (setq from
- (or (mew-summary-message-number)
- (progn
- (re-search-backward mew-summary-message-regex nil t)
- (mew-summary-message-number))))
- (goto-char (max r1 r2))
- (setq to
- (or (mew-summary-message-number)
- (progn
- (re-search-backward mew-summary-message-regex nil t)
- (mew-summary-message-number))))
- (goto-char (min r1 r2))
- (beginning-of-line)
- (mew-summary-sort-subr (concat from "-" to) method from)))))
+ (if mew-use-imsort
+ (let (from to)
+ (save-excursion
+ (goto-char (min r1 r2))
+ (setq from
+ (or (mew-summary-message-number)
+ (progn
+ (re-search-backward mew-summary-message-regex nil t)
+ (mew-summary-message-number))))
+ (goto-char (max r1 r2))
+ (setq to
+ (or (mew-summary-message-number)
+ (progn
+ (re-search-backward mew-summary-message-regex nil t)
+ (mew-summary-message-number))))
+ (goto-char (min r1 r2))
+ (beginning-of-line)
+ (mew-summary-sort-subr (concat from "-" to) method from)))
+ (let ((end (if (> r1 r2) r1 r2))
+ msgs from)
+ (save-excursion
+ (goto-char (min r1 r2))
+ (setq from
+ (or (mew-summary-message-number)
+ (progn
+ (re-search-backward mew-summary-message-regex nil t)
+ (mew-summary-message-number))))
+ (while (re-search-forward mew-summary-message-regex end t)
+ (setq msgs (cons (match-string 1) msgs)))
+ (goto-char (min r1 r2))
+ (beginning-of-line)
+ (mew-summary-sort-subr (nreverse msgs) method from))))))
(defun mew-summary-mark-sort (&optional r1 r2)
(interactive)
diff -u -r ../mew-1.95b16/mew-vars.el ./mew-vars.el
--- ../mew-1.95b16/mew-vars.el Tue Dec 28 17:00:38 1999
+++ ./mew-vars.el Tue Dec 28 20:07:24 1999
@@ -964,6 +964,10 @@
"*If non-nil, Mew uses 'immv' for refile. Otherwise, Mew
refiles messages by Elisp-version code.")
+(defvar mew-use-imsort nil
+ "*If non-nil, Mew uses 'imsort' for sort. Otherwise, Mew
+sorts messages by Elisp-version code.")
+
(defvar mew-use-text/enriched (equal mew-mule-ver 3)
"*If non-nil, Mew highlights enriched format text messages.")
Mew-dist メーリングリストの案内