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. If MAXELT is non-nil, it specifies the maximum length of the history. Otherwise, the maximum history length is the value of the `history-length' property on symbol HISTORY-VAR, if set, or the value of the `history-length' -variable. +variable. The possible values of maximum length have the same meaning as +the values of `history-length'. Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even 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." ;; "Return the name of the file from which AUTOLOAD will be loaded. ;; \n\(fn AUTOLOAD)") +(defun define-symbol-prop (symbol prop val) + "Define the property PROP of SYMBOL to be VAL. +This is to `put' what `defalias' is to `fset'." + ;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)). + ;; (cl-pushnew symbol (alist-get prop + ;; (alist-get 'define-symbol-props + ;; current-load-list))) + (let ((sps (assq 'define-symbol-props current-load-list))) + (unless sps + (setq sps (list 'define-symbol-props)) + (push sps current-load-list)) + (let ((ps (assq prop sps))) + (unless ps + (setq ps (list prop)) + (setcdr sps (cons ps (cdr sps)))) + (unless (member symbol (cdr ps)) + (setcdr ps (cons symbol (cdr ps)))))) + (put symbol prop val)) + (defun symbol-file (symbol &optional type) "Return the name of the file that defined SYMBOL. The value is normally an absolute file name. It can also be nil, @@ -2007,47 +2027,30 @@ file name without extension. If TYPE is nil, then any kind of definition is acceptable. If TYPE is `defun', `defvar', or `defface', that specifies function -definition, variable definition, or face definition only." +definition, variable definition, or face definition only. +Otherwise TYPE is assumed to be a symbol property." (if (and (or (null type) (eq type 'defun)) (symbolp symbol) (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) - (let ((files load-history) - file match) - (while files - (if (if type - (if (eq type 'defvar) - ;; Variables are present just as their names. - (member symbol (cdr (car files))) - ;; Other types are represented as (TYPE . NAME). - (member (cons type symbol) (cdr (car files)))) - ;; We accept all types, so look for variable def - ;; and then for any other kind. - (or (member symbol (cdr (car files))) - (and (setq match (rassq symbol (cdr (car files)))) - (not (eq 'require (car match)))))) - (setq file (car (car files)) files nil)) - (setq files (cdr files))) - file))) - -(defun method-files (method) - "Return a list of files where METHOD is defined by `cl-defmethod'. -The list will have entries of the form (FILE . (METHOD ...)) -where (METHOD ...) contains the qualifiers and specializers of -the method and is a suitable argument for -`find-function-search-for-symbol'. Filenames are absolute." - (let ((files load-history) - result) - (while files - (let ((defs (cdr (car files)))) - (while defs - (let ((def (car defs))) - (if (and (eq (car-safe def) 'cl-defmethod) - (eq (cadr def) method)) - (push (cons (car (car files)) (cdr def)) result))) - (setq defs (cdr defs)))) - (setq files (cdr files))) - result)) + (catch 'found + (pcase-dolist (`(,file . ,elems) load-history) + (when (if type + (if (eq type 'defvar) + ;; Variables are present just as their names. + (member symbol elems) + ;; Many other types are represented as (TYPE . NAME). + (or (member (cons type symbol) elems) + (memq symbol (alist-get type + (alist-get 'define-symbol-props + elems))))) + ;; We accept all types, so look for variable def + ;; and then for any other kind. + (or (member symbol elems) + (let ((match (rassq symbol elems))) + (and match + (not (eq 'require (car match))))))) + (throw 'found file)))))) (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. |