1;;; lisp.el --- Lisp editing commands for Emacs 2 3;; Copyright (C) 1985, 1986, 1994, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Maintainer: FSF 7;; Keywords: lisp, languages 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs 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;; GNU Emacs 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., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Lisp editing commands to go with Lisp major mode. More-or-less 29;; applicable in other modes too. 30 31;;; Code: 32 33;; Note that this variable is used by non-lisp modes too. 34(defcustom defun-prompt-regexp nil 35 "*If non-nil, a regexp to ignore before a defun. 36This is only necessary if the opening paren or brace is not in column 0. 37See function `beginning-of-defun'." 38 :type '(choice (const nil) 39 regexp) 40 :group 'lisp) 41(make-variable-buffer-local 'defun-prompt-regexp) 42 43(defcustom parens-require-spaces t 44 "If non-nil, `insert-parentheses' inserts whitespace as needed." 45 :type 'boolean 46 :group 'lisp) 47 48(defvar forward-sexp-function nil 49 "If non-nil, `forward-sexp' delegates to this function. 50Should take the same arguments and behave similarly to `forward-sexp'.") 51 52(defun forward-sexp (&optional arg) 53 "Move forward across one balanced expression (sexp). 54With ARG, do it that many times. Negative arg -N means 55move backward across N balanced expressions." 56 (interactive "p") 57 (or arg (setq arg 1)) 58 (if forward-sexp-function 59 (funcall forward-sexp-function arg) 60 (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) 61 (if (< arg 0) (backward-prefix-chars)))) 62 63(defun backward-sexp (&optional arg) 64 "Move backward across one balanced expression (sexp). 65With ARG, do it that many times. Negative arg -N means 66move forward across N balanced expressions." 67 (interactive "p") 68 (or arg (setq arg 1)) 69 (forward-sexp (- arg))) 70 71(defun mark-sexp (&optional arg allow-extend) 72 "Set mark ARG sexps from point. 73The place mark goes is the same place \\[forward-sexp] would 74move to with the same argument. 75Interactively, if this command is repeated 76or (in Transient Mark mode) if the mark is active, 77it marks the next ARG sexps after the ones already marked." 78 (interactive "P\np") 79 (cond ((and allow-extend 80 (or (and (eq last-command this-command) (mark t)) 81 (and transient-mark-mode mark-active))) 82 (setq arg (if arg (prefix-numeric-value arg) 83 (if (< (mark) (point)) -1 1))) 84 (set-mark 85 (save-excursion 86 (goto-char (mark)) 87 (forward-sexp arg) 88 (point)))) 89 (t 90 (push-mark 91 (save-excursion 92 (forward-sexp (prefix-numeric-value arg)) 93 (point)) 94 nil t)))) 95 96(defun forward-list (&optional arg) 97 "Move forward across one balanced group of parentheses. 98With ARG, do it that many times. 99Negative arg -N means move backward across N groups of parentheses." 100 (interactive "p") 101 (or arg (setq arg 1)) 102 (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) 103 104(defun backward-list (&optional arg) 105 "Move backward across one balanced group of parentheses. 106With ARG, do it that many times. 107Negative arg -N means move forward across N groups of parentheses." 108 (interactive "p") 109 (or arg (setq arg 1)) 110 (forward-list (- arg))) 111 112(defun down-list (&optional arg) 113 "Move forward down one level of parentheses. 114With ARG, do this that many times. 115A negative argument means move backward but still go down a level." 116 (interactive "p") 117 (or arg (setq arg 1)) 118 (let ((inc (if (> arg 0) 1 -1))) 119 (while (/= arg 0) 120 (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) 121 (setq arg (- arg inc))))) 122 123(defun backward-up-list (&optional arg) 124 "Move backward out of one level of parentheses. 125With ARG, do this that many times. 126A negative argument means move forward but still to a less deep spot." 127 (interactive "p") 128 (up-list (- (or arg 1)))) 129 130(defun up-list (&optional arg) 131 "Move forward out of one level of parentheses. 132With ARG, do this that many times. 133A negative argument means move backward but still to a less deep spot." 134 (interactive "p") 135 (or arg (setq arg 1)) 136 (let ((inc (if (> arg 0) 1 -1))) 137 (while (/= arg 0) 138 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) 139 (setq arg (- arg inc))))) 140 141(defun kill-sexp (&optional arg) 142 "Kill the sexp (balanced expression) following point. 143With ARG, kill that many sexps after point. 144Negative arg -N means kill N sexps before point." 145 (interactive "p") 146 (let ((opoint (point))) 147 (forward-sexp (or arg 1)) 148 (kill-region opoint (point)))) 149 150(defun backward-kill-sexp (&optional arg) 151 "Kill the sexp (balanced expression) preceding point. 152With ARG, kill that many sexps before point. 153Negative arg -N means kill N sexps after point." 154 (interactive "p") 155 (kill-sexp (- (or arg 1)))) 156 157;; After Zmacs: 158(defun kill-backward-up-list (&optional arg) 159 "Kill the form containing the current sexp, leaving the sexp itself. 160A prefix argument ARG causes the relevant number of surrounding 161forms to be removed." 162 (interactive "*p") 163 (let ((current-sexp (thing-at-point 'sexp))) 164 (if current-sexp 165 (save-excursion 166 (backward-up-list arg) 167 (kill-sexp) 168 (insert current-sexp)) 169 (error "Not at a sexp")))) 170 171(defvar beginning-of-defun-function nil 172 "If non-nil, function for `beginning-of-defun-raw' to call. 173This is used to find the beginning of the defun instead of using the 174normal recipe (see `beginning-of-defun'). Major modes can define this 175if defining `defun-prompt-regexp' is not sufficient to handle the mode's 176needs. 177 178The function (of no args) should go to the line on which the current 179defun starts, and return non-nil, or should return nil if it can't 180find the beginning.") 181 182(defun beginning-of-defun (&optional arg) 183 "Move backward to the beginning of a defun. 184With ARG, do it that many times. Negative arg -N 185means move forward to Nth following beginning of defun. 186Returns t unless search stops due to beginning or end of buffer. 187 188If variable `beginning-of-defun-function' is non-nil, its value 189is called as a function to find the defun's beginning. 190 191Normally a defun is assumed to start where there is a char with 192open-parenthesis syntax at the beginning of a line. If 193`defun-prompt-regexp' is non-nil, then a string which matches 194that regexp may precede the open-parenthesis, and point ends up 195at the beginning of the line. 196 197If `defun-prompt-regexp' and `open-paren-in-column-0-is-defun-start' 198are both nil, the function instead finds an open-paren at the 199outermost level." 200 (interactive "p") 201 (or (not (eq this-command 'beginning-of-defun)) 202 (eq last-command 'beginning-of-defun) 203 (and transient-mark-mode mark-active) 204 (push-mark)) 205 (and (beginning-of-defun-raw arg) 206 (progn (beginning-of-line) t))) 207 208(defun beginning-of-defun-raw (&optional arg) 209 "Move point to the character that starts a defun. 210This is identical to function `beginning-of-defun', except that point 211does not move to the beginning of the line when `defun-prompt-regexp' 212is non-nil. 213 214If variable `beginning-of-defun-function' is non-nil, its value 215is called as a function to find the defun's beginning." 216 (interactive "p") ; change this to "P", maybe, if we ever come to pass ARG 217 ; to beginning-of-defun-function. 218 (unless arg (setq arg 1)) 219 (cond 220 (beginning-of-defun-function 221 (if (> arg 0) 222 (dotimes (i arg) 223 (funcall beginning-of-defun-function)) 224 ;; Better not call end-of-defun-function directly, in case 225 ;; it's not defined. 226 (end-of-defun (- arg)))) 227 228 ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start) 229 (and (< arg 0) (not (eobp)) (forward-char 1)) 230 (and (re-search-backward (if defun-prompt-regexp 231 (concat (if open-paren-in-column-0-is-defun-start 232 "^\\s(\\|" "") 233 "\\(?:" defun-prompt-regexp "\\)\\s(") 234 "^\\s(") 235 nil 'move arg) 236 (progn (goto-char (1- (match-end 0)))) t)) 237 238 ;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp 239 ;; are both nil, column 0 has no significance - so scan forward 240 ;; from BOB to see how nested point is, then carry on from there. 241 ;; 242 ;; It is generally not a good idea to land up here, because the 243 ;; call to scan-lists below can be extremely slow. This is because 244 ;; back_comment in syntax.c may have to scan from bob to find the 245 ;; beginning of each comment. Fixing this is not trivial -- cyd. 246 247 ((eq arg 0)) 248 (t 249 (let ((floor (point-min)) 250 (ceiling (point-max)) 251 (arg-+ve (> arg 0))) 252 (save-restriction 253 (widen) 254 (let ((ppss (let (syntax-begin-function 255 font-lock-beginning-of-syntax-function) 256 (syntax-ppss))) 257 ;; position of least enclosing paren, or nil. 258 encl-pos) 259 ;; Back out of any comment/string, so that encl-pos will always 260 ;; become nil if we're at top-level. 261 (when (nth 8 ppss) 262 (goto-char (nth 8 ppss)) 263 (setq ppss (syntax-ppss))) ; should be fast, due to cache. 264 (setq encl-pos (syntax-ppss-toplevel-pos ppss)) 265 (if encl-pos (goto-char encl-pos)) 266 267 (and encl-pos arg-+ve (setq arg (1- arg))) 268 (and (not encl-pos) (not arg-+ve) (not (looking-at "\\s(")) 269 (setq arg (1+ arg))) 270 271 (condition-case nil ; to catch crazy parens. 272 (progn 273 (goto-char (scan-lists (point) (- arg) 0)) 274 (if arg-+ve 275 (if (>= (point) floor) 276 t 277 (goto-char floor) 278 nil) 279 ;; forward to next (, or trigger the c-c 280 (goto-char (1- (scan-lists (point) 1 -1))) 281 (if (<= (point) ceiling) 282 t 283 (goto-char ceiling) 284 nil))) 285 (error 286 (goto-char (if arg-+ve floor ceiling)) 287 nil)))))))) 288 289(defvar end-of-defun-function nil 290 "If non-nil, function for function `end-of-defun' to call. 291This is used to find the end of the defun instead of using the normal 292recipe (see `end-of-defun'). Major modes can define this if the 293normal method is not appropriate.") 294 295(defun buffer-end (arg) 296 "Return the \"far end\" position of the buffer, in direction ARG. 297If ARG is positive, that's the end of the buffer. 298Otherwise, that's the beginning of the buffer." 299 (if (> arg 0) (point-max) (point-min))) 300 301(defun end-of-defun (&optional arg) 302 "Move forward to next end of defun. 303With argument, do it that many times. 304Negative argument -N means move back to Nth preceding end of defun. 305 306An end of a defun occurs right after the close-parenthesis that 307matches the open-parenthesis that starts a defun; see function 308`beginning-of-defun'. 309 310If variable `end-of-defun-function' is non-nil, its value 311is called as a function to find the defun's end." 312 (interactive "p") 313 (or (not (eq this-command 'end-of-defun)) 314 (eq last-command 'end-of-defun) 315 (and transient-mark-mode mark-active) 316 (push-mark)) 317 (if (or (null arg) (= arg 0)) (setq arg 1)) 318 (if end-of-defun-function 319 (if (> arg 0) 320 (dotimes (i arg) 321 (funcall end-of-defun-function)) 322 ;; Better not call beginning-of-defun-function 323 ;; directly, in case it's not defined. 324 (beginning-of-defun (- arg))) 325 (let ((first t)) 326 (while (and (> arg 0) (< (point) (point-max))) 327 (let ((pos (point))) 328 (while (progn 329 (if (and first 330 (progn 331 (end-of-line 1) 332 (beginning-of-defun-raw 1))) 333 nil 334 (or (bobp) (forward-char -1)) 335 (beginning-of-defun-raw -1)) 336 (setq first nil) 337 (forward-list 1) 338 (skip-chars-forward " \t") 339 (if (looking-at "\\s<\\|\n") 340 (forward-line 1)) 341 (<= (point) pos)))) 342 (setq arg (1- arg))) 343 (while (< arg 0) 344 (let ((pos (point))) 345 (beginning-of-defun-raw 1) 346 (forward-sexp 1) 347 (forward-line 1) 348 (if (>= (point) pos) 349 (if (beginning-of-defun-raw 2) 350 (progn 351 (forward-list 1) 352 (skip-chars-forward " \t") 353 (if (looking-at "\\s<\\|\n") 354 (forward-line 1))) 355 (goto-char (point-min))))) 356 (setq arg (1+ arg)))))) 357 358(defun mark-defun (&optional allow-extend) 359 "Put mark at end of this defun, point at beginning. 360The defun marked is the one that contains point or follows point. 361 362Interactively, if this command is repeated 363or (in Transient Mark mode) if the mark is active, 364it marks the next defun after the ones already marked." 365 (interactive "p") 366 (cond ((and allow-extend 367 (or (and (eq last-command this-command) (mark t)) 368 (and transient-mark-mode mark-active))) 369 (set-mark 370 (save-excursion 371 (goto-char (mark)) 372 (end-of-defun) 373 (point)))) 374 (t 375 (let ((opoint (point)) 376 beg end) 377 (push-mark opoint) 378 ;; Try first in this order for the sake of languages with nested 379 ;; functions where several can end at the same place as with 380 ;; the offside rule, e.g. Python. 381 (beginning-of-defun) 382 (setq beg (point)) 383 (end-of-defun) 384 (setq end (point)) 385 (while (looking-at "^\n") 386 (forward-line 1)) 387 (if (> (point) opoint) 388 (progn 389 ;; We got the right defun. 390 (push-mark beg nil t) 391 (goto-char end) 392 (exchange-point-and-mark)) 393 ;; beginning-of-defun moved back one defun 394 ;; so we got the wrong one. 395 (goto-char opoint) 396 (end-of-defun) 397 (push-mark (point) nil t) 398 (beginning-of-defun)) 399 (re-search-backward "^\n" (- (point) 1) t))))) 400 401(defun narrow-to-defun (&optional arg) 402 "Make text outside current defun invisible. 403The defun visible is the one that contains point or follows point. 404Optional ARG is ignored." 405 (interactive) 406 (save-excursion 407 (widen) 408 (let ((opoint (point)) 409 beg end) 410 ;; Try first in this order for the sake of languages with nested 411 ;; functions where several can end at the same place as with 412 ;; the offside rule, e.g. Python. 413 (beginning-of-defun) 414 (setq beg (point)) 415 (end-of-defun) 416 (setq end (point)) 417 (while (looking-at "^\n") 418 (forward-line 1)) 419 (unless (> (point) opoint) 420 ;; beginning-of-defun moved back one defun 421 ;; so we got the wrong one. 422 (goto-char opoint) 423 (end-of-defun) 424 (setq end (point)) 425 (beginning-of-defun) 426 (setq beg (point))) 427 (goto-char end) 428 (re-search-backward "^\n" (- (point) 1) t) 429 (narrow-to-region beg end)))) 430 431(defvar insert-pair-alist 432 '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\')) 433 "Alist of paired characters inserted by `insert-pair'. 434Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR 435OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR 436of the pair whose key is equal to the last input character with 437or without modifiers, are inserted by `insert-pair'.") 438 439(defun insert-pair (&optional arg open close) 440 "Enclose following ARG sexps in a pair of OPEN and CLOSE characters. 441Leave point after the first character. 442A negative ARG encloses the preceding ARG sexps instead. 443No argument is equivalent to zero: just insert characters 444and leave point between. 445If `parens-require-spaces' is non-nil, this command also inserts a space 446before and after, depending on the surrounding characters. 447If region is active, insert enclosing characters at region boundaries. 448 449If arguments OPEN and CLOSE are nil, the character pair is found 450from the variable `insert-pair-alist' according to the last input 451character with or without modifiers. If no character pair is 452found in the variable `insert-pair-alist', then the last input 453character is inserted ARG times." 454 (interactive "P") 455 (if (not (and open close)) 456 (let ((pair (or (assq last-command-char insert-pair-alist) 457 (assq (event-basic-type last-command-event) 458 insert-pair-alist)))) 459 (if pair 460 (if (nth 2 pair) 461 (setq open (nth 1 pair) close (nth 2 pair)) 462 (setq open (nth 0 pair) close (nth 1 pair)))))) 463 (if (and open close) 464 (if (and transient-mark-mode mark-active) 465 (progn 466 (save-excursion (goto-char (region-end)) (insert close)) 467 (save-excursion (goto-char (region-beginning)) (insert open))) 468 (if arg (setq arg (prefix-numeric-value arg)) 469 (setq arg 0)) 470 (cond ((> arg 0) (skip-chars-forward " \t")) 471 ((< arg 0) (forward-sexp arg) (setq arg (- arg)))) 472 (and parens-require-spaces 473 (not (bobp)) 474 (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close))) 475 (insert " ")) 476 (insert open) 477 (save-excursion 478 (or (eq arg 0) (forward-sexp arg)) 479 (insert close) 480 (and parens-require-spaces 481 (not (eobp)) 482 (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open))) 483 (insert " ")))) 484 (insert-char (event-basic-type last-command-event) 485 (prefix-numeric-value arg)))) 486 487(defun insert-parentheses (&optional arg) 488 "Enclose following ARG sexps in parentheses. 489Leave point after open-paren. 490A negative ARG encloses the preceding ARG sexps instead. 491No argument is equivalent to zero: just insert `()' and leave point between. 492If `parens-require-spaces' is non-nil, this command also inserts a space 493before and after, depending on the surrounding characters. 494If region is active, insert enclosing characters at region boundaries." 495 (interactive "P") 496 (insert-pair arg ?\( ?\))) 497 498(defun delete-pair () 499 "Delete a pair of characters enclosing the sexp that follows point." 500 (interactive) 501 (save-excursion (forward-sexp 1) (delete-char -1)) 502 (delete-char 1)) 503 504(defun raise-sexp (&optional arg) 505 "Raise ARG sexps higher up the tree." 506 (interactive "p") 507 (let ((s (if (and transient-mark-mode mark-active) 508 (buffer-substring (region-beginning) (region-end)) 509 (buffer-substring 510 (point) 511 (save-excursion (forward-sexp arg) (point)))))) 512 (backward-up-list 1) 513 (delete-region (point) (save-excursion (forward-sexp 1) (point))) 514 (save-excursion (insert s)))) 515 516(defun move-past-close-and-reindent () 517 "Move past next `)', delete indentation before it, then indent after it." 518 (interactive) 519 (up-list 1) 520 (forward-char -1) 521 (while (save-excursion ; this is my contribution 522 (let ((before-paren (point))) 523 (back-to-indentation) 524 (and (= (point) before-paren) 525 (progn 526 ;; Move to end of previous line. 527 (beginning-of-line) 528 (forward-char -1) 529 ;; Verify it doesn't end within a string or comment. 530 (let ((end (point)) 531 state) 532 (beginning-of-line) 533 ;; Get state at start of line. 534 (setq state (list 0 nil nil 535 (null (calculate-lisp-indent)) 536 nil nil nil nil 537 nil)) 538 ;; Parse state across the line to get state at end. 539 (setq state (parse-partial-sexp (point) end nil nil 540 state)) 541 ;; Check not in string or comment. 542 (and (not (elt state 3)) (not (elt state 4)))))))) 543 (delete-indentation)) 544 (forward-char 1) 545 (newline-and-indent)) 546 547(defun check-parens () ; lame name? 548 "Check for unbalanced parentheses in the current buffer. 549More accurately, check the narrowed part of the buffer for unbalanced 550expressions (\"sexps\") in general. This is done according to the 551current syntax table and will find unbalanced brackets or quotes as 552appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is 553found, an error is signaled and point is left at the first unbalanced 554character." 555 (interactive) 556 (condition-case data 557 ;; Buffer can't have more than (point-max) sexps. 558 (scan-sexps (point-min) (point-max)) 559 (scan-error (goto-char (nth 2 data)) 560 ;; Could print (nth 1 data), which is either 561 ;; "Containing expression ends prematurely" or 562 ;; "Unbalanced parentheses", but those may not be so 563 ;; accurate/helpful, e.g. quotes may actually be 564 ;; mismatched. 565 (error "Unmatched bracket or quote")) 566 (error (cond ((eq 'scan-error (car data)) 567 (goto-char (nth 2 data)) 568 (error "Unmatched bracket or quote")) 569 (t (signal (car data) (cdr data))))))) 570 571(defun lisp-complete-symbol (&optional predicate) 572 "Perform completion on Lisp symbol preceding point. 573Compare that symbol against the known Lisp symbols. 574If no characters can be completed, display a list of possible completions. 575Repeating the command at that point scrolls the list. 576 577When called from a program, optional arg PREDICATE is a predicate 578determining which symbols are considered, e.g. `commandp'. 579If PREDICATE is nil, the context determines which symbols are 580considered. If the symbol starts just after an open-parenthesis, only 581symbols with function definitions are considered. Otherwise, all 582symbols with function definitions, values or properties are 583considered." 584 (interactive) 585 (let ((window (get-buffer-window "*Completions*" 0))) 586 (if (and (eq last-command this-command) 587 window (window-live-p window) (window-buffer window) 588 (buffer-name (window-buffer window))) 589 ;; If this command was repeated, and 590 ;; there's a fresh completion window with a live buffer, 591 ;; and this command is repeated, scroll that window. 592 (with-current-buffer (window-buffer window) 593 (if (pos-visible-in-window-p (point-max) window) 594 (set-window-start window (point-min)) 595 (save-selected-window 596 (select-window window) 597 (scroll-up)))) 598 599 ;; Do completion. 600 (let* ((end (point)) 601 (beg (with-syntax-table emacs-lisp-mode-syntax-table 602 (save-excursion 603 (backward-sexp 1) 604 (while (= (char-syntax (following-char)) ?\') 605 (forward-char 1)) 606 (point)))) 607 (pattern (buffer-substring-no-properties beg end)) 608 (predicate 609 (or predicate 610 (save-excursion 611 (goto-char beg) 612 (if (not (eq (char-before) ?\()) 613 (lambda (sym) ;why not just nil ? -sm 614 (or (boundp sym) (fboundp sym) 615 (symbol-plist sym))) 616 ;; Looks like a funcall position. Let's double check. 617 (if (condition-case nil 618 (progn (up-list -2) (forward-char 1) 619 (eq (char-after) ?\()) 620 (error nil)) 621 ;; If the first element of the parent list is an open 622 ;; parenthesis we are probably not in a funcall position. 623 ;; Maybe a `let' varlist or something. 624 nil 625 ;; Else, we assume that a function name is expected. 626 'fboundp))))) 627 (completion (try-completion pattern obarray predicate))) 628 (cond ((eq completion t)) 629 ((null completion) 630 (message "Can't find completion for \"%s\"" pattern) 631 (ding)) 632 ((not (string= pattern completion)) 633 (delete-region beg end) 634 (insert completion) 635 ;; Don't leave around a completions buffer that's out of date. 636 (let ((win (get-buffer-window "*Completions*" 0))) 637 (if win (with-selected-window win (bury-buffer))))) 638 (t 639 (let ((minibuf-is-in-use 640 (eq (minibuffer-window) (selected-window)))) 641 (unless minibuf-is-in-use 642 (message "Making completion list...")) 643 (let ((list (all-completions pattern obarray predicate))) 644 (setq list (sort list 'string<)) 645 (or (eq predicate 'fboundp) 646 (let (new) 647 (while list 648 (setq new (cons (if (fboundp (intern (car list))) 649 (list (car list) " <f>") 650 (car list)) 651 new)) 652 (setq list (cdr list))) 653 (setq list (nreverse new)))) 654 (if (> (length list) 1) 655 (with-output-to-temp-buffer "*Completions*" 656 (display-completion-list list pattern)) 657 ;; Don't leave around a completions buffer that's 658 ;; out of date. 659 (let ((win (get-buffer-window "*Completions*" 0))) 660 (if win (with-selected-window win (bury-buffer)))))) 661 (unless minibuf-is-in-use 662 (message "Making completion list...%s" "done"))))))))) 663 664;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e 665;;; lisp.el ends here 666