diff options
Diffstat (limited to 'lisp/subr.el')
| -rw-r--r-- | lisp/subr.el | 79 |
1 files changed, 41 insertions, 38 deletions
diff --git a/lisp/subr.el b/lisp/subr.el index d9d918ed12d..b3f9f902349 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -1789,7 +1789,8 @@ Return the new history list. | |||
| 1789 | If MAXELT is non-nil, it specifies the maximum length of the history. | 1789 | If MAXELT is non-nil, it specifies the maximum length of the history. |
| 1790 | Otherwise, the maximum history length is the value of the `history-length' | 1790 | Otherwise, the maximum history length is the value of the `history-length' |
| 1791 | property on symbol HISTORY-VAR, if set, or the value of the `history-length' | 1791 | property on symbol HISTORY-VAR, if set, or the value of the `history-length' |
| 1792 | variable. | 1792 | variable. The possible values of maximum length have the same meaning as |
| 1793 | the values of `history-length'. | ||
| 1793 | Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. | 1794 | Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. |
| 1794 | If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even | 1795 | If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even |
| 1795 | if it is empty or a duplicate." | 1796 | if it is empty or a duplicate." |
| @@ -1998,6 +1999,25 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." | |||
| 1998 | ;; "Return the name of the file from which AUTOLOAD will be loaded. | 1999 | ;; "Return the name of the file from which AUTOLOAD will be loaded. |
| 1999 | ;; \n\(fn AUTOLOAD)") | 2000 | ;; \n\(fn AUTOLOAD)") |
| 2000 | 2001 | ||
| 2002 | (defun define-symbol-prop (symbol prop val) | ||
| 2003 | "Define the property PROP of SYMBOL to be VAL. | ||
| 2004 | This is to `put' what `defalias' is to `fset'." | ||
| 2005 | ;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)). | ||
| 2006 | ;; (cl-pushnew symbol (alist-get prop | ||
| 2007 | ;; (alist-get 'define-symbol-props | ||
| 2008 | ;; current-load-list))) | ||
| 2009 | (let ((sps (assq 'define-symbol-props current-load-list))) | ||
| 2010 | (unless sps | ||
| 2011 | (setq sps (list 'define-symbol-props)) | ||
| 2012 | (push sps current-load-list)) | ||
| 2013 | (let ((ps (assq prop sps))) | ||
| 2014 | (unless ps | ||
| 2015 | (setq ps (list prop)) | ||
| 2016 | (setcdr sps (cons ps (cdr sps)))) | ||
| 2017 | (unless (member symbol (cdr ps)) | ||
| 2018 | (setcdr ps (cons symbol (cdr ps)))))) | ||
| 2019 | (put symbol prop val)) | ||
| 2020 | |||
| 2001 | (defun symbol-file (symbol &optional type) | 2021 | (defun symbol-file (symbol &optional type) |
| 2002 | "Return the name of the file that defined SYMBOL. | 2022 | "Return the name of the file that defined SYMBOL. |
| 2003 | The value is normally an absolute file name. It can also be nil, | 2023 | The value is normally an absolute file name. It can also be nil, |
| @@ -2007,47 +2027,30 @@ file name without extension. | |||
| 2007 | 2027 | ||
| 2008 | If TYPE is nil, then any kind of definition is acceptable. If | 2028 | If TYPE is nil, then any kind of definition is acceptable. If |
| 2009 | TYPE is `defun', `defvar', or `defface', that specifies function | 2029 | TYPE is `defun', `defvar', or `defface', that specifies function |
| 2010 | definition, variable definition, or face definition only." | 2030 | definition, variable definition, or face definition only. |
| 2031 | Otherwise TYPE is assumed to be a symbol property." | ||
| 2011 | (if (and (or (null type) (eq type 'defun)) | 2032 | (if (and (or (null type) (eq type 'defun)) |
| 2012 | (symbolp symbol) | 2033 | (symbolp symbol) |
| 2013 | (autoloadp (symbol-function symbol))) | 2034 | (autoloadp (symbol-function symbol))) |
| 2014 | (nth 1 (symbol-function symbol)) | 2035 | (nth 1 (symbol-function symbol)) |
| 2015 | (let ((files load-history) | 2036 | (catch 'found |
| 2016 | file match) | 2037 | (pcase-dolist (`(,file . ,elems) load-history) |
| 2017 | (while files | 2038 | (when (if type |
| 2018 | (if (if type | 2039 | (if (eq type 'defvar) |
| 2019 | (if (eq type 'defvar) | 2040 | ;; Variables are present just as their names. |
| 2020 | ;; Variables are present just as their names. | 2041 | (member symbol elems) |
| 2021 | (member symbol (cdr (car files))) | 2042 | ;; Many other types are represented as (TYPE . NAME). |
| 2022 | ;; Other types are represented as (TYPE . NAME). | 2043 | (or (member (cons type symbol) elems) |
| 2023 | (member (cons type symbol) (cdr (car files)))) | 2044 | (memq symbol (alist-get type |
| 2024 | ;; We accept all types, so look for variable def | 2045 | (alist-get 'define-symbol-props |
| 2025 | ;; and then for any other kind. | 2046 | elems))))) |
| 2026 | (or (member symbol (cdr (car files))) | 2047 | ;; We accept all types, so look for variable def |
| 2027 | (and (setq match (rassq symbol (cdr (car files)))) | 2048 | ;; and then for any other kind. |
| 2028 | (not (eq 'require (car match)))))) | 2049 | (or (member symbol elems) |
| 2029 | (setq file (car (car files)) files nil)) | 2050 | (let ((match (rassq symbol elems))) |
| 2030 | (setq files (cdr files))) | 2051 | (and match |
| 2031 | file))) | 2052 | (not (eq 'require (car match))))))) |
| 2032 | 2053 | (throw 'found file)))))) | |
| 2033 | (defun method-files (method) | ||
| 2034 | "Return a list of files where METHOD is defined by `cl-defmethod'. | ||
| 2035 | The list will have entries of the form (FILE . (METHOD ...)) | ||
| 2036 | where (METHOD ...) contains the qualifiers and specializers of | ||
| 2037 | the method and is a suitable argument for | ||
| 2038 | `find-function-search-for-symbol'. Filenames are absolute." | ||
| 2039 | (let ((files load-history) | ||
| 2040 | result) | ||
| 2041 | (while files | ||
| 2042 | (let ((defs (cdr (car files)))) | ||
| 2043 | (while defs | ||
| 2044 | (let ((def (car defs))) | ||
| 2045 | (if (and (eq (car-safe def) 'cl-defmethod) | ||
| 2046 | (eq (cadr def) method)) | ||
| 2047 | (push (cons (car (car files)) (cdr def)) result))) | ||
| 2048 | (setq defs (cdr defs)))) | ||
| 2049 | (setq files (cdr files))) | ||
| 2050 | result)) | ||
| 2051 | 2054 | ||
| 2052 | (defun locate-library (library &optional nosuffix path interactive-call) | 2055 | (defun locate-library (library &optional nosuffix path interactive-call) |
| 2053 | "Show the precise file name of Emacs library LIBRARY. | 2056 | "Show the precise file name of Emacs library LIBRARY. |