diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 126 |
1 files changed, 99 insertions, 27 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index cd0ce2d3f33..387228fbb8c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1393,32 +1393,94 @@ That function's doc string says which file created it." | |||
| 1393 | t)) | 1393 | t)) |
| 1394 | nil)) | 1394 | nil)) |
| 1395 | 1395 | ||
| 1396 | (defun load-history-regexp (file) | ||
| 1397 | "Form a regexp to find FILE in `load-history'. | ||
| 1398 | FILE, a string, is described in the function `eval-after-load'." | ||
| 1399 | (if (file-name-absolute-p file) | ||
| 1400 | (setq file (file-truename file))) | ||
| 1401 | (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") | ||
| 1402 | (regexp-quote file) | ||
| 1403 | (if (file-name-extension file) | ||
| 1404 | "" | ||
| 1405 | ;; Note: regexp-opt can't be used here, since we need to call | ||
| 1406 | ;; this before Emacs has been fully started. 2006-05-21 | ||
| 1407 | (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) | ||
| 1408 | "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") | ||
| 1409 | "\\)?\\'")) | ||
| 1410 | |||
| 1411 | (defun load-history-filename-element (file-regexp) | ||
| 1412 | "Get the first elt of `load-history' whose car matches FILE-REGEXP. | ||
| 1413 | Return nil if there isn't one." | ||
| 1414 | (let* ((loads load-history) | ||
| 1415 | (load-elt (and loads (car loads)))) | ||
| 1416 | (save-match-data | ||
| 1417 | (while (and loads | ||
| 1418 | (or (null (car load-elt)) | ||
| 1419 | (not (string-match file-regexp (car load-elt))))) | ||
| 1420 | (setq loads (cdr loads) | ||
| 1421 | load-elt (and loads (car loads))))) | ||
| 1422 | load-elt)) | ||
| 1423 | |||
| 1396 | (defun eval-after-load (file form) | 1424 | (defun eval-after-load (file form) |
| 1397 | "Arrange that, if FILE is ever loaded, FORM will be run at that time. | 1425 | "Arrange that, if FILE is ever loaded, FORM will be run at that time. |
| 1398 | This makes or adds to an entry on `after-load-alist'. | ||
| 1399 | If FILE is already loaded, evaluate FORM right now. | 1426 | If FILE is already loaded, evaluate FORM right now. |
| 1400 | It does nothing if FORM is already on the list for FILE. | 1427 | |
| 1401 | FILE must match exactly. Normally FILE is the name of a library, | 1428 | If a matching file is loaded again, FORM will be evaluated again. |
| 1402 | with no directory or extension specified, since that is how `load' | 1429 | |
| 1403 | is normally called. | 1430 | If FILE is a string, it may be either an absolute or a relative file |
| 1404 | FILE can also be a feature (i.e. a symbol), in which case FORM is | 1431 | name, and may have an extension \(e.g. \".el\") or may lack one, and |
| 1405 | evaluated whenever that feature is `provide'd." | 1432 | additionally may or may not have an extension denoting a compressed |
| 1406 | (let ((elt (assoc file after-load-alist))) | 1433 | format \(e.g. \".gz\"). |
| 1407 | ;; Make sure there is an element for FILE. | 1434 | |
| 1408 | (unless elt (setq elt (list file)) (push elt after-load-alist)) | 1435 | When FILE is absolute, this first converts it to a true name by chasing |
| 1409 | ;; Add FORM to the element if it isn't there. | 1436 | symbolic links. Only a file of this name \(see next paragraph regarding |
| 1437 | extensions) will trigger the evaluation of FORM. When FILE is relative, | ||
| 1438 | a file whose absolute true name ends in FILE will trigger evaluation. | ||
| 1439 | |||
| 1440 | When FILE lacks an extension, a file name with any extension will trigger | ||
| 1441 | evaluation. Otherwise, its extension must match FILE's. A further | ||
| 1442 | extension for a compressed format \(e.g. \".gz\") on FILE will not affect | ||
| 1443 | this name matching. | ||
| 1444 | |||
| 1445 | Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM | ||
| 1446 | is evaluated whenever that feature is `provide'd. | ||
| 1447 | |||
| 1448 | Usually FILE is just a library name like \"font-lock\" or a feature name | ||
| 1449 | like 'font-lock. | ||
| 1450 | |||
| 1451 | This function makes or adds to an entry on `after-load-alist'." | ||
| 1452 | ;; Add this FORM into after-load-alist (regardless of whether we'll be | ||
| 1453 | ;; evaluating it now). | ||
| 1454 | (let* ((regexp-or-feature | ||
| 1455 | (if (stringp file) (load-history-regexp file) file)) | ||
| 1456 | (elt (assoc regexp-or-feature after-load-alist))) | ||
| 1457 | (unless elt | ||
| 1458 | (setq elt (list regexp-or-feature)) | ||
| 1459 | (push elt after-load-alist)) | ||
| 1460 | ;; Add FORM to the element unless it's already there. | ||
| 1410 | (unless (member form (cdr elt)) | 1461 | (unless (member form (cdr elt)) |
| 1411 | (nconc elt (list form)) | 1462 | (nconc elt (list form))) |
| 1412 | ;; If the file has been loaded already, run FORM right away. | 1463 | |
| 1413 | (if (if (symbolp file) | 1464 | ;; Is there an already loaded file whose name (or `provide' name) |
| 1414 | (featurep file) | 1465 | ;; matches FILE? |
| 1415 | ;; Make sure `load-history' contains the files dumped with | 1466 | (if (if (stringp file) |
| 1416 | ;; Emacs for the case that FILE is one of them. | 1467 | (load-history-filename-element regexp-or-feature) |
| 1417 | ;; (load-symbol-file-load-history) | 1468 | (featurep file)) |
| 1418 | (when (locate-library file) | 1469 | (eval form)))) |
| 1419 | (assoc (locate-library file) load-history))) | 1470 | |
| 1420 | (eval form)))) | 1471 | (defun do-after-load-evaluation (abs-file) |
| 1421 | form) | 1472 | "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. |
| 1473 | ABS-FILE, a string, should be the absolute true name of a file just loaded." | ||
| 1474 | (let ((after-load-elts after-load-alist) | ||
| 1475 | a-l-element file-elements file-element form) | ||
| 1476 | (while after-load-elts | ||
| 1477 | (setq a-l-element (car after-load-elts) | ||
| 1478 | after-load-elts (cdr after-load-elts)) | ||
| 1479 | (when (and (stringp (car a-l-element)) | ||
| 1480 | (string-match (car a-l-element) abs-file)) | ||
| 1481 | (while (setq a-l-element (cdr a-l-element)) ; discard the file name | ||
| 1482 | (setq form (car a-l-element)) | ||
| 1483 | (eval form)))))) | ||
| 1422 | 1484 | ||
| 1423 | (defun eval-next-after-load (file) | 1485 | (defun eval-next-after-load (file) |
| 1424 | "Read the following input sexp, and run it whenever FILE is loaded. | 1486 | "Read the following input sexp, and run it whenever FILE is loaded. |
| @@ -1555,7 +1617,7 @@ Optional DEFAULT is a default password to use instead of empty input. | |||
| 1555 | This function echoes `.' for each character that the user types. | 1617 | This function echoes `.' for each character that the user types. |
| 1556 | The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. | 1618 | The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. |
| 1557 | C-g quits; if `inhibit-quit' was non-nil around this function, | 1619 | C-g quits; if `inhibit-quit' was non-nil around this function, |
| 1558 | then it returns nil if the user types C-g. | 1620 | then it returns nil if the user types C-g, but quit-flag remains set. |
| 1559 | 1621 | ||
| 1560 | Once the caller uses the password, it can erase the password | 1622 | Once the caller uses the password, it can erase the password |
| 1561 | by doing (clear-string STRING)." | 1623 | by doing (clear-string STRING)." |
| @@ -1575,6 +1637,9 @@ by doing (clear-string STRING)." | |||
| 1575 | (sit-for 1)))) | 1637 | (sit-for 1)))) |
| 1576 | success) | 1638 | success) |
| 1577 | (let ((pass nil) | 1639 | (let ((pass nil) |
| 1640 | ;; Copy it so that add-text-properties won't modify | ||
| 1641 | ;; the object that was passed in by the caller. | ||
| 1642 | (prompt (copy-sequence prompt)) | ||
| 1578 | (c 0) | 1643 | (c 0) |
| 1579 | (echo-keystrokes 0) | 1644 | (echo-keystrokes 0) |
| 1580 | (cursor-in-echo-area t) | 1645 | (cursor-in-echo-area t) |
| @@ -2137,7 +2202,8 @@ If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." | |||
| 2137 | ;;;; Lisp macros to do various things temporarily. | 2202 | ;;;; Lisp macros to do various things temporarily. |
| 2138 | 2203 | ||
| 2139 | (defmacro with-current-buffer (buffer &rest body) | 2204 | (defmacro with-current-buffer (buffer &rest body) |
| 2140 | "Execute the forms in BODY with BUFFER as the current buffer. | 2205 | "Execute the forms in BODY with BUFFER temporarily current. |
| 2206 | BUFFER can be a buffer or a buffer name. | ||
| 2141 | The value returned is the value of the last form in BODY. | 2207 | The value returned is the value of the last form in BODY. |
| 2142 | See also `with-temp-buffer'." | 2208 | See also `with-temp-buffer'." |
| 2143 | (declare (indent 1) (debug t)) | 2209 | (declare (indent 1) (debug t)) |
| @@ -2250,13 +2316,19 @@ See also `with-temp-file' and `with-output-to-string'." | |||
| 2250 | (defmacro with-local-quit (&rest body) | 2316 | (defmacro with-local-quit (&rest body) |
| 2251 | "Execute BODY, allowing quits to terminate BODY but not escape further. | 2317 | "Execute BODY, allowing quits to terminate BODY but not escape further. |
| 2252 | When a quit terminates BODY, `with-local-quit' returns nil but | 2318 | When a quit terminates BODY, `with-local-quit' returns nil but |
| 2253 | requests another quit. That quit will be processed, the next time quitting | 2319 | requests another quit. That quit will be processed as soon as quitting |
| 2254 | is allowed once again." | 2320 | is allowed once again. (Immediately, if `inhibit-quit' is nil.)" |
| 2255 | (declare (debug t) (indent 0)) | 2321 | (declare (debug t) (indent 0)) |
| 2256 | `(condition-case nil | 2322 | `(condition-case nil |
| 2257 | (let ((inhibit-quit nil)) | 2323 | (let ((inhibit-quit nil)) |
| 2258 | ,@body) | 2324 | ,@body) |
| 2259 | (quit (setq quit-flag t) nil))) | 2325 | (quit (setq quit-flag t) |
| 2326 | ;; This call is to give a chance to handle quit-flag | ||
| 2327 | ;; in case inhibit-quit is nil. | ||
| 2328 | ;; Without this, it will not be handled until the next function | ||
| 2329 | ;; call, and that might allow it to exit thru a condition-case | ||
| 2330 | ;; that intends to handle the quit signal next time. | ||
| 2331 | (eval '(ignore nil))))) | ||
| 2260 | 2332 | ||
| 2261 | (defmacro while-no-input (&rest body) | 2333 | (defmacro while-no-input (&rest body) |
| 2262 | "Execute BODY only as long as there's no pending input. | 2334 | "Execute BODY only as long as there's no pending input. |