[Mew-dist 06028] uniqfy
Kazu Yamamoto ( 山本和彦 )
kazu at example.com
1998年 8月 20日 (木) 15:21:45 JST
mew-refile.el で使われている mew-refile-list-uniq という関数は、セルを
いっぱい消費する悪い子でした。
本日開催された itojun 先生による Lisp 教室の演習問題として、よい子の
(「禁断の」ともいう) mew-uniq-list を作ってみましたのでお試し下さい。
ないとは思いますが、副作用バリバリかもしれません。
あと、mew-refile.el 中の delq はどうも delete の方が正しいと思われるの
で、全部置換しました。eq じゃなくて equal を期待しているんでしょう？
> nom さん
--かず
Index: mew-func.el
===================================================================
RCS file: /usr/local/cvsroot/Mew/mew/mew-func.el,v
retrieving revision 1.36
diff -c -r1.36 mew-func.el
*** mew-func.el 1998/08/19 09:48:01 1.36
--- mew-func.el 1998/08/20 06:11:01
***************
*** 43,48 ****
--- 43,53 ----
(setq list (cdr list))
(setq n (1+ n))))))
+ (defmacro mew-uniq-list (lst)
+ (` (let ((tmp (, lst)))
+ (while tmp (setq tmp (delete (car tmp) (cdr tmp))))
+ (, lst))))
+
;;
;; Associative list functions
;;
Index: mew-refile.el
===================================================================
RCS file: /usr/local/cvsroot/Mew/mew/mew-refile.el,v
retrieving revision 1.38
diff -c -r1.38 mew-refile.el
*** mew-refile.el 1998/08/19 14:04:32 1.38
--- mew-refile.el 1998/08/20 06:11:03
***************
*** 110,116 ****
(setq funcs (cdr funcs)))
(setq info (nreverse info))
(if mew-refile-ctrl-multi
! (cons (mew-refile-list-uniq guess) info)
(cons (list (car guess)) info))))
;;
--- 110,116 ----
(setq funcs (cdr funcs)))
(setq info (nreverse info))
(if mew-refile-ctrl-multi
! (cons (mew-uniq-list guess) info)
(cons (list (car guess)) info))))
;;
***************
*** 168,174 ****
(setq ret (cons ent ret))))
(setq sublist (cdr sublist))))))
(setq alist (cdr alist)))
! (mew-refile-list-uniq (nreverse ret))))
(defun mew-refile-guess-by-alist2 (regexp field string)
(let ((p 1) match-list b e)
--- 168,174 ----
(setq ret (cons ent ret))))
(setq sublist (cdr sublist))))))
(setq alist (cdr alist)))
! (mew-uniq-list (nreverse ret))))
(defun mew-refile-guess-by-alist2 (regexp field string)
(let ((p 1) match-list b e)
***************
*** 201,208 ****
(setq ent (mew-assoc-case-equal (car newsgroups) mew-folder-alist 1))
(if ent (setq ret (cons (nth 0 ent) ret)))
(setq newsgroups (cdr newsgroups)))
! (setq ret (nreverse ret))
! (mew-refile-list-uniq ret))))
;;
;; by folder returns: (guess1 guess2 ...) or nil
--- 201,207 ----
(setq ent (mew-assoc-case-equal (car newsgroups) mew-folder-alist 1))
(if ent (setq ret (cons (nth 0 ent) ret)))
(setq newsgroups (cdr newsgroups)))
! (mew-uniq-list (nreverse ret)))))
;;
;; by folder returns: (guess1 guess2 ...) or nil
***************
*** 218,225 ****
(setq ret (cons (nth 0 ent) ret))
(mew-refile-treat-alias-insert (car to-cc)))
(setq to-cc (cdr to-cc)))
! (setq ret (nreverse ret))
! (mew-refile-list-uniq ret)))
;;
;; by message-id returns: guess1 or nil
--- 217,223 ----
(setq ret (cons (nth 0 ent) ret))
(mew-refile-treat-alias-insert (car to-cc)))
(setq to-cc (cdr to-cc)))
! (mew-uniq-list (nreverse ret))))
;;
;; by message-id returns: guess1 or nil
***************
*** 273,280 ****
(setq ent (mew-refile-guess-by-from (car to-cc)))
(if ent (setq ret (cons ent ret)))
(setq to-cc (cdr to-cc)))
! (setq ret (nreverse ret))
! (mew-refile-list-uniq ret))
())))
;;
--- 271,277 ----
(setq ent (mew-refile-guess-by-from (car to-cc)))
(if ent (setq ret (cons ent ret)))
(setq to-cc (cdr to-cc)))
! (mew-uniq-list (nreverse ret)))
())))
;;
***************
*** 440,449 ****
(message "...")
;; delete from alias-alist and from-alist
(setq mew-refile-from-alist
! (delq (assoc addr mew-refile-from-alist) mew-refile-from-alist))
(setq ent (assoc user mew-alias-alist))
(if (equal addr (cdr ent))
! (setq mew-alias-alist (delq ent mew-alias-alist)))
;; save from-alist for safety
(mew-refile-alist-save mew-refile-from-file-name mew-refile-from-alist)
;; delete address in screen.
--- 437,446 ----
(message "...")
;; delete from alias-alist and from-alist
(setq mew-refile-from-alist
! (delete (assoc addr mew-refile-from-alist) mew-refile-from-alist))
(setq ent (assoc user mew-alias-alist))
(if (equal addr (cdr ent))
! (setq mew-alias-alist (delete ent mew-alias-alist)))
;; save from-alist for safety
(mew-refile-alist-save mew-refile-from-file-name mew-refile-from-alist)
;; delete address in screen.
***************
*** 471,484 ****
;; if key is already exists, move it to the top of the alist.
(if (setq value (assoc addr mew-refile-from-alist))
(setq mew-refile-from-alist
! (cons value (delq value mew-refile-from-alist)))
(setq mew-refile-from-alist
(cons (cons addr nil) mew-refile-from-alist)))
;; also Add to mew-alias-alist
(setq mew-alias-alist
(cons
(cons key addr)
! (delq (assoc key mew-alias-alist) mew-alias-alist)))
;; save from-alist for safety
(mew-refile-alist-save mew-refile-from-file-name mew-refile-from-alist)
(message "Alias for %s is added." addr)))))
--- 468,481 ----
;; if key is already exists, move it to the top of the alist.
(if (setq value (assoc addr mew-refile-from-alist))
(setq mew-refile-from-alist
! (cons value (delete value mew-refile-from-alist)))
(setq mew-refile-from-alist
(cons (cons addr nil) mew-refile-from-alist)))
;; also Add to mew-alias-alist
(setq mew-alias-alist
(cons
(cons key addr)
! (delete (assoc key mew-alias-alist) mew-alias-alist)))
;; save from-alist for safety
(mew-refile-alist-save mew-refile-from-file-name mew-refile-from-alist)
(message "Alias for %s is added." addr)))))
***************
*** 488,504 ****
;;; common routines for (a)list
;;;
- (defun mew-refile-list-uniq (lst)
- (let (ret)
- (while lst
- (if (not (member (car lst) ret))
- (setq ret (cons (car lst) ret)))
- (setq lst (cdr lst)))
- (nreverse ret)))
-
(defun mew-refile-alist-purge (key alist)
(let ((a alist))
! (delq (assoc key a) a)))
(defun mew-refile-alist-load (filename)
(let ((alist nil)
--- 485,493 ----
;;; common routines for (a)list
;;;
(defun mew-refile-alist-purge (key alist)
(let ((a alist))
! (delete (assoc key a) a)))
(defun mew-refile-alist-load (filename)
(let ((alist nil)
Mew-dist メーリングリストの案内