From: ueno <ueno>
Date: Mon, 11 Sep 2000 10:47:54 +0000 (+0000)
Subject: * liece-minibuf.el: Autoload `completing-read-multiple'; declare
X-Git-Tag: liece-1_4_4-1~21
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4474bbe3792887d46fe9acbaf0415c325e09c905;p=elisp%2Fliece.git

* liece-minibuf.el: Autoload `completing-read-multiple'; declare
`crm-separator'.
(liece-minibuffer-completing-read): Rename from
`liece-minibuffer-completing-default-read'; accept optional arguments
`history' and `default'.
(liece-minibuffer-completion-separator): New variable.
(liece-minibuffer-completion-table): New variable.
(liece-minibuffer-completing-read-multiple-1): New completion function.
(liece-minibuffer-completing-read-multiple): Rename from
`liece-minibuffer-completing-sequential-read'; accept optional
arguments `history' and `default'; use `completing-read-multiple'
when optional 8th argument `multiple-candidate' is specified.

* liece-xemacs.el (liece-xemacs-redisplay-unread-mark): Don't bind `chnl'.

* liece-commands.el (liece-command-join,liece-command-part,
liece-command-ban,liece-command-ban-kick,liece-command-list,
liece-command-modec,liece-command-mode+o,liece-command-mode-o,
liece-command-mode+v,liece-command-mode-v,liece-command-message,
liece-command-mta-private,liece-command-names,liece-command-who,
liece-command-private-conversation,liece-command-activate-friends,
liece-command-userhost): Follow `liece-minibuf' changes.

* liece-ctcp.el (liece-minibuffer-complete-client-query,
liece-complete-client): Follow `liece-minibuf' changes.

* liece-dcc.el (liece-command-dcc-chat-listen,
liece-command-dcc-send): Follow `liece-minibuf'	changes.

* liece-mail.el (liece-command-mail-compose): Follow
`liece-minibuf' changes.

* liece-url.el (liece-command-browse-url): Use `completing-read'
instead of `liece-minibuffer-completing-default-read'.

* liece-window.el (liece-command-set-window-style): Follow
`liece-minibuf' changes.

* liece.el (liece-start-server): Follow	`liece-minibuf' changes.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9717630..8d767ca 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,22 @@
 2000-09-11   Daiki Ueno  <ueno@unixuser.org>
 
