summaryrefslogtreecommitdiff
path: root/lisp/subr.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/subr.el')
-rw-r--r--lisp/subr.el79
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.