cgit.sxemacs.org Git - riece/blob - lisp/riece-complete.el

   1 ;;; riece-complete.el --- completion
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1999-02-02
   6 ;; Keywords: minibuffer, completion
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))       ;butlast
  28
  29 (require 'riece-compat)
  30
  31 (defvar riece-minibuffer-map
  32   (let ((map (make-sparse-keymap)))
  33     (set-keymap-parent map minibuffer-local-map)
  34     (define-key map "?" 'riece-minibuffer-help)
  35     map))
  36
  37 (defvar riece-temp-minibuffer-message nil)
  38
  39 ;; stolen (and renamed) from XEmacs's minibuf.el.
  40 (defun riece-temp-minibuffer-message (message)
  41   (let ((end (point-max)))
  42     (save-excursion
  43       (goto-char (point-max))
  44       (message nil)
  45       (insert message))
  46     (let ((inhibit-quit t))
  47       (sit-for 2)
  48       (delete-region end (point-max)))))
  49
  50 (defun riece-minibuffer-help ()
  51   (interactive)
  52   (if riece-temp-minibuffer-message
  53       (riece-temp-minibuffer-message riece-temp-minibuffer-message)))
  54
  55 ;;; stolen (and renamed) from crm.el.
  56 (defvar riece-completing-read-multiple-separator ",")
  57 (defvar riece-completing-read-multiple-table nil)
  58
  59 (defun riece-completing-read-multiple-1 (string predicate flag)
  60   "Function used by `riece-completing-read-multiple'.
  61 The value of STRING is the string to be completed.
  62
  63 The value of PREDICATE is a function to filter possible matches, or
  64 nil if none.
  65
  66 The value of FLAG is used to specify the type of completion operation.
  67 A value of nil specifies `try-completion'.  A value of t specifies
  68 `all-completions'.  A value of lambda specifes a test for an exact match.
  69
  70 For more information on STRING, PREDICATE, and FLAG, see the Elisp
  71 Reference sections on 'Programmed Completion' and 'Basic Completion
  72 Functions'."
  73   (let ((except (split-string string riece-completing-read-multiple-separator))
  74         (table (copy-sequence riece-completing-read-multiple-table))
  75         lead)
  76     ;; Remove a partially matched word construct if it exists.
  77     (or (string-match
  78          (concat riece-completing-read-multiple-separator "$")
  79          string)
  80         (setq except (butlast except)))
  81     (when (string-match
  82            (concat ".*" riece-completing-read-multiple-separator)
  83            string)
  84       (setq lead (substring string 0 (match-end 0))
  85             string (substring string (match-end 0))))
  86     (while except
  87       (let ((entry (assoc (car except) table)))
  88         (if entry
  89             (setq table (delq entry table)))
  90         (setq except (cdr except))))
  91     (if (null flag)
  92         (progn
  93           (setq string (try-completion string table predicate))
  94           (or (eq t string)
  95               (concat lead string)))
  96       (if (eq flag 'lambda)
  97           (eq t (try-completion string table predicate))
  98         (if flag
  99             (all-completions string table predicate))))))
 100
 101 (defun riece-completing-read-multiple
 102   (prompt table &optional predicate require-match initial-input
 103           history default)
 104   "Execute `completing-read' consequently.
 105
 106 See the documentation for `completing-read' for details on the arguments:
 107 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HISTORY, DEFAULT."
 108   (let ((prompt
 109          (format "%s (separated by \"%s\"): "
 110                  prompt riece-completing-read-multiple-separator))
 111         (riece-completing-read-multiple-table table))
 112     (split-string
 113      (completing-read
 114       prompt #'riece-completing-read-multiple-1
 115       predicate require-match initial-input history default)
 116      riece-completing-read-multiple-separator)))
 117
 118 (provide 'riece-complete)
 119
 120 ;;; riece-complete.el ends here