+\f
+;; Define the major mode for lists of completions.
+
+(defvar completion-list-mode-map nil)
+(or completion-list-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2] 'mouse-choose-completion)
+ (define-key map [down-mouse-2] nil)
+ (define-key map "\C-m" 'choose-completion)
+ (define-key map [return] 'choose-completion)
+ (setq completion-list-mode-map map)))
+
+;; Completion mode is suitable only for specially formatted data.
+(put 'completion-list-mode 'mode-class 'special)
+
+;; Record the buffer that was current when the completion list was requested.
+(defvar completion-reference-buffer)
+
+;; This records the length of the text at the beginning of the buffer
+;; which was not included in the completion.
+(defvar completion-base-size nil)
+
+(defun choose-completion ()
+ "Choose the completion that point is in or next to."
+ (interactive)
+ (let (beg end completion (buffer completion-reference-buffer)
+ (base-size completion-base-size))
+ (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
+ (setq end (point) beg (1+ (point))))
+ (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
+ (setq end (1- (point)) beg(point)))
+ (if (null beg)
+ (error "No completion here"))
+ (setq beg (previous-single-property-change beg 'mouse-face))
+ (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
+ (setq completion (buffer-substring beg end))
+ (let ((owindow (selected-window)))
+ (if (and (one-window-p t 'selected-frame)
+ (window-dedicated-p (selected-window)))
+ ;; This is a special buffer's frame
+ (iconify-frame (selected-frame))
+ (or (window-dedicated-p (selected-window))
+ (bury-buffer)))
+ (select-window owindow))
+ (choose-completion-string completion buffer base-size)))
+
+;; Delete the longest partial match for STRING
+;; that can be found before POINT.
+(defun choose-completion-delete-max-match (string)
+ (let ((opoint (point))
+ (len (min (length string)
+ (- (point) (point-min)))))
+ (goto-char (- (point) (length string)))
+ (if completion-ignore-case
+ (setq string (downcase string)))
+ (while (and (> len 0)
+ (let ((tail (buffer-substring (point)
+ (+ (point) len))))
+ (if completion-ignore-case
+ (setq tail (downcase tail)))
+ (not (string= tail (substring string 0 len)))))
+ (setq len (1- len))
+ (forward-char 1))
+ (delete-char len)))
+
+(defun choose-completion-string (choice &optional buffer base-size)
+ (let ((buffer (or buffer completion-reference-buffer)))
+ ;; If BUFFER is a minibuffer, barf unless it's the currently
+ ;; active minibuffer.
+ (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
+ (or (not (minibuffer-window-active-p (minibuffer-window)))
+ (not (equal buffer (window-buffer (minibuffer-window))))))
+ (error "Minibuffer is not active for completion")
+ ;; Insert the completion into the buffer where completion was requested.
+ (set-buffer buffer)
+ (if base-size
+ (delete-region (+ base-size (point-min)) (point))
+ (choose-completion-delete-max-match choice))
+ (insert choice)
+ (remove-text-properties (- (point) (length choice)) (point)
+ '(mouse-face nil))
+ ;; Update point in the window that BUFFER is showing in.
+ (let ((window (get-buffer-window buffer t)))
+ (set-window-point window (point)))
+ ;; If completing for the minibuffer, exit it with this choice.
+ (and (equal buffer (window-buffer (minibuffer-window)))
+ minibuffer-completion-table
+ (exit-minibuffer)))))
+
+(defun completion-list-mode ()
+ "Major mode for buffers showing lists of possible completions.
+Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
+ to select the completion near point.
+Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
+ with the mouse."
+ (interactive)
+ (kill-all-local-variables)
+ (use-local-map completion-list-mode-map)
+ (setq mode-name "Completion List")
+ (setq major-mode 'completion-list-mode)
+ (make-local-variable 'completion-base-size)
+ (setq completion-base-size nil)
+ (run-hooks 'completion-list-mode-hook))
+
+(defvar completion-fixup-function nil)
+
+(defun completion-setup-function ()
+ (save-excursion
+ (let ((mainbuf (current-buffer)))
+ (set-buffer standard-output)
+ (completion-list-mode)
+ (make-local-variable 'completion-reference-buffer)
+ (setq completion-reference-buffer mainbuf)
+ (goto-char (point-min))
+ (if window-system
+ (insert (substitute-command-keys
+ "Click \\[mouse-choose-completion] on a completion to select it.\n")))
+ (insert (substitute-command-keys
+ "In this buffer, type \\[choose-completion] to \
+select the completion near point.\n\n"))
+ (forward-line 1)
+ (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
+ (let ((beg (match-beginning 0))
+ (end (point)))
+ (if completion-fixup-function
+ (funcall completion-fixup-function))
+ (put-text-property beg (point) 'mouse-face 'highlight)
+ (goto-char end))))))
+
+(add-hook 'completion-setup-hook 'completion-setup-function)
+\f
+;;;; Keypad support.
+
+;;; Make the keypad keys act like ordinary typing keys. If people add
+;;; bindings for the function key symbols, then those bindings will
+;;; override these, so this shouldn't interfere with any existing
+;;; bindings.
+
+;; Also tell read-char how to handle these keys.
+(mapcar
+ (lambda (keypad-normal)
+ (let ((keypad (nth 0 keypad-normal))
+ (normal (nth 1 keypad-normal)))
+ (put keypad 'ascii-character normal)
+ (define-key function-key-map (vector keypad) (vector normal))))
+ '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
+ (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
+ (kp-space ?\ )
+ (kp-tab ?\t)
+ (kp-enter ?\r)
+ (kp-multiply ?*)
+ (kp-add ?+)
+ (kp-separator ?,)
+ (kp-subtract ?-)
+ (kp-decimal ?.)
+ (kp-divide ?/)
+ (kp-equal ?=)))