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 (require 'riece-compat)
  28
  29 (defvar riece-minibuffer-map
  30   (let ((map (make-sparse-keymap)))
  31     (set-keymap-parent map minibuffer-local-map)
  32     (define-key map "?" 'riece-minibuffer-help)
  33     map))
  34
  35 (defvar riece-temp-minibuffer-message nil)
  36
  37 ;; stolen (and renamed) from XEmacs's minibuf.el.
  38 (defun riece-temp-minibuffer-message (message)
  39   (let ((end (point-max)))
  40     (save-excursion
  41       (goto-char (point-max))
  42       (message nil)
  43       (insert message))
  44     (let ((inhibit-quit t))
  45       (sit-for 2)
  46       (delete-region end (point-max)))))
  47
  48 (defun riece-minibuffer-help ()
  49   (interactive)
  50   (if riece-temp-minibuffer-message
  51       (riece-temp-minibuffer-message riece-temp-minibuffer-message)))
  52
  53 ;;; stolen (and renamed) from crm.el.
  54 (defvar riece-completing-read-multiple-separator ",")
  55 (defvar riece-completing-read-multiple-table nil)
  56
  57 (defun riece-completing-read-multiple-1 (string predicate flag)
  58   "Function used by `riece-completing-read-multiple'.
  59 The value of STRING is the string to be completed.
  60
  61 The value of PREDICATE is a function to filter possible matches, or
  62 nil if none.
  63
  64 The value of FLAG is used to specify the type of completion operation.
  65 A value of nil specifies `try-completion'.  A value of t specifies
  66 `all-completions'.  A value of lambda specifes a test for an exact match.
  67
  68 For more information on STRING, PREDICATE, and FLAG, see the Elisp
  69 Reference sections on 'Programmed Completion' and 'Basic Completion
  70 Functions'."
  71   (let ((except (split-string string riece-completing-read-multiple-separator))
  72         (table (copy-sequence riece-completing-read-multiple-table))
  73         lead)
  74     ;; Remove a partially matched word construct if it exists.
  75     (or (string-match
  76          (concat riece-completing-read-multiple-separator "$")
  77          string)
  78         (setq except (butlast except)))
  79     (when (string-match
  80            (concat ".*" riece-completing-read-multiple-separator)
  81            string)
  82       (setq lead (substring string 0 (match-end 0))
  83             string (substring string (match-end 0))))
  84     (while except
  85       (let ((entry (assoc (car except) table)))
  86         (if entry
  87             (setq table (delq entry table)))
  88         (setq except (cdr except))))
  89     (if (null flag)
  90         (progn
  91           (setq string (try-completion string table predicate))
  92           (or (eq t string)
  93               (concat lead string)))
  94       (if (eq flag 'lambda)
  95           (eq t (try-completion string table predicate))
  96         (if flag
  97             (all-completions string table predicate))))))
  98
  99 (defun riece-completing-read-multiple
 100   (prompt table &optional predicate require-match initial-input
 101           history default)
 102   "Execute `completing-read' consequently.
 103
 104 See the documentation for `completing-read' for details on the arguments:
 105 PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HISTORY, DEFAULT."
 106   (let ((prompt
 107          (format "%s (separated by \"%s\"): "
 108                  prompt riece-completing-read-multiple-separator))
 109         (riece-completing-read-multiple-table table))
 110     (split-string
 111      (completing-read
 112       prompt #'riece-completing-read-multiple-1
 113       predicate require-match initial-input history default)
 114      riece-completing-read-multiple-separator)))
 115
 116 (provide 'riece-complete)
 117
 118 ;;; riece-complete.el ends here