lisp/liece-minibuf.el

   1 ;;; liece-minibuf.el --- Minibuffer custom completion.
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1999-02-02
   6 ;; Revised: 1999-02-02
   7 ;; Keywords: minibuffer, completion
   8
   9 ;; This file is part of Liece.
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (require 'liece-compat)
  33 (require 'liece-intl)
  34 (require 'liece-nick)
  35
  36 (defvar liece-minibuffer-map nil)
  37 (defvar liece-minibuffer-complete-function nil)
  38
  39 (unless liece-minibuffer-map
  40   (setq liece-minibuffer-map
  41         (let ((map (make-sparse-keymap)))
  42           (set-keymap-parent map minibuffer-local-map)
  43           (define-key map " " nil)
  44           (define-key map "\t" 'liece-minibuffer-complete)
  45           (define-key map "\r" 'exit-minibuffer)
  46           (define-key map "\n" 'exit-minibuffer)
  47           map)))
  48
  49 (defun liece-minibuffer-complete ()
  50   (interactive)
  51   (if (and liece-minibuffer-complete-function
  52            (fboundp liece-minibuffer-complete-function))
  53       (funcall liece-minibuffer-complete-function)))
  54
  55 (defun liece-minibuffer-parse-modes ()
  56   (save-excursion
  57     (let (preceding-char (state 'flag) type)
  58       (beginning-of-buffer)
  59       (while (not (eobp))
  60         (forward-char)
  61         (setq preceding-char (char-before))
  62         (cond
  63          ((and (memq state '(flag arg))
  64                (or (char-equal preceding-char ?+)
  65                    (char-equal preceding-char ?-)))
  66           (setq state 'mode
  67                 type nil))
  68          ((and (eq state 'mode) (char-equal preceding-char ? ))
  69           (setq state 'arg))
  70          ((and (eq state 'mode) (memq preceding-char '(?o ?v)))
  71           (setq type (nconc type (list 'nick preceding-char
  72                                        (char-before (1- (point)))))))
  73          ((and (eq state 'mode) (eq preceding-char ?b))
  74           (setq type (nconc type (list 'ban (char-before (1- (point)))))))))
  75       (cons state type))))
  76
  77 (defun liece-minibuffer-prepare-candidate ()
  78   (let ((point (point)))
  79     (skip-syntax-backward "^ ")
  80     (prog1 (buffer-substring (point) point)
  81       (goto-char point))))
  82
  83 (defun liece-minibuffer-delete-candidate ()
  84   (let ((point (point)))
  85     (skip-syntax-backward "^ ")
  86     (delete-region (point) point)))
  87
  88 (defun liece-minibuffer-finalize-completion (completion pattern all)
  89   (cond
  90    ((eq completion t))
  91    ((null completion)
  92     (temp-minibuffer-message (_ "[No match]")))
  93    ((not (string= pattern completion))
  94     (liece-minibuffer-delete-candidate)
  95     (insert completion))
  96    (t
  97     (with-output-to-temp-buffer "*Completions*"
  98       (funcall completion-display-completion-list-function
  99                (sort all (function (lambda (x y)
 100                                      (string-lessp
 101                                       (or (car-safe x) x)
 102                                       (or (car-safe y) y))))))))))
 103
 104 (defun liece-minibuffer-complete-channel-modes ()
 105   (let* ((preceding-char (char-before)) completion candidate all
 106          (modes (mapconcat
 107                  (function car)
 108                  liece-supported-channel-mode-alist ""))
 109          (nicks (liece-channel-get-nicks))
 110          uahs
 111          (context (liece-minibuffer-parse-modes))
 112          (state (car context)) (type (cdr context)))
 113     (cond
 114      ((memq state '(flag mode))
 115       (temp-minibuffer-message
 116        (format (_ "[Modes are: %s]") modes)))
 117      ((and (eq state 'arg) (memq 'ban type))
 118       (if (memq ?- type)
 119           (setq uahs (list-to-alist (liece-channel-get-bans)))
 120         (setq uahs (mapcar
 121                     (function
 122                      (lambda (nick)
 123                        (list (concat nick "!"
 124                                      (liece-nick-get-user-at-host nick)))))
 125                     nicks)))
 126       (setq candidate (liece-minibuffer-prepare-candidate)
 127             completion (try-completion candidate uahs)
 128             all (all-completions candidate uahs)))
 129      ((and (eq state 'arg) (memq 'nick type))
 130       (let* ((masks (cond ((memq ?o type) (liece-channel-get-operators))
 131                           ((memq ?v type) (liece-channel-get-voices))))
 132              (nicks
 133               (if (memq ?- type)
 134                   masks
 135                 (remove-if
 136                  (` (lambda (item)
 137                       (and (stringp item)
 138                            (string-list-member-ignore-case item '(, masks)))))
 139                  nicks))))
 140         (setq nicks (mapcar (function list) nicks)
 141               candidate (liece-minibuffer-prepare-candidate)
 142               completion (try-completion candidate nicks)
 143               all (all-completions candidate nicks)))))
 144     (liece-minibuffer-finalize-completion completion candidate all)))
 145
 146 (defun liece-minibuffer-complete-user-modes ()
 147   (temp-minibuffer-message
 148    (format
 149     (_ "[Modes are: %s]")
 150     (mapconcat (function car) liece-supported-user-mode-alist ""))))
 151
 152 (defun liece-minibuffer-completing-default-read
 153   (prompt table &optional predicate require-match initial-input)
 154   "Completing-read w/ default argument like in 'kill-buffer'."
 155   (let ((default-read
 156           (completing-read
 157            (if initial-input
 158                (format "%s(default %s) " prompt initial-input)
 159              prompt)
 160            table predicate require-match nil)))
 161     (if (and (string= default-read "") initial-input)
 162         initial-input
 163       default-read)))
 164
 165 (defun liece-minibuffer-completing-sequential-read
 166   (prompt &optional count table predicate require-match multiple-candidate)
 167   "Execute completing-read w/ default argument consequently."
 168   (let ((count (or count 0)) string result)
 169     (while (progn
 170              (setq string
 171                    (completing-read
 172                     (format "%s (%d): " prompt (incf count))
 173                     table predicate require-match nil))
 174              (or multiple-candidate
 175                  (remove-alist 'table string))
 176              (not (string= "" string)))
 177       (push string result))
 178     result))
 179
 180 (provide 'liece-minibuf)
 181
 182 ;;; liece-minibuf.el ends here