;;; liece-minibuf.el --- Minibuffer custom completion.
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Created: 1999-02-02
;; Revised: 1999-02-02
;; Keywords: minibuffer, completion

;; This file is part of Liece.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.


;;; Commentary:
;; 

;;; Code:

(require 'liece-compat)
(require 'liece-intl)
(require 'liece-nick)

(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)))
	  (set-keymap-parent map minibuffer-local-map)
	  (define-key map " " nil)
	  (define-key map "\t" 'liece-minibuffer-complete)
	  (define-key map "\r" 'exit-minibuffer)
	  (define-key map "\n" 'exit-minibuffer)
	  map)))

(defun liece-minibuffer-complete ()
  (interactive)
  (if (and liece-minibuffer-complete-function
	   (fboundp liece-minibuffer-complete-function))
      (funcall liece-minibuffer-complete-function)))

(defun liece-minibuffer-parse-modes ()
  (save-excursion
    (let (preceding-char (state 'flag) type)
      (beginning-of-buffer)
      (while (not (eobp))
	(forward-char)
	(setq preceding-char (char-before))
	(cond
	 ((and (eq state 'flag) (memq preceding-char '(+ ?-)))
	  (setq state 'mode
		type nil))
	 ((and (eq state 'mode) (eq preceding-char ? ))
	  (setq state 'arg))
	 ((and (eq state 'mode) (memq preceding-char '(?o ?v)))
	  (setq type (nconc type (list 'nick preceding-char
				       (char-before (1- (point)))))))
	 ((and (eq state 'mode) (eq preceding-char ?b))
	  (setq type (nconc type (list 'ban (char-before (1- (point)))))))))
      (cons state type))))

(defun liece-minibuffer-prepare-candidate ()
  (let ((point (point)))
    (skip-syntax-backward "^ ")
    (prog1 (buffer-substring (point) point)
      (goto-char point))))

(defun liece-minibuffer-delete-candidate ()
  (let ((point (point)))
    (skip-syntax-backward "^ ")
    (delete-region (point) point)))

(defun liece-minibuffer-finalize-completion (completion pattern all)
  (cond
   ((eq completion t))
   ((null completion)
    (temp-minibuffer-message (_ "[No match]")))
   ((not (string= pattern completion))
    (liece-minibuffer-delete-candidate)
    (insert completion))
   (t
    (with-output-to-temp-buffer "*Completions*"
      (funcall completion-display-completion-list-function
	       (sort all (function (lambda (x y)
				     (string-lessp
				      (or (car-safe x) x)
				      (or (car-safe y) y))))))))))

(defun liece-minibuffer-complete-channel-modes ()
  (let* ((preceding-char (char-before)) completion candidate all
	 (modes (mapconcat
		 (function car)
		 liece-supported-channel-mode-alist ""))
	 (nicks (liece-channel-get-nicks))
	 uahs
	 (context (liece-minibuffer-parse-modes))
	 (state (car context)) (type (cdr context)))
    (cond
     ((memq state '(flag mode))
      (temp-minibuffer-message
       (format (_ "[Modes are: %s]") modes)))
     ((and (eq state 'arg) (memq 'ban type))
      (if (memq ?- type)
	  (setq uahs (list-to-alist (liece-channel-get-bans)))
	(setq uahs (mapcar
		    (function
		     (lambda (nick)
		       (list (concat nick "!"
				     (liece-nick-get-user-at-host nick)))))
		    nicks)))
      (setq candidate (liece-minibuffer-prepare-candidate)
	    completion (try-completion candidate uahs)
	    all (all-completions candidate uahs)))
     ((and (eq state 'arg) (memq 'nick type))
      (let* ((masks (cond ((memq ?o type) (liece-channel-get-operators))
			  ((memq ?v type) (liece-channel-get-voices))))
	     (nicks
	      (if (memq ?- type)
		  masks
		(remove-if
		 `(lambda (item)
		    (and (stringp item)
			 (string-list-member-ignore-case item ',masks)))
		 nicks))))
	(setq nicks (mapcar (function list) nicks)
	      candidate (liece-minibuffer-prepare-candidate)
	      completion (try-completion candidate nicks)
	      all (all-completions candidate nicks)))))
    (liece-minibuffer-finalize-completion completion candidate all)))

(defun liece-minibuffer-complete-user-modes ()
  (temp-minibuffer-message
   (format
    (_ "[Modes are: %s]")
    (mapconcat (function car) liece-supported-user-mode-alist ""))))

(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 initial-input history default))

(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
	 (split-string string liece-minibuffer-completion-separator))
	(table
	 (copy-sequence liece-minibuffer-completion-table))
	lead)
    ;; Remove a partially matched word construct if it exists.
    (or (string-match
	 (concat liece-minibuffer-completion-separator "$")
	 string)
	(setq except (butlast except)))
    (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))
	(split-string
	 (completing-read
	  prompt #'liece-minibuffer-completing-read-multiple-1
	  predicate require-match initial-input history default)
	 liece-minibuffer-completion-separator)))))

(provide 'liece-minibuf)

;;; liece-minibuf.el ends here