Merge remote-tracking branch 'savannah/master' into HEAD

This commit is contained in:
Andrea Corallo 2020-12-27 17:54:57 +01:00
commit 8fb9463013
133 changed files with 4293 additions and 1544 deletions

View file

@ -1169,7 +1169,9 @@
hash-table-count
int-to-string intern-soft isnan
keymap-parent
lax-plist-get ldexp length line-beginning-position line-end-position
lax-plist-get ldexp
length length< length> length=
line-beginning-position line-end-position
local-variable-if-set-p local-variable-p locale-info
log log10 logand logb logcount logior lognot logxor lsh
make-byte-code make-list make-string make-symbol marker-buffer max

View file

@ -592,7 +592,7 @@ already is one.)"
"A list of entries associating symbols with buffer regions.
Each entry is an `edebug--form-data' struct with fields:
SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
are at the beginning and end of an entry level form and SYMBOL is
are at the beginning and end of an instrumented form and SYMBOL is
a symbol that holds all edebug related information for the form on its
property list.

View file

@ -394,7 +394,70 @@ The search is done in the source for library LIBRARY."
(progn
(beginning-of-line)
(cons (current-buffer) (point)))
(cons (current-buffer) nil)))))))))
;; If the regexp search didn't find the location of
;; the symbol (for example, because it is generated by
;; a macro), try a slightly more expensive search that
;; expands macros until it finds the symbol.
(cons (current-buffer)
(find-function--search-by-expanding-macros
(current-buffer) symbol type))))))))))
(defun find-function--try-macroexpand (form)
"Try to macroexpand FORM in full or partially.
This is a best-effort operation in which if macroexpansion fails,
this function returns FORM as is."
(ignore-errors
(or
(macroexpand-all form)
(macroexpand-1 form)
form)))
(defun find-function--any-subform-p (form pred)
"Walk FORM and apply PRED to its subexpressions.
Return t if any PRED returns t."
(cond
((not (consp form)) nil)
((funcall pred form) t)
(t
(cl-destructuring-bind (left-child . right-child) form
(or
(find-function--any-subform-p left-child pred)
(find-function--any-subform-p right-child pred))))))
(defun find-function--search-by-expanding-macros (buf symbol type)
"Expand macros in BUF to search for the definition of SYMBOL of TYPE."
(catch 'found
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
(condition-case nil
(while t
(let ((form (read (current-buffer)))
(expected-symbol-p
(lambda (form)
(cond
((null type)
;; Check if a given form is a `defalias' to
;; SYM, the function name we are searching
;; for. All functions in Emacs Lisp
;; ultimately expand to a `defalias' form
;; after several steps of macroexpansion.
(and (eq (car-safe form) 'defalias)
(equal (car-safe (cdr form))
`(quote ,symbol))))
((eq type 'defvar)
;; Variables generated by macros ultimately
;; expand to `defvar'.
(and (eq (car-safe form) 'defvar)
(eq (car-safe (cdr form)) symbol)))
(t nil)))))
(when (find-function--any-subform-p
(find-function--try-macroexpand form)
expected-symbol-p)
;; We want to return the location at the beginning
;; of the macro, so move back one sexp.
(throw 'found (progn (backward-sexp) (point))))))
(end-of-file nil))))))
(defun find-function-library (function &optional lisp-only verbose)
"Return the pair (ORIG-FUNCTION . LIBRARY) for FUNCTION.

View file

@ -208,6 +208,7 @@ a section."
(when start
(save-excursion
(goto-char start)
(looking-at outline-regexp)
(let ((level (lisp-outline-level))
(case-fold-search t)
next-section-found)
@ -218,6 +219,7 @@ a section."
nil t))
(> (save-excursion
(beginning-of-line)
(looking-at outline-regexp)
(lisp-outline-level))
level)))
(min (if next-section-found

View file

@ -204,7 +204,9 @@ by counted more than once."
(cl-incf total (memory-report--object-size counted (car value))))
(if (cdr value)
(if (consp (cdr value))
(setq value (cdr value))
(if (gethash (cdr value) counted)
(setq value nil)
(setq value (cdr value)))
(cl-incf total (memory-report--object-size counted (cdr value)))
(setq value nil))
(setq value nil)))

View file

@ -831,40 +831,45 @@ correspond to previously loaded files (those returned by
(declare-function find-library-name "find-func" (library))
(defun package--files-load-history ()
(delq nil
(mapcar (lambda (x)
(let ((f (car x)))
(and (stringp f)
(file-name-sans-extension (file-truename f)))))
load-history)))
(defun package--list-of-conflicts (dir history)
(delq
nil
(mapcar
(lambda (x) (let* ((file (file-relative-name x dir))
;; Previously loaded file, if any.
(previous
(ignore-errors
(file-name-sans-extension
(file-truename (find-library-name file)))))
(pos (when previous (member previous history))))
;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
(when pos
(cons (file-name-sans-extension file) (length pos)))))
(directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))
(defun package--list-loaded-files (dir)
"Recursively list all files in DIR which correspond to loaded features.
Returns the `file-name-sans-extension' of each file, relative to
DIR, sorted by most recently loaded last."
(let* ((history (delq nil
(mapcar (lambda (x)
(let ((f (car x)))
(and (stringp f)
(file-name-sans-extension f))))
load-history)))
(let* ((history (package--files-load-history))
(dir (file-truename dir))
;; List all files that have already been loaded.
(list-of-conflicts
(delq
nil
(mapcar
(lambda (x) (let* ((file (file-relative-name x dir))
;; Previously loaded file, if any.
(previous
(ignore-errors
(file-name-sans-extension
(file-truename (find-library-name file)))))
(pos (when previous (member previous history))))
;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
(when pos
(cons (file-name-sans-extension file) (length pos)))))
(directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
(list-of-conflicts (package--list-of-conflicts dir history)))
;; Turn the list of (FILENAME . POS) back into a list of features. Files in
;; subdirectories are returned relative to DIR (so not actually features).
(let ((default-directory (file-name-as-directory dir)))
(mapcar (lambda (x) (file-truename (car x)))
(sort list-of-conflicts
;; Sort the files by ascending HISTORY-POSITION.
(lambda (x y) (< (cdr x) (cdr y))))))))
(sort list-of-conflicts
;; Sort the files by ascending HISTORY-POSITION.
(lambda (x y) (< (cdr x) (cdr y))))))))
;;;; `package-activate'
;; This function activates a newer version of a package if an older

View file

@ -146,7 +146,8 @@ There can be any number of :example/:result elements."
(string-limit
:eval (string-limit "foobar" 3)
:eval (string-limit "foobar" 3 t)
:eval (string-limit "foobar" 10))
:eval (string-limit "foobar" 10)
:eval (string-limit "fo好" 3 nil 'utf-8))
(truncate-string-to-width
:eval (truncate-string-to-width "foobar" 3)
:eval (truncate-string-to-width "你好bar" 5))
@ -154,9 +155,6 @@ There can be any number of :example/:result elements."
:eval (split-string "foo bar")
:eval (split-string "|foo|bar|" "|")
:eval (split-string "|foo|bar|" "|" t))
(string-slice
:eval (string-slice "foo-bar" "-")
:eval (string-slice "foo-bar--zot-" "-+"))
(string-lines
:eval (string-lines "foo\n\nbar")
:eval (string-lines "foo\n\nbar" t))
@ -620,6 +618,12 @@ There can be any number of :example/:result elements."
"Data About Lists"
(length
:eval (length '(a b c)))
(length<
:eval (length< '(a b c) 1))
(length>
:eval (length> '(a b c) 1))
(length=
:eval (length> '(a b c) 3))
(safe-length
:eval (safe-length '(a b c))))

View file

@ -286,7 +286,7 @@ result will have lines that are longer than LENGTH."
(fill-region (point-min) (point-max)))
(buffer-string)))
(defun string-limit (string length &optional end)
(defun string-limit (string length &optional end coding-system)
"Return (up to) a LENGTH substring of STRING.
If STRING is shorter than or equal to LENGTH, the entire string
is returned unchanged.
@ -295,34 +295,45 @@ If STRING is longer than LENGTH, return a substring consisting of
the first LENGTH characters of STRING. If END is non-nil, return
the last LENGTH characters instead.
If CODING-SYSTEM is non-nil, STRING will be encoded before
limiting, and LENGTH is interpreted as the number of bytes to
limit the string to. The result will be a unibyte string that is
shorter than LENGTH, but will not contain \"partial\" characters,
even if CODING-SYSTEM encodes characters with several bytes per
character.
When shortening strings for display purposes,
`truncate-string-to-width' is almost always a better alternative
than this function."
(unless (natnump length)
(signal 'wrong-type-argument (list 'natnump length)))
(cond
((<= (length string) length) string)
(end (substring string (- (length string) length)))
(t (substring string 0 length))))
(if coding-system
(let ((result nil)
(result-length 0)
(index (if end (1- (length string)) 0)))
(while (let ((encoded (encode-coding-char
(aref string index) coding-system)))
(and (<= (+ (length encoded) result-length) length)
(progn
(push encoded result)
(cl-incf result-length (length encoded))
(setq index (if end (1- index)
(1+ index))))
(if end (> index -1)
(< index (length string)))))
;; No body.
)
(apply #'concat (if end result (nreverse result))))
(cond
((<= (length string) length) string)
(end (substring string (- (length string) length)))
(t (substring string 0 length)))))
(defun string-lines (string &optional omit-nulls)
"Split STRING into a list of lines.
If OMIT-NULLS, empty lines will be removed from the results."
(split-string string "\n" omit-nulls))
(defun string-slice (string regexp)
"Split STRING at REGEXP boundaries and return a list of slices.
The boundaries that match REGEXP are included in the result.
Also see `split-string'."
(if (zerop (length string))
(list "")
(let ((i (string-match-p regexp string 1)))
(if i
(cons (substring string 0 i)
(string-slice (substring string i) regexp))
(list string)))))
(defun string-pad (string length &optional padding start)
"Pad STRING to LENGTH using PADDING.
If PADDING is nil, the space character is used. If not nil, it