aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/subr.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/subr.el')
-rw-r--r--lisp/subr.el126
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'.
1398FILE, 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.
1413Return 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.
1398This makes or adds to an entry on `after-load-alist'.
1399If FILE is already loaded, evaluate FORM right now. 1426If FILE is already loaded, evaluate FORM right now.
1400It does nothing if FORM is already on the list for FILE. 1427
1401FILE must match exactly. Normally FILE is the name of a library, 1428If a matching file is loaded again, FORM will be evaluated again.
1402with no directory or extension specified, since that is how `load' 1429
1403is normally called. 1430If FILE is a string, it may be either an absolute or a relative file
1404FILE can also be a feature (i.e. a symbol), in which case FORM is 1431name, and may have an extension \(e.g. \".el\") or may lack one, and
1405evaluated whenever that feature is `provide'd." 1432additionally may or may not have an extension denoting a compressed
1406 (let ((elt (assoc file after-load-alist))) 1433format \(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)) 1435When FILE is absolute, this first converts it to a true name by chasing
1409 ;; Add FORM to the element if it isn't there. 1436symbolic links. Only a file of this name \(see next paragraph regarding
1437extensions) will trigger the evaluation of FORM. When FILE is relative,
1438a file whose absolute true name ends in FILE will trigger evaluation.
1439
1440When FILE lacks an extension, a file name with any extension will trigger
1441evaluation. Otherwise, its extension must match FILE's. A further
1442extension for a compressed format \(e.g. \".gz\") on FILE will not affect
1443this name matching.
1444
1445Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
1446is evaluated whenever that feature is `provide'd.
1447
1448Usually FILE is just a library name like \"font-lock\" or a feature name
1449like 'font-lock.
1450
1451This 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.
1473ABS-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.
1555This function echoes `.' for each character that the user types. 1617This function echoes `.' for each character that the user types.
1556The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. 1618The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
1557C-g quits; if `inhibit-quit' was non-nil around this function, 1619C-g quits; if `inhibit-quit' was non-nil around this function,
1558then it returns nil if the user types C-g. 1620then it returns nil if the user types C-g, but quit-flag remains set.
1559 1621
1560Once the caller uses the password, it can erase the password 1622Once the caller uses the password, it can erase the password
1561by doing (clear-string STRING)." 1623by 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.
2206BUFFER can be a buffer or a buffer name.
2141The value returned is the value of the last form in BODY. 2207The value returned is the value of the last form in BODY.
2142See also `with-temp-buffer'." 2208See 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.
2252When a quit terminates BODY, `with-local-quit' returns nil but 2318When a quit terminates BODY, `with-local-quit' returns nil but
2253requests another quit. That quit will be processed, the next time quitting 2319requests another quit. That quit will be processed as soon as quitting
2254is allowed once again." 2320is 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.