+	* liece-minibuf.el: Autoload `completing-read-multiple'; declare
+	`crm-separator'.
+	(liece-minibuffer-completing-read): Rename from
+	`liece-minibuffer-completing-default-read'; accept optional arguments
+	`history' and `default'.
+	(liece-minibuffer-completion-separator): New variable.
+	(liece-minibuffer-completion-table): New variable.
+	(liece-minibuffer-completing-read-multiple-1): New completion function.
+	(liece-minibuffer-completing-read-multiple): Rename from
+	`liece-minibuffer-completing-sequential-read'; accept optional
+	arguments `history' and `default'; use `completing-read-multiple'
+	when optional 8th argument `multiple-candidate' is specified.
+
+	* liece-xemacs.el (liece-xemacs-redisplay-unread-mark): Don't bind `chnl'.
+
+2000-09-11   Daiki Ueno  <ueno@unixuser.org>
+
 	* liece-commands.el (liece-command-quit): Don't send QUIT.
 
 	* liece-emacs.el (liece-emacs-splash): Use `generate-new-buffer'
diff --git a/lisp/liece-commands.el b/lisp/liece-commands.el
index 8d3331e..de437de 100644
--- a/lisp/liece-commands.el
+++ b/lisp/liece-commands.el
@@ -224,14 +224,13 @@ with specified user."
 	       current-prefix-arg
 	     (liece-channel-virtual
 	      (if (eq liece-command-buffer-mode 'chat)
-		  (liece-minibuffer-completing-default-read
+		  (liece-minibuffer-completing-read
 		   (_ "Start private conversation with: ")
-		   liece-nick-alist
-		   nil nil liece-privmsg-partner)
-		(liece-minibuffer-completing-default-read
+		   liece-nick-alist nil nil nil nil liece-privmsg-partner)
+		(liece-minibuffer-completing-read
 		 (_ "Join channel: ")
 		 (append liece-channel-alist liece-nick-alist)
-		 nil nil liece-default-channel-candidate)))))
+		 nil nil nil nil liece-default-channel-candidate)))))
      (if (and current-prefix-arg
 	      (not (numberp current-prefix-arg)))
 	 (setq key
@@ -268,14 +267,14 @@ with specified user."
      (setq part-channel-var
 	   (liece-channel-virtual
 	    (if (eq liece-command-buffer-mode 'chat)
-		(liece-minibuffer-completing-default-read
+		(liece-minibuffer-completing-read
 		 (_ "End private conversation with: ")
 		 (list-to-alist liece-current-chat-partners)
-		 nil nil liece-current-chat-partner)
-	      (liece-minibuffer-completing-default-read
+		 nil nil nil nil liece-current-chat-partner)
+	      (liece-minibuffer-completing-read
 	       (_ "Part channel: ")
 	       (list-to-alist liece-current-channels)
-	       nil nil liece-current-channel))))
+	       nil nil nil nil liece-current-channel))))
      (when current-prefix-arg
        (setq part-msg (read-string (_ "Part Message: "))))
      (list part-channel-var part-msg)))
@@ -389,8 +388,8 @@ If SILENT is non-nil, don't notify current status."
 		     (concat nick "!" (liece-nick-get-user-at-host nick)))))
 		 nicks))
 	  ban nick msg)
-     (setq ban (liece-minibuffer-completing-default-read
-		(_ "Ban pattern: ") uahs nil nil
+     (setq ban (liece-minibuffer-completing-read
+		(_ "Ban pattern: ") uahs nil nil nil nil
 		(concat nick "!" (liece-nick-get-user-at-host nick))))
      (list ban)))
   (liece-send "MODE %s :+b %s"
@@ -410,8 +409,8 @@ If SILENT is non-nil, don't notify current status."
 	  ban nick msg)
      (setq nick (completing-read (_ "Kick out nickname: ")
 				 (list-to-alist nicks))
-	   ban (liece-minibuffer-completing-default-read
-		(_ "Ban pattern: ") uahs nil nil
+	   ban (liece-minibuffer-completing-read
+		(_ "Ban pattern: ") uahs nil nil nil nil
 		(concat nick "!" (liece-nick-get-user-at-host nick))))
      (if current-prefix-arg
 	 (setq msg (concat " :" (read-string (_ "Kick Message: "))))
@@ -432,9 +431,9 @@ With - as argument, list all channels."
        (if (eq current-prefix-arg '-)
 	   (list current-prefix-arg))
      (let ((completion-ignore-case t) channel)
-       (setq channel (liece-minibuffer-completing-default-read
+       (setq channel (liece-minibuffer-completing-read
 		      (_ "LIST channel: ")
-		      liece-channel-alist nil nil liece-current-channel))
+		      liece-channel-alist nil nil nil nil liece-current-channel))
        (unless (string-equal "" channel)
 	 (list channel)))))
   
@@ -463,10 +462,10 @@ Argument CHANGE ."
 	 liece-minibuffer-complete-function prompt)
      (if current-prefix-arg
 	 (setq chnl
-	       (liece-minibuffer-completing-default-read
+	       (liece-minibuffer-completing-read
 		(_ "Channel/User: ")
 		(append liece-channel-alist liece-nick-alist)
-		nil nil liece-current-channel)))
+		nil nil nil nil liece-current-channel)))
      (cond
       ((liece-channel-p (liece-channel-real chnl))
        (setq prompt (format
@@ -492,9 +491,8 @@ Argument CHANGE ."
      (setq nicks (filter-elements
                   nick nicks
                   (not (liece-nick-member nick opers)))
-	   opers (liece-minibuffer-completing-sequential-read
-		  (_ "Set Operator for") 0
-		  (list-to-alist nicks)))
+	   opers (liece-minibuffer-completing-read-multiple
+		  (_ "Assign operational privilege to: ") (list-to-alist nicks)))
      (list opers)))
   (let (ops)
     (dolist (oper opers)
@@ -516,9 +514,8 @@ Argument CHANGE ."
   (interactive
    (let ((completion-ignore-case t)
 	 (opers (liece-channel-get-operators)) oper nicks)
-     (setq nicks (liece-minibuffer-completing-sequential-read
-		  (_ "Unset Operator for") 0
-		  (list-to-alist opers)))
+     (setq nicks (liece-minibuffer-completing-read-multiple
+		  (_ "Divest operational privilege from: ") (list-to-alist opers)))
      (list nicks)))
   (let (ops)
     (dolist (oper opers)
@@ -546,8 +543,8 @@ Argument CHANGE ."
 	 (count 0))
      (setq nicks (filter-elements nick nicks
 		   (not (string-assoc-ignore-case nick voices)))
-	   voices (liece-minibuffer-completing-sequential-read
-		   (_ "Set Voice for") 0 (list-to-alist nicks)))
+	   voices (liece-minibuffer-completing-read-multiple
+		   (_ "Allow to speak: ") (list-to-alist nicks)))
      (list voices)))
   (let (vcs)
     (dolist (voice voices)
@@ -569,8 +566,8 @@ Argument CHANGE ."
   (interactive
    (let ((completion-ignore-case t)
 	 (voices (liece-channel-get-voices)) voice nicks)
-     (setq nicks (liece-minibuffer-completing-sequential-read
-		  (_ "Unset Voice for") 0 (list-to-alist voices)))
+     (setq nicks (liece-minibuffer-completing-read-multiple
+		  (_ "Forbid to speak: ") (list-to-alist voices)))
      (list nicks)))
   (let (vcs)
     (dolist (voice voices)
@@ -593,10 +590,10 @@ Argument CHANGE ."
    (let ((completion-ignore-case t) address)
      (setq address
 	   (liece-channel-virtual
-	    (liece-minibuffer-completing-default-read
+	    (liece-minibuffer-completing-read
 	     (_ "Private message to: ")
 	     (append liece-nick-alist liece-channel-alist)
-	     nil nil liece-privmsg-partner)))
+	     nil nil nil nil liece-privmsg-partner)))
      (list address
 	   (read-string
 	    (format
@@ -617,10 +614,10 @@ Argument CHANGE ."
    (let ((completion-ignore-case t))
      (setq liece-privmsg-partner
 	   (liece-channel-virtual
-	    (liece-minibuffer-completing-default-read
+	    (liece-minibuffer-completing-read
 	     (_ "To whom: ")
 	     (append liece-nick-alist liece-channel-alist)
-	     nil nil liece-privmsg-partner)))
+	     nil nil nil nil liece-privmsg-partner)))
      (list liece-privmsg-partner)))
   (let ((message (buffer-substring (progn (beginning-of-line) (point))
 				   (progn (end-of-line) (point)))))
@@ -639,9 +636,9 @@ With - as argument, list all channels."
        (if (eq current-prefix-arg '-)
 	   (list current-prefix-arg))
      (let ((completion-ignore-case t) expr)
-       (setq expr (liece-minibuffer-completing-default-read
+       (setq expr (liece-minibuffer-completing-read
 		      (_ "Names on channel: ")
-		      liece-channel-alist nil nil liece-current-channel))
+		      liece-channel-alist nil nil nil nil liece-current-channel))
        (unless (string-equal "" expr)
 	 (list expr)))))
   (when (or (and (eq expr '-)
@@ -672,7 +669,7 @@ With - as argument, list all users."
        (if (eq current-prefix-arg '-)
 	   (list current-prefix-arg))
      (let ((completion-ignore-case t) expr)
-       (setq expr (liece-minibuffer-completing-default-read
+       (setq expr (completing-read
 		   (_ "WHO expression: ")
 		   (append liece-channel-alist liece-nick-alist)))
        (unless (string-equal "" expr)
@@ -999,10 +996,10 @@ Argument ARG is prefix argument of toggle status."
       (if current-prefix-arg
 	  ;; prefixed, ask where to continue
 	  (if (eq liece-command-buffer-mode 'chat)
-	      (liece-minibuffer-completing-default-read
+	      (liece-minibuffer-completing-read
 	       (_ "Return to channel: ")
 	       (append liece-channel-alist liece-nick-alist)
-	       nil nil liece-current-channel)
+	       nil nil nil nil liece-current-channel)
 	    (completing-read
 	     (_ "Start private conversation with: ")
 	     liece-nick-alist nil nil))
@@ -1144,8 +1141,8 @@ Argument ARG is prefix argument of toggle status."
   "IsON users NICKS."
   (interactive
    (let (nicks (completion-ignore-case t))
-     (setq nicks (liece-minibuffer-completing-sequential-read
-		  "IsON" 0 liece-nick-alist))
+     (setq nicks (liece-minibuffer-completing-read-multiple
+		  "IsON" liece-nick-alist))
      (list nicks)))
   (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
 
@@ -1154,8 +1151,8 @@ Argument ARG is prefix argument of toggle status."
   (interactive
    (let (nicks (completion-ignore-case t))
      (setq nicks
-	   (liece-minibuffer-completing-sequential-read
-	    (_ "Friend") 0
+	   (liece-minibuffer-completing-read-multiple
+	    (_ "Friend")
 	    (filter-elements nick liece-nick-alist
 	      (not (string-list-member-ignore-case
 		    (car nick) liece-friends)))))
@@ -1182,8 +1179,8 @@ Argument ARG is prefix argument of toggle status."
   "Ask for the hostnames of NICKS."
   (interactive
    (let (nicks (completion-ignore-case t))
-     (setq nicks (liece-minibuffer-completing-sequential-read
-		  (_ "Userhost nick") 0
+     (setq nicks (liece-minibuffer-completing-read-multiple
+		  (_ "Userhost nick")
 		  (list-to-alist liece-nick-alist)))
      (list nicks)))
   (liece-send "USERHOST :%s" (mapconcat 'identity nicks ",")))
diff --git a/lisp/liece-ctcp.el b/lisp/liece-ctcp.el
index 230e772..ec97b2b 100644
--- a/lisp/liece-ctcp.el
+++ b/lisp/liece-ctcp.el
@@ -479,8 +479,8 @@
 
 (defmacro liece-complete-client ()
   '(let ((completion-ignore-case t) (nick liece-ctcp-last-nick))
-     (liece-minibuffer-completing-default-read
-      (_ "Whose client: ") liece-nick-alist nil nil
+     (liece-minibuffer-completing-read
+      (_ "Whose client: ") liece-nick-alist nil nil nil nil
       (if nick (liece-channel-virtual nick)))))
 
 (defun liece-minibuffer-complete-client-query ()
@@ -529,10 +529,10 @@
     (if arg
 	(setq liece-privmsg-partner 
 	      (liece-channel-virtual
-	       (liece-minibuffer-completing-default-read 
+	       (liece-minibuffer-completing-read 
 		(_ "To whom: ")
 		(append liece-nick-alist liece-channel-alist)
-		nil nil liece-privmsg-partner))))
+		nil nil nil nil liece-privmsg-partner))))
     (beginning-of-line)
     (setq message (buffer-substring (point)(progn (end-of-line)(point))))
     (if (string= message "")
diff --git a/lisp/liece-dcc.el b/lisp/liece-dcc.el
index b519830..4963610 100644
--- a/lisp/liece-dcc.el
+++ b/lisp/liece-dcc.el
@@ -103,10 +103,10 @@
 	  (read-file-name
 	   (_ "File to send: ")
 	   default-directory nil))
-	 (liece-minibuffer-completing-default-read
+	 (liece-minibuffer-completing-read
 	  (_ "To whom: ")
 	  (append liece-nick-alist liece-channel-alist)
-	  nil nil liece-privmsg-partner)))
+	  nil nil nil nil liece-privmsg-partner)))
 
   (setq liece-privmsg-partner towhom)
   (let (process)
@@ -214,10 +214,10 @@
 
 (defun liece-command-dcc-chat-listen (towhom)
   (interactive
-   (list (liece-minibuffer-completing-default-read
+   (list (liece-minibuffer-completing-read
 	  (_ "With whom: ")
 	  (append liece-nick-alist liece-channel-alist)
-	  nil nil liece-privmsg-partner)))
+	  nil nil nil nil liece-privmsg-partner)))
   (setq liece-privmsg-partner towhom)
   (let (process)
     (as-binary-process
diff --git a/lisp/liece-mail.el b/lisp/liece-mail.el
index d8ceab1..645c934 100644
--- a/lisp/liece-mail.el
+++ b/lisp/liece-mail.el
@@ -50,8 +50,8 @@
   (interactive
    (let ((completion-ignore-case t))
      (list
-      (liece-minibuffer-completing-default-read
-       "To whom: " liece-nick-alist nil nil liece-current-chat-partner))))
+      (liece-minibuffer-completing-read
+       "To whom: " liece-nick-alist nil nil nil nil liece-current-chat-partner))))
   (let ((composefunc (get mail-user-agent 'composefunc)) (to nick)
 	(user-agent (liece-version)) uah)
     (if (setq uah (liece-nick-get-user-at-host nick))
diff --git a/lisp/liece-minibuf.el b/lisp/liece-minibuf.el
index f0bbb53..5104d63 100644
--- a/lisp/liece-minibuf.el
+++ b/lisp/liece-minibuf.el
@@ -36,6 +36,9 @@
 (defvar liece-minibuffer-map nil)
 (defvar liece-minibuffer-complete-function nil)
 
+(autoload 'completing-read-multiple "crm")
+(defvar crm-separator)
+
 (unless liece-minibuffer-map
   (setq liece-minibuffer-map
 	(let ((map (make-sparse-keymap)))
@@ -149,33 +152,79 @@
     (_ "[Modes are: %s]")
     (mapconcat (function car) liece-supported-user-mode-alist ""))))
 
-(defun liece-minibuffer-completing-default-read
-  (prompt table &optional predicate require-match initial-input)
-  "Completing-read w/ default argument like in 'kill-buffer'."
-  (let ((default-read
-	  (completing-read
-	   (if initial-input
-	       (format "%s(default %s) " prompt initial-input)
-	     prompt)
-	   table predicate require-match nil)))
-    (if (and (string= default-read "") initial-input)
-	initial-input
-      default-read)))
-
-(defun liece-minibuffer-completing-sequential-read
-  (prompt &optional count table predicate require-match multiple-candidate)
-  "Execute completing-read w/ default argument consequently."
-  (let ((count (or count 0)) string result)
-    (while (progn
-	     (setq string
-		   (completing-read
-		    (format "%s (%d): " prompt (incf count))
-		    table predicate require-match nil))
-	     (or multiple-candidate
-		 (remove-alist 'table string))
-	     (not (string= "" string)))
-      (push string result))
-    result))
+(defun liece-minibuffer-completing-read
+  (prompt table &optional predicate require-match initial-input history default)
+  (completing-read
+   (if default
+       (format "%s(default %s) " prompt default)
+     prompt)
+   table predicate require-match nil))
+
+(defvar liece-minibuffer-completion-separator ","
+  "Separator used for separating strings in `liece-minibuffer-completing-read-multiple'.
+It should be regular expression which doesn't match word-continuent characters.")
+
+(defvar liece-minibuffer-completion-table nil)
+  
+(defun liece-minibuffer-completing-read-multiple-1 (string predicate flag)
+  "Function used by `liece-minibuffer-completing-read-multiple'.
+The value of STRING is the string to be completed.
+
+The value of PREDICATE is a function to filter possible matches, or
+nil if none.
+
+The value of FLAG is used to specify the type of completion operation.
+A value of nil specifies `try-completion'.  A value of t specifies
+`all-completions'.  A value of lambda specifes a test for an exact match.
+
+For more information on STRING, PREDICATE, and FLAG, see the Elisp
+Reference sections on 'Programmed Completion' and 'Basic Completion
+Functions'."
+  (let ((except
+	 (butlast
+	  (split-string string liece-minibuffer-completion-separator)))
+	(table
+	 (copy-sequence liece-minibuffer-completion-table))
+	lead)
+    (when (string-match
+	   (concat ".*" liece-minibuffer-completion-separator)
+	   string)
+      (setq lead (substring string 0 (match-end 0))
+	    string (substring string (match-end 0))))
+    (while except
+      (setq table (remassoc (car except) table)
+	    except (cdr except)))
+    (if (null flag)
+	(progn
+	  (setq string (try-completion string table predicate))
+	  (or (eq t string)
+	      (concat lead string)))
+      (if (eq flag 'lambda)
+	  (eq t (try-completion string table predicate))
+	(if flag
+	    (all-completions string table predicate))))))
+
+(defun liece-minibuffer-completing-read-multiple
+  (prompt table &optional predicate require-match initial-input
+	  history default multiple-candidate)
+  "Execute `completing-read' consequently.
+
+See the documentation for `completing-read' for details on the arguments:
+PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HISTORY, DEFAULT."
+  (let ((prompt
+	 (format "%s(punctuate by \"%s\") "
+		 prompt liece-minibuffer-completion-separator)))
+    (if multiple-candidate
+	(let ((crm-separator
+	       liece-minibuffer-completion-separator))
+	  (completing-read-multiple
+	   prompt table predicate require-match initial-input
+	   history default))
+      (let ((liece-minibuffer-completion-table
+	     table))
+	(completing-read
+	 prompt #'liece-minibuffer-completing-read-multiple-1
+	 predicate require-match initial-input history default)))))
 
 (provide 'liece-minibuf)
 
diff --git a/lisp/liece-url.el b/lisp/liece-url.el
index 3f478cf..a0e2033 100644
--- a/lisp/liece-url.el
+++ b/lisp/liece-url.el
@@ -82,8 +82,7 @@
    (let (url)
      (if (and current-prefix-arg (eq current-prefix-arg '-))
 	 (setq url (caar liece-url-alist))
-       (setq url (liece-minibuffer-completing-default-read
-		  (_ "Open URL:") liece-url-alist)))
+       (setq url (completing-read (_ "Open URL:") liece-url-alist)))
      (list url)))
   (let ((browse-url-browser-function liece-url-browser-function))
     (browse-url url)))
diff --git a/lisp/liece-window.el b/lisp/liece-window.el
index c9f9b77..5ae23c8 100644
--- a/lisp/liece-window.el
+++ b/lisp/liece-window.el
@@ -158,8 +158,8 @@
   (interactive
    (let ((styles (directory-files liece-window-style-directory)))
      (list
-      (liece-minibuffer-completing-default-read
-       "Window style: " (list-to-alist styles) nil t
+      (liece-minibuffer-completing-read
+       "Window style: " (list-to-alist styles) nil t nil nil
        liece-window-current-style))))
   (liece-window-load-style-file style))
 
diff --git a/lisp/liece-xemacs.el b/lisp/liece-xemacs.el
index 0bc60bc..a1bda48 100644
--- a/lisp/liece-xemacs.el
+++ b/lisp/liece-xemacs.el
@@ -583,9 +583,8 @@ If ARG is given, don't hide splash buffer."
 
 (defun liece-xemacs-redisplay-unread-mark ()
   (if liece-display-unread-mark
-    (let ((chnl))
       (dolist (chnl liece-channel-unread-list)
-        (liece-xemacs-unread-mark chnl)))))
+        (liece-xemacs-unread-mark chnl))))
 
 
 ;;; @ emulation functions
diff --git a/lisp/liece.el b/lisp/liece.el
index 539509f..7fc1eee 100644
--- a/lisp/liece.el
+++ b/lisp/liece.el
@@ -345,9 +345,7 @@ is running on."
     ;; Open IRC server.
     (when (or confirm (null liece-server))
       (setq liece-server
-	    (liece-minibuffer-completing-default-read
-	     (_ "IRC server: ")
-	     liece-server-alist)))
+	    (completing-read (_ "IRC server: ") liece-server-alist)))
     (and confirm
 	 liece-ask-for-nickname
 	 (setq liece-nickname