comparison lisp/subr.el @ 81803:f7d2bfbd3abc

*** empty log message ***
author Stefan Monnier <monnier@iro.umontreal.ca>
date Tue, 10 Jul 2007 19:54:43 +0000
parents f1d802f34413
children 885122f2f146
comparison
equal deleted inserted replaced
81802:dc2bceb79a0a 81803:f7d2bfbd3abc
508 (setq a (car a) b (car b)) 508 (setq a (car a) b (car b))
509 (if (integerp a) 509 (if (integerp a)
510 (if (integerp b) (< a b) 510 (if (integerp b) (< a b)
511 t) 511 t)
512 (if (integerp b) t 512 (if (integerp b) t
513 ;; string< also accepts symbols.
513 (string< a b)))))) 514 (string< a b))))))
514 (dolist (p list) 515 (dolist (p list)
515 (funcall function (car p) (cdr p)))) 516 (funcall function (car p) (cdr p))))
516 (map-keymap function keymap))) 517 (map-keymap function keymap)))
517 518
2483 (catch ',catch-sym 2484 (catch ',catch-sym
2484 (let ((throw-on-input ',catch-sym)) 2485 (let ((throw-on-input ',catch-sym))
2485 (or (input-pending-p) 2486 (or (input-pending-p)
2486 ,@body)))))) 2487 ,@body))))))
2487 2488
2489 (defmacro condition-case-no-debug (var bodyform &rest handlers)
2490 "Like `condition-case' except that it does not catch anything when debugging.
2491 More specifically if `debug-on-error' is set, then it does not catch any signal."
2492 (declare (debug condition-case) (indent 2))
2493 (let ((bodysym (make-symbol "body")))
2494 `(let ((,bodysym (lambda () ,bodyform)))
2495 (if debug-on-error
2496 (funcall ,bodysym)
2497 (condition-case ,var
2498 (funcall ,bodysym)
2499 ,@handlers)))))
2500
2501 (defmacro with-demoted-errors (&rest body)
2502 "Run BODY and demote any errors to simple messages.
2503 If `debug-on-error' is non-nil, run BODY without catching its errors.
2504 This is to be used around code which is not expected to signal an error
2505 but which should be robust in the unexpected case that an error is signalled."
2506 (declare (debug t) (indent 0))
2507 (let ((err (make-symbol "err")))
2508 `(condition-case-no-debug ,err
2509 (progn ,@body)
2510 (error (message "Error: %s" ,err) nil))))
2511
2488 (defmacro combine-after-change-calls (&rest body) 2512 (defmacro combine-after-change-calls (&rest body)
2489 "Execute BODY, but don't call the after-change functions till the end. 2513 "Execute BODY, but don't call the after-change functions till the end.
2490 If BODY makes changes in the buffer, they are recorded 2514 If BODY makes changes in the buffer, they are recorded
2491 and the functions on `after-change-functions' are called several times 2515 and the functions on `after-change-functions' are called several times
2492 when BODY is finished. 2516 when BODY is finished.
2517 (with-current-buffer ,old-buffer 2541 (with-current-buffer ,old-buffer
2518 (set-case-table ,old-case-table)))))) 2542 (set-case-table ,old-case-table))))))
2519 2543
2520 ;;;; Constructing completion tables. 2544 ;;;; Constructing completion tables.
2521 2545
2546 (defun complete-with-action (action table string pred)
2547 "Perform completion ACTION.
2548 STRING is the string to complete.
2549 TABLE is the completion table, which should not be a function.
2550 PRED is a completion predicate.
2551 ACTION can be one of nil, t or `lambda'."
2552 ;; (assert (not (functionp table)))
2553 (funcall
2554 (cond
2555 ((null action) 'try-completion)
2556 ((eq action t) 'all-completions)
2557 (t 'test-completion))
2558 string table pred))
2559
2522 (defmacro dynamic-completion-table (fun) 2560 (defmacro dynamic-completion-table (fun)
2523 "Use function FUN as a dynamic completion table. 2561 "Use function FUN as a dynamic completion table.
2524 FUN is called with one argument, the string for which completion is required, 2562 FUN is called with one argument, the string for which completion is required,
2525 and it should return an alist containing all the intended possible 2563 and it should return an alist containing all the intended possible
2526 completions. This alist may be a full list of possible completions so that FUN 2564 completions. This alist may be a full list of possible completions so that FUN
2538 (mode (make-symbol "mode"))) 2576 (mode (make-symbol "mode")))
2539 `(lambda (,string ,predicate ,mode) 2577 `(lambda (,string ,predicate ,mode)
2540 (with-current-buffer (let ((,win (minibuffer-selected-window))) 2578 (with-current-buffer (let ((,win (minibuffer-selected-window)))
2541 (if (window-live-p ,win) (window-buffer ,win) 2579 (if (window-live-p ,win) (window-buffer ,win)
2542 (current-buffer))) 2580 (current-buffer)))
2543 (cond 2581 (complete-with-action ,mode (,fun ,string) ,string ,predicate)))))
2544 ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate))
2545 ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
2546 (t (test-completion ,string (,fun ,string) ,predicate)))))))
2547 2582
2548 (defmacro lazy-completion-table (var fun) 2583 (defmacro lazy-completion-table (var fun)
2549 ;; We used to have `&rest args' where `args' were evaluated late (at the 2584 ;; We used to have `&rest args' where `args' were evaluated late (at the
2550 ;; time of the call to `fun'), which was counter intuitive. But to get 2585 ;; time of the call to `fun'), which was counter intuitive. But to get
2551 ;; them to be evaluated early, we have to either use lexical-let (which is 2586 ;; them to be evaluated early, we have to either use lexical-let (which is