428
+ − 1 ;;; list-mode.el --- Major mode for buffers containing lists of items
+ − 2
+ − 3 ;; Copyright (C) 1992-4, 1997 Free Software Foundation, Inc.
442
+ − 4 ;; Copyright (C) 1996, 2000 Ben Wing.
428
+ − 5
+ − 6 ;; Maintainer: XEmacs Development Team
+ − 7 ;; Keywords: extensions, dumped
+ − 8
+ − 9 ;; This file is part of XEmacs.
+ − 10
+ − 11 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 12 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 19 ;; General Public License for more details.
+ − 20
+ − 21 ;; You should have received a copy of the GNU General Public License
+ − 22 ;; along with XEmacs; 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 ;;; Synched up with: Not synched
+ − 27
+ − 28 ;;; Commentary:
+ − 29
+ − 30 ;; This file is dumped with XEmacs.
+ − 31
+ − 32 ;; Cleanup, merging with FSF by Ben Wing, January 1996
+ − 33
+ − 34 ;;; Code:
+ − 35
+ − 36 (defvar list-mode-extent nil)
+ − 37 (make-variable-buffer-local 'list-mode-extent)
+ − 38
+ − 39 (defvar list-mode-map nil
+ − 40 "Local map for buffers containing lists of items.")
+ − 41 (or list-mode-map
+ − 42 (let ((map (setq list-mode-map (make-sparse-keymap 'list-mode-map))))
+ − 43 (suppress-keymap map)
+ − 44 (define-key map 'button2up 'list-mode-item-mouse-selected)
+ − 45 (define-key map 'button2 'undefined)
+ − 46 (define-key map "\C-m" 'list-mode-item-keyboard-selected)
+ − 47 ;;
+ − 48 ;; The following calls to `substitute-key-definition' losed because
+ − 49 ;; they were based on an incorrect assumption that `forward-char' and
+ − 50 ;; `backward-char' are bound to keys in the global map. This might not
+ − 51 ;; be the case if a user binds motion keys to different functions,
+ − 52 ;; and was not actually the case since 20.5 beta 28 or around.
+ − 53 ;;
+ − 54 ;; (substitute-key-definition 'forward-char 'next-list-mode-item map
+ − 55 ;; global-map)
+ − 56 ;; (substitute-key-definition 'backward-char 'previous-list-mode-item map
+ − 57 ;; global-map)
+ − 58 ;;
+ − 59 ;; We bind standard keys to motion commands instead.
+ − 60 ;;
+ − 61 (dolist (key '(kp-right right (control ?f)))
+ − 62 (define-key map key 'next-list-mode-item))
+ − 63 (dolist (key '(kp-left left (control ?b)))
+ − 64 (define-key map key 'previous-list-mode-item))))
+ − 65
442
+ − 66 ;; #### We make list-mode-hook, as well as completion-setup-hook and
+ − 67 ;; minibuffer-setup-hook, permanent-local so that it's possible to create
+ − 68 ;; buffers in these modes and then set up some buffer-specific
+ − 69 ;; customizations without resorting to awful kludges. (The problem here
+ − 70 ;; is that when you switch a buffer into a mode, reset-buffer is usually
+ − 71 ;; called, which destroys all buffer-local settings that you carefully
+ − 72 ;; tried to set up when you created the buffer. Therefore, the only way
+ − 73 ;; to set these variables is to use the setup hooks -- but if they are
+ − 74 ;; not declared permanent local, then any local hook functions that you
+ − 75 ;; put on them (which is exactly what you want to do) also get removed,
+ − 76 ;; so you would have to resort to putting a global hook function on the
+ − 77 ;; setup hook, and then making sure it gets removed later. I actually
+ − 78 ;; added some support for doing this with one-shot hooks, but this is
+ − 79 ;; clearly not the correct way to do things, and it fails in some cases,
+ − 80 ;; particularly when the buffer gets put into the mode more than once,
+ − 81 ;; which typically happens with completion buffers, for example.) In
+ − 82 ;; fact, all setup hooks should be made permanent local, but I didn't
+ − 83 ;; feel like making a global change like this quite yet. The proper way
+ − 84 ;; to do it would be to declare new def-style forms, such as defhook and
+ − 85 ;; define-local-setup-hook, which are used to initialize hooks in place
+ − 86 ;; of the current generic defvars. --ben
+ − 87
+ − 88 (put 'list-mode-hook 'permanent-local t)
+ − 89 (defvar list-mode-hook nil
+ − 90 "Normal hook run when entering List mode.")
+ − 91
428
+ − 92 (defun list-mode ()
+ − 93 "Major mode for buffer containing lists of items."
+ − 94 (interactive)
+ − 95 (kill-all-local-variables)
+ − 96 (use-local-map list-mode-map)
+ − 97 (setq mode-name "List")
+ − 98 (setq major-mode 'list-mode)
442
+ − 99 (add-local-hook 'post-command-hook 'set-list-mode-extent)
+ − 100 (add-local-hook 'pre-command-hook 'list-mode-extent-pre-hook)
+ − 101 (set (make-local-variable 'next-line-add-newlines) nil)
428
+ − 102 (setq list-mode-extent nil)
+ − 103 ;; It is visually disconcerting to have the text cursor disappear within list
+ − 104 ;; buffers, especially when moving from window to window, so leave it
+ − 105 ;; visible. -- Bob Weiner, 06/20/1999
+ − 106 ; (set-specifier text-cursor-visible-p nil (current-buffer))
+ − 107 (setq buffer-read-only t)
+ − 108 (goto-char (point-min))
+ − 109 (run-hooks 'list-mode-hook))
+ − 110
+ − 111 ;; List mode is suitable only for specially formatted data.
+ − 112 (put 'list-mode 'mode-class 'special)
+ − 113
+ − 114 (defvar list-mode-extent-old-point nil
+ − 115 "The value of point when pre-command-hook is called.
+ − 116 Used to determine the direction of motion.")
+ − 117 (make-variable-buffer-local 'list-mode-extent-old-point)
+ − 118
+ − 119 (defun list-mode-extent-pre-hook ()
+ − 120 (setq list-mode-extent-old-point (point))
+ − 121 ;(setq atomic-extent-goto-char-p nil)
+ − 122 )
+ − 123
+ − 124 (defun set-list-mode-extent ()
+ − 125 "Move to the closest list item and set up the extent for it.
+ − 126 This is called from `post-command-hook'."
+ − 127 (cond ((get-char-property (point) 'list-mode-item))
+ − 128 ((and (> (point) (point-min))
+ − 129 (get-char-property (1- (point)) 'list-mode-item))
+ − 130 (goto-char (1- (point))))
+ − 131 (t
+ − 132 (let ((pos (point))
+ − 133 dirflag)
+ − 134 ;this fucks things up more than it helps.
+ − 135 ;atomic-extent-goto-char-p as currently defined is all broken,
+ − 136 ;since it will be triggered if the command *ever* runs goto-char!
+ − 137 ;(if atomic-extent-goto-char-p
+ − 138 ; (setq dirflag 1)
+ − 139 (if (and list-mode-extent-old-point
+ − 140 (> pos list-mode-extent-old-point))
+ − 141 (setq dirflag 1)
+ − 142 (setq dirflag -1))
+ − 143 (next-list-mode-item dirflag)
+ − 144 (or (get-char-property (point) 'list-mode-item)
+ − 145 (next-list-mode-item (- dirflag))))))
+ − 146 (or (and list-mode-extent
+ − 147 (eq (current-buffer) (extent-object list-mode-extent)))
+ − 148 (progn
+ − 149 (setq list-mode-extent (make-extent nil nil (current-buffer)))
+ − 150 (set-extent-face list-mode-extent 'list-mode-item-selected)))
+ − 151 (let ((ex (extent-at (point) nil 'list-mode-item nil 'at)))
+ − 152 (if ex
+ − 153 (progn
+ − 154 (set-extent-endpoints list-mode-extent
+ − 155 (extent-start-position ex)
+ − 156 (extent-end-position ex))
+ − 157 (auto-show-make-region-visible (extent-start-position ex)
+ − 158 (extent-end-position ex)))
+ − 159 (detach-extent list-mode-extent))))
+ − 160
+ − 161 (defun previous-list-mode-item (n)
+ − 162 "Move to the previous item in list-mode."
+ − 163 (interactive "p")
+ − 164 (next-list-mode-item (- n)))
+ − 165
+ − 166 (defun next-list-mode-item (n)
+ − 167 "Move to the next item in list-mode.
+ − 168 With prefix argument N, move N items (negative N means move backward)."
+ − 169 (interactive "p")
+ − 170 (while (and (> n 0) (not (eobp)))
+ − 171 (let ((extent (extent-at (point) (current-buffer) 'list-mode-item))
+ − 172 (end (point-max)))
+ − 173 ;; If in a completion, move to the end of it.
+ − 174 (if extent (goto-char (extent-end-position extent)))
+ − 175 ;; Move to start of next one.
+ − 176 (or (extent-at (point) (current-buffer) 'list-mode-item)
+ − 177 (goto-char (next-single-property-change (point) 'list-mode-item
+ − 178 nil end))))
+ − 179 (setq n (1- n)))
+ − 180 (while (and (< n 0) (not (bobp)))
+ − 181 (let ((extent (extent-at (point) (current-buffer) 'list-mode-item))
+ − 182 (end (point-min)))
+ − 183 ;; If in a completion, move to the start of it.
+ − 184 (if extent (goto-char (extent-start-position extent)))
+ − 185 ;; Move to the start of that one.
+ − 186 (if (setq extent (extent-at (point) (current-buffer) 'list-mode-item
+ − 187 nil 'before))
+ − 188 (goto-char (extent-start-position extent))
+ − 189 (goto-char (previous-single-property-change
+ − 190 (point) 'list-mode-item nil end))
+ − 191 (if (setq extent (extent-at (point) (current-buffer) 'list-mode-item
+ − 192 nil 'before))
+ − 193 (goto-char (extent-start-position extent)))))
+ − 194 (setq n (1+ n))))
+ − 195
+ − 196 (defun list-mode-item-selected-1 (extent event)
+ − 197 (let ((func (extent-property extent 'list-mode-item-activate-callback))
+ − 198 (user-data (extent-property extent 'list-mode-item-user-data)))
+ − 199 (if func
+ − 200 (funcall func event extent user-data))))
+ − 201
+ − 202 ;; we could make these two be just one function, but we want to be
+ − 203 ;; able to refer to them in DOC strings.
+ − 204
+ − 205 (defun list-mode-item-keyboard-selected ()
+ − 206 (interactive)
+ − 207 (list-mode-item-selected-1 (extent-at (point) (current-buffer)
+ − 208 'list-mode-item nil 'at)
+ − 209 nil))
+ − 210
+ − 211 (defun list-mode-item-mouse-selected (event)
+ − 212 (interactive "e")
+ − 213 ;; Sometimes event-closest-point returns nil.
+ − 214 ;; So beep instead of bombing.
+ − 215 (let ((point (event-closest-point event)))
+ − 216 (if point
+ − 217 (list-mode-item-selected-1 (extent-at point
+ − 218 (event-buffer event)
+ − 219 'list-mode-item nil 'at)
+ − 220 event)
+ − 221 (ding))))
+ − 222
+ − 223 (defun add-list-mode-item (start end &optional buffer activate-callback
+ − 224 user-data)
+ − 225 "Add a new list item in list-mode, from START to END in BUFFER.
+ − 226 BUFFER defaults to the current buffer.
+ − 227 This works by creating an extent for the span of text in question.
+ − 228 If ACTIVATE-CALLBACK is non-nil, it should be a function of three
+ − 229 arguments (EVENT EXTENT USER-DATA) that will be called when button2
+ − 230 is pressed on the extent. USER-DATA comes from the optional
+ − 231 USER-DATA argument."
+ − 232 (let ((extent (make-extent start end buffer)))
+ − 233 (set-extent-property extent 'list-mode-item t)
+ − 234 (set-extent-property extent 'start-open t)
+ − 235 (if activate-callback
+ − 236 (progn
+ − 237 (set-extent-property extent 'mouse-face 'highlight)
+ − 238 (set-extent-property extent 'list-mode-item-activate-callback
+ − 239 activate-callback)
+ − 240 (set-extent-property extent 'list-mode-item-user-data user-data)))
+ − 241 extent))
+ − 242
+ − 243
+ − 244 ;; Define the major mode for lists of completions.
+ − 245
+ − 246
+ − 247 (defvar completion-highlight-first-word-only nil
+ − 248 "*Completion will only highlight the first blank delimited word if t.
+ − 249 If the variable in not t or nil, the string is taken as a regexp to match for end
+ − 250 of highlight")
+ − 251
442
+ − 252 ;; see comment at list-mode-hook.
+ − 253 (put 'completion-setup-hook 'permanent-local t)
428
+ − 254 (defvar completion-setup-hook nil
442
+ − 255 "Normal hook run at the end of setting up the text of a completion buffer.
+ − 256 When run, the completion buffer is the current buffer.")
428
+ − 257
+ − 258 ; Unnecessary FSFmacs crock. We frob the extents directly in
+ − 259 ; display-completion-list, so no "heuristics" like this are necessary.
+ − 260 ;(defvar completion-fixup-function nil
+ − 261 ; "A function to customize how completions are identified in completion lists.
+ − 262 ;`completion-setup-function' calls this function with no arguments
+ − 263 ;each time it has found what it thinks is one completion.
+ − 264 ;Point is at the end of the completion in the completion list buffer.
+ − 265 ;If this function moves point, it can alter the end of that completion.")
+ − 266
+ − 267 (defvar completion-default-help-string
+ − 268 '(concat
+ − 269 (if (device-on-window-system-p)
+ − 270 (substitute-command-keys
+ − 271 "Click \\<list-mode-map>\\[list-mode-item-mouse-selected] on a completion to select it.\n") "")
+ − 272 (substitute-command-keys
+ − 273 "Type \\<minibuffer-local-completion-map>\\[advertised-switch-to-completions] or \\[switch-to-completions] to move to this buffer, for keyboard selection.\n\n"))
+ − 274 "Form the evaluate to get a help string for completion lists.
+ − 275 This string is inserted at the beginning of the buffer.
+ − 276 See `display-completion-list'.")
+ − 277
+ − 278 (defun display-completion-list (completions &rest cl-keys)
+ − 279 "Display the list of completions, COMPLETIONS, using `standard-output'.
+ − 280 Each element may be just a symbol or string or may be a list of two
+ − 281 strings to be printed as if concatenated.
+ − 282 Frob a mousable extent onto each completion. This extent has properties
+ − 283 'mouse-face (so it highlights when the mouse passes over it) and
+ − 284 'list-mode-item (so it can be located).
+ − 285
+ − 286 Keywords:
+ − 287 :activate-callback (default is `default-choose-completion')
+ − 288 See `add-list-mode-item'.
+ − 289 :user-data
+ − 290 Value passed to activation callback.
+ − 291 :window-width
+ − 292 If non-nil, width to use in displaying the list, instead of the
+ − 293 actual window's width.
442
+ − 294 :window-height
+ − 295 If non-nil, use no more than this many lines, and extend line width as
+ − 296 necessary.
428
+ − 297 :help-string (default is the value of `completion-default-help-string')
+ − 298 Form to evaluate to get a string to insert at the beginning of
+ − 299 the completion list buffer. This is evaluated when that buffer
+ − 300 is the current buffer and after it has been put into
+ − 301 completion-list-mode.
+ − 302 :reference-buffer (default is the current buffer)
+ − 303 This specifies the value of `completion-reference-buffer' in
+ − 304 the completion buffer. This specifies the buffer (normally a
+ − 305 minibuffer) that `default-choose-completion' will insert the
+ − 306 completion into.
+ − 307
+ − 308 At the end, run the normal hook `completion-setup-hook'.
+ − 309 It can find the completion buffer in `standard-output'.
+ − 310 If `completion-highlight-first-word-only' is non-nil, then only the start
+ − 311 of the string is highlighted."
+ − 312 ;; #### I18N3 should set standard-output to be (temporarily)
+ − 313 ;; output-translating.
+ − 314 (cl-parsing-keywords
+ − 315 ((:activate-callback 'default-choose-completion)
+ − 316 :user-data
+ − 317 :reference-buffer
+ − 318 (:help-string completion-default-help-string)
+ − 319 (:completion-string "Possible completions are:")
442
+ − 320 :window-width
+ − 321 :window-height)
428
+ − 322 ()
+ − 323 (let ((old-buffer (current-buffer))
+ − 324 (bufferp (bufferp standard-output)))
+ − 325 (if bufferp
+ − 326 (set-buffer standard-output))
+ − 327 (if (null completions)
+ − 328 (princ (gettext
+ − 329 "There are no possible completions of what you have typed."))
+ − 330 (let ((win-width
+ − 331 (or cl-window-width
+ − 332 (if bufferp
+ − 333 ;; This needs fixing for the case of windows
+ − 334 ;; that aren't the same width's the frame.
+ − 335 ;; Sadly, the window it will appear in is not known
+ − 336 ;; until after the text has been made.
+ − 337
+ − 338 ;; We have to use last-nonminibuf-frame here
+ − 339 ;; and not selected-frame because if a
+ − 340 ;; minibuffer-only frame is being used it will
+ − 341 ;; be the selected-frame at the point this is
+ − 342 ;; run. We keep the selected-frame call around
+ − 343 ;; just in case.
+ − 344 (frame-width (or (last-nonminibuf-frame)
+ − 345 (selected-frame)))
+ − 346 80))))
+ − 347 (let ((count 0)
442
+ − 348 (max-width 0)
+ − 349 old-max-width)
428
+ − 350 ;; Find longest completion
+ − 351 (let ((tail completions))
+ − 352 (while tail
+ − 353 (let* ((elt (car tail))
+ − 354 (len (cond ((stringp elt)
+ − 355 (length elt))
+ − 356 ((and (consp elt)
+ − 357 (stringp (car elt))
+ − 358 (stringp (car (cdr elt))))
+ − 359 (+ (length (car elt))
+ − 360 (length (car (cdr elt)))))
+ − 361 (t
+ − 362 (signal 'wrong-type-argument
+ − 363 (list 'stringp elt))))))
+ − 364 (if (> len max-width)
+ − 365 (setq max-width len))
+ − 366 (setq count (1+ count)
+ − 367 tail (cdr tail)))))
+ − 368
+ − 369 (setq max-width (+ 2 max-width)) ; at least two chars between cols
442
+ − 370 (setq old-max-width max-width)
428
+ − 371 (let ((rows (let ((cols (min (/ win-width max-width) count)))
+ − 372 (if (<= cols 1)
+ − 373 count
+ − 374 (progn
+ − 375 ;; re-space the columns
+ − 376 (setq max-width (/ win-width cols))
+ − 377 (if (/= (% count cols) 0) ; want ceiling...
+ − 378 (1+ (/ count cols))
+ − 379 (/ count cols)))))))
442
+ − 380 (when
+ − 381 (and cl-window-height
+ − 382 (> rows cl-window-height))
+ − 383 (setq max-width old-max-width)
+ − 384 (setq rows cl-window-height))
+ − 385 (when (and (stringp cl-completion-string)
+ − 386 (> (length cl-completion-string) 0))
+ − 387 (princ (gettext cl-completion-string))
+ − 388 (terpri))
428
+ − 389 (let ((tail completions)
+ − 390 (r 0)
+ − 391 (regexp-string
+ − 392 (if (eq t
+ − 393 completion-highlight-first-word-only)
+ − 394 "[ \t]"
+ − 395 completion-highlight-first-word-only)))
+ − 396 (while (< r rows)
442
+ − 397 (and (> r 0) (terpri))
428
+ − 398 (let ((indent 0)
+ − 399 (column 0)
+ − 400 (tail2 tail))
+ − 401 (while tail2
+ − 402 (let ((elt (car tail2)))
+ − 403 (if (/= indent 0)
+ − 404 (if bufferp
+ − 405 (indent-to indent 2)
+ − 406 (while (progn (write-char ?\ )
+ − 407 (setq column (1+ column))
+ − 408 (< column indent)))))
+ − 409 (setq indent (+ indent max-width))
+ − 410 (let ((start (point))
+ − 411 end)
+ − 412 ;; Frob some mousable extents in there too!
+ − 413 (if (consp elt)
+ − 414 (progn
+ − 415 (princ (car elt))
+ − 416 (princ (car (cdr elt)))
+ − 417 (or bufferp
+ − 418 (setq column
+ − 419 (+ column
+ − 420 (length (car elt))
+ − 421 (length (car (cdr elt)))))))
+ − 422 (progn
+ − 423 (princ elt)
+ − 424 (or bufferp
+ − 425 (setq column (+ column (length
+ − 426 elt))))))
+ − 427 (add-list-mode-item
+ − 428 start
+ − 429 (progn
+ − 430 (setq end (point))
+ − 431 (or
+ − 432 (and completion-highlight-first-word-only
+ − 433 (goto-char start)
+ − 434 (re-search-forward regexp-string end t)
+ − 435 (match-beginning 0))
+ − 436 end))
+ − 437 nil cl-activate-callback cl-user-data)
+ − 438 (goto-char end)))
+ − 439 (setq tail2 (nthcdr rows tail2)))
+ − 440 (setq tail (cdr tail)
+ − 441 r (1+ r)))))))))
+ − 442 (if bufferp
+ − 443 (set-buffer old-buffer)))
+ − 444 (save-excursion
+ − 445 (let ((mainbuf (or cl-reference-buffer (current-buffer))))
+ − 446 (set-buffer standard-output)
+ − 447 (completion-list-mode)
+ − 448 (make-local-variable 'completion-reference-buffer)
+ − 449 (setq completion-reference-buffer mainbuf)
+ − 450 ;;; The value 0 is right in most cases, but not for file name completion.
+ − 451 ;;; so this has to be turned off.
+ − 452 ;;; (setq completion-base-size 0)
+ − 453 (goto-char (point-min))
+ − 454 (let ((buffer-read-only nil))
+ − 455 (insert (eval cl-help-string)))
+ − 456 ;; unnecessary FSFmacs crock
+ − 457 ;;(forward-line 1)
+ − 458 ;;(while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
+ − 459 ;; (let ((beg (match-beginning 0))
+ − 460 ;; (end (point)))
+ − 461 ;; (if completion-fixup-function
+ − 462 ;; (funcall completion-fixup-function))
+ − 463 ;; (put-text-property beg (point) 'mouse-face 'highlight)
+ − 464 ;; (put-text-property beg (point) 'list-mode-item t)
+ − 465 ;; (goto-char end)))))
+ − 466 ))
442
+ − 467 (save-excursion
+ − 468 (set-buffer standard-output)
+ − 469 (run-hooks 'completion-setup-hook))))
428
+ − 470
+ − 471 (defvar completion-display-completion-list-function 'display-completion-list
+ − 472 "Function to set up the list of completions in the completion buffer.
+ − 473 The function is called with one argument, the sorted list of completions.
+ − 474 Particular minibuffer interface functions (e.g. `read-file-name') may
+ − 475 want to change this. To do that, set a local value for this variable
+ − 476 in the minibuffer; that ensures that other minibuffer invocations will
+ − 477 not be affected.")
+ − 478
+ − 479 (defun minibuffer-completion-help ()
+ − 480 "Display a list of possible completions of the current minibuffer contents.
+ − 481 The list of completions is determined by calling `all-completions',
+ − 482 passing it the current minibuffer contents, the value of
+ − 483 `minibuffer-completion-table', and the value of
+ − 484 `minibuffer-completion-predicate'. The list is displayed by calling
+ − 485 the value of `completion-display-completion-list-function' on the sorted
+ − 486 list of completions, with the standard output set to the completion
+ − 487 buffer."
+ − 488 (interactive)
+ − 489 (message "Making completion list...")
+ − 490 (let ((completions (all-completions (buffer-string)
+ − 491 minibuffer-completion-table
+ − 492 minibuffer-completion-predicate)))
+ − 493 (message nil)
+ − 494 (if (null completions)
+ − 495 (progn
+ − 496 (ding nil 'no-completion)
+ − 497 (temp-minibuffer-message " [No completions]"))
+ − 498 (with-output-to-temp-buffer "*Completions*"
+ − 499 (funcall completion-display-completion-list-function
+ − 500 (sort completions #'string-lessp))))))
+ − 501
+ − 502 (define-derived-mode completion-list-mode list-mode
+ − 503 "Completion List"
+ − 504 "Major mode for buffers showing lists of possible completions.
+ − 505 \\{completion-list-mode-map}"
+ − 506 (make-local-variable 'completion-base-size)
+ − 507 (setq completion-base-size nil))
+ − 508
+ − 509 (let ((map completion-list-mode-map))
+ − 510 (define-key map 'button2up 'mouse-choose-completion)
+ − 511 (define-key map 'button2 'undefined)
+ − 512 (define-key map "\C-m" 'choose-completion)
+ − 513 (define-key map "\e\e\e" 'delete-completion-window)
+ − 514 (define-key map "\C-g" 'minibuffer-keyboard-quit)
+ − 515 (define-key map "q" 'completion-list-mode-quit)
+ − 516 (define-key map " " 'completion-switch-to-minibuffer)
+ − 517 ;; [Tab] used to switch to the minibuffer but since [space] does that and
+ − 518 ;; since most applications in the world use [Tab] to select the next item
+ − 519 ;; in a list, do that in the *Completions* buffer too. -- Bob Weiner,
+ − 520 ;; BeOpen.com, 06/23/1999.
+ − 521 (define-key map "\t" 'next-list-mode-item))
+ − 522
+ − 523 (defvar completion-reference-buffer nil
+ − 524 "Record the buffer that was current when the completion list was requested.
+ − 525 This is a local variable in the completion list buffer.
+ − 526 Initial value is nil to avoid some compiler warnings.")
+ − 527
+ − 528 (defvar completion-base-size nil
+ − 529 "Number of chars at beginning of minibuffer not involved in completion.
+ − 530 This is a local variable in the completion list buffer
+ − 531 but it talks about the buffer in `completion-reference-buffer'.
+ − 532 If this is nil, it means to compare text to determine which part
+ − 533 of the tail end of the buffer's text is involved in completion.")
+ − 534
+ − 535 ;; These names are referenced in the doc string for `completion-list-mode'.
+ − 536 (defalias 'choose-completion 'list-mode-item-keyboard-selected)
+ − 537 (defalias 'mouse-choose-completion 'list-mode-item-mouse-selected)
+ − 538
+ − 539 (defun delete-completion-window ()
+ − 540 "Delete the completion list window.
+ − 541 Go to the window from which completion was requested."
+ − 542 (interactive)
+ − 543 (let ((buf completion-reference-buffer))
+ − 544 (delete-window (selected-window))
+ − 545 (if (get-buffer-window buf)
+ − 546 (select-window (get-buffer-window buf)))))
+ − 547
+ − 548 (defun completion-switch-to-minibuffer ()
+ − 549 "Move from a completions buffer to the active minibuffer window."
+ − 550 (interactive)
+ − 551 (select-window (minibuffer-window)))
+ − 552
+ − 553 (defun completion-list-mode-quit ()
+ − 554 "Abort any recursive edit and bury the completions buffer."
+ − 555 (interactive)
+ − 556 (condition-case ()
+ − 557 (abort-recursive-edit)
+ − 558 (error nil))
+ − 559 ;; If there was no recursive edit to abort, simply bury the completions
+ − 560 ;; list buffer.
+ − 561 (if (eq major-mode 'completion-list-mode) (bury-buffer)))
+ − 562
+ − 563 (defun completion-do-in-minibuffer ()
+ − 564 (interactive "_")
+ − 565 (save-excursion
+ − 566 (set-buffer (window-buffer (minibuffer-window)))
+ − 567 (call-interactively (key-binding (this-command-keys)))))
+ − 568
+ − 569 (defun default-choose-completion (event extent buffer)
+ − 570 "Click on an alternative in the `*Completions*' buffer to choose it."
+ − 571 (and (button-event-p event)
+ − 572 ;; Give temporary modes such as isearch a chance to turn off.
+ − 573 (run-hooks 'mouse-leave-buffer-hook))
+ − 574 (or buffer (setq buffer (symbol-value-in-buffer
+ − 575 'completion-reference-buffer
+ − 576 (or (and (button-event-p event)
+ − 577 (event-buffer event))
+ − 578 (current-buffer)))))
+ − 579 (save-selected-window
+ − 580 (and (button-event-p event)
+ − 581 (select-window (event-window event)))
+ − 582 (if (and (one-window-p t 'selected-frame)
+ − 583 (window-dedicated-p (selected-window)))
+ − 584 ;; This is a special buffer's frame
+ − 585 (iconify-frame (selected-frame))
+ − 586 (or (window-dedicated-p (selected-window))
+ − 587 (bury-buffer))))
+ − 588 (choose-completion-string (extent-string extent)
+ − 589 buffer
+ − 590 completion-base-size))
+ − 591
+ − 592 ;; Delete the longest partial match for STRING
+ − 593 ;; that can be found before POINT.
+ − 594 (defun choose-completion-delete-max-match (string)
+ − 595 (let ((len (min (length string)
+ − 596 (- (point) (point-min)))))
+ − 597 (goto-char (- (point) (length string)))
+ − 598 (if completion-ignore-case
+ − 599 (setq string (downcase string)))
+ − 600 (while (and (> len 0)
+ − 601 (let ((tail (buffer-substring (point)
+ − 602 (+ (point) len))))
+ − 603 (if completion-ignore-case
+ − 604 (setq tail (downcase tail)))
+ − 605 (not (string= tail (substring string 0 len)))))
+ − 606 (setq len (1- len))
+ − 607 (forward-char 1))
+ − 608 (delete-char len)))
+ − 609
+ − 610 ;; Switch to BUFFER and insert the completion choice CHOICE.
+ − 611 ;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
+ − 612 ;; to keep. If it is nil, use choose-completion-delete-max-match instead.
+ − 613 (defun choose-completion-string (choice &optional buffer base-size)
+ − 614 (let ((buffer (or buffer completion-reference-buffer)))
+ − 615 ;; If BUFFER is a minibuffer, barf unless it's the currently
+ − 616 ;; active minibuffer.
+ − 617 (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
+ − 618 (or (not (active-minibuffer-window))
+ − 619 (not (equal buffer
+ − 620 (window-buffer (active-minibuffer-window))))))
+ − 621 (error "Minibuffer is not active for completion")
+ − 622 ;; Insert the completion into the buffer where completion was requested.
+ − 623 (set-buffer buffer)
+ − 624 (if base-size
+ − 625 (delete-region (+ base-size (point-min)) (point))
+ − 626 (choose-completion-delete-max-match choice))
+ − 627 (insert choice)
+ − 628 (remove-text-properties (- (point) (length choice)) (point)
+ − 629 '(highlight nil))
+ − 630 ;; Update point in the window that BUFFER is showing in.
+ − 631 (let ((window (get-buffer-window buffer t)))
+ − 632 (set-window-point window (point)))
+ − 633 ;; If completing for the minibuffer, exit it with this choice.
+ − 634 (and (equal buffer (window-buffer (minibuffer-window)))
+ − 635 minibuffer-completion-table
+ − 636 (exit-minibuffer)))))
+ − 637
+ − 638 (define-key minibuffer-local-completion-map [prior]
+ − 639 'switch-to-completions)
+ − 640 (define-key minibuffer-local-must-match-map [prior]
+ − 641 'switch-to-completions)
+ − 642 (define-key minibuffer-local-completion-map "\M-v"
+ − 643 'advertised-switch-to-completions)
+ − 644 (define-key minibuffer-local-must-match-map "\M-v"
+ − 645 'advertised-switch-to-completions)
+ − 646
+ − 647 (defalias 'advertised-switch-to-completions 'switch-to-completions)
+ − 648 (defun switch-to-completions ()
+ − 649 "Select the completion list window."
+ − 650 (interactive)
+ − 651 ;; Make sure we have a completions window.
+ − 652 (or (get-buffer-window "*Completions*")
+ − 653 (minibuffer-completion-help))
+ − 654 (if (not (get-buffer-window "*Completions*"))
+ − 655 nil
+ − 656 (select-window (get-buffer-window "*Completions*"))
+ − 657 (goto-char (next-single-property-change (point-min) 'list-mode-item nil
+ − 658 (point-max)))))
+ − 659
+ − 660 ;;; list-mode.el ends here