Mercurial > emacs
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 |