procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source
This commit is contained in:
Andrea Corallo 2020-10-23 20:08:58 +01:00
commit 99e7cc0da6
319 changed files with 5156 additions and 3702 deletions
Download patch file Download diff file Expand all files Collapse all files

180
lisp/emacs-lisp/bindat.el
View file

@ -1,4 +1,4 @@
;;; bindat.el --- binary data structure packing and unpacking.
;;; bindat.el --- binary data structure packing and unpacking. -*- lexical-binding: t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@ -193,8 +193,8 @@
;; Helper functions for structure unpacking.
;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
(defvar bindat-raw)
(defvar bindat-idx)
(defvar bindat-raw nil)
(defvar bindat-idx nil)
(defun bindat--unpack-u8 ()
(prog1
@ -276,7 +276,7 @@
(t nil)))
(defun bindat--unpack-group (spec)
(let (struct last)
(let (struct)
(while spec
(let* ((item (car spec))
(field (car item))
@ -298,7 +298,7 @@
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply 'bindat-get-field struct len)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
@ -330,21 +330,21 @@
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
(t
(setq data (bindat--unpack-item type len vectype)
last data)))
(setq data (bindat--unpack-item type len vectype))))
(if data
(if field
(setq struct (cons (cons field data) struct))
(setq struct (append data struct))))))
struct))
(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
"Return structured data according to SPEC for binary data in BINDAT-RAW.
BINDAT-RAW is a unibyte string or vector.
Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW."
(when (multibyte-string-p bindat-raw)
(defun bindat-unpack (spec raw &optional idx)
"Return structured data according to SPEC for binary data in RAW.
RAW is a unibyte string or vector.
Optional third arg IDX specifies the starting offset in RAW."
(when (multibyte-string-p raw)
(error "String is multibyte"))
(unless bindat-idx (setq bindat-idx 0))
(setq bindat-raw raw)
(setq bindat-idx (or idx 0))
(bindat--unpack-group spec))
(defun bindat-get-field (struct &rest field)
@ -373,74 +373,70 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(ip . 4)))
(defun bindat--length-group (struct spec)
(let (last)
(while spec
(let* ((item (car spec))
(field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)))))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)))))
(if (and len (consp len) (eq (car len) 'eval))
(setq len (eval (car (cdr len)))))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply 'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(while (eq type 'vec)
(let ((vlen 1))
(if (consp vectype)
(setq len (* len (nth 1 vectype))
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil))))
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
(eval len)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
(bindat--length-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
(and (consp cc) (eval cc)))
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
(t
(if (setq type (assq type bindat--fixed-length-alist))
(setq len (* len (cdr type))))
(if field
(setq last (bindat-get-field struct field)))
(setq bindat-idx (+ bindat-idx len))))))))
(while spec
(let* ((item (car spec))
(field (car item))
(type (nth 1 item))
(len (nth 2 item))
(vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq field (eval (car (cdr field)))))
(if (and type (consp type) (eq (car type) 'eval))
(setq type (eval (car (cdr type)))))
(if (and len (consp len) (eq (car len) 'eval))
(setq len (eval (car (cdr len)))))
(if (memq field '(eval fill align struct union))
(setq tail 2
len type
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(while (eq type 'vec)
(if (consp vectype)
(setq len (* len (nth 1 vectype))
type (nth 2 vectype))
(setq type (or vectype 'u8)
vectype nil)))
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
(eval len)))
((eq type 'fill)
(setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
(while (/= (% bindat-idx len) 0)
(setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len)))
((eq type 'repeat)
(let ((index 0) (count len))
(while (< index count)
(bindat--length-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
(let ((tag len) (cases (nthcdr tail item)) case cc)
(while cases
(setq case (car cases)
cases (cdr cases)
cc (car case))
(if (or (equal cc tag) (equal cc t)
(and (consp cc) (eval cc)))
(progn
(bindat--length-group struct (cdr case))
(setq cases nil))))))
(t
(if (setq type (assq type bindat--fixed-length-alist))
(setq len (* len (cdr type))))
(setq bindat-idx (+ bindat-idx len)))))))
(defun bindat-length (spec struct)
"Calculate bindat-raw length for STRUCT according to bindat SPEC."
@ -557,7 +553,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
type field
field nil))
(if (and (consp len) (not (eq type 'eval)))
(setq len (apply 'bindat-get-field struct len)))
(setq len (apply #'bindat-get-field struct len)))
(if (not len)
(setq len 1))
(cond
@ -596,17 +592,17 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
(bindat--pack-item last type len vectype)
))))))
(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
(defun bindat-pack (spec struct &optional raw idx)
"Return binary data packed according to SPEC for structured data STRUCT.
Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
pack into.
Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
(when (multibyte-string-p bindat-raw)
Optional third arg RAW is a pre-allocated unibyte string or
vector to pack into.
Optional fourth arg IDX is the starting offset into BINDAT-RAW."
(when (multibyte-string-p raw)
(error "Pre-allocated string is multibyte"))
(let ((no-return bindat-raw))
(unless bindat-idx (setq bindat-idx 0))
(unless bindat-raw
(setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0)))
(let ((no-return raw))
(setq bindat-idx (or idx 0))
(setq bindat-raw (or raw
(make-string (+ bindat-idx (bindat-length spec struct)) 0)))
(bindat--pack-group struct spec)
(if no-return nil bindat-raw)))
@ -624,7 +620,7 @@ only that many elements from VECT."
(while (> i 0)
(setq i (1- i)
s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
(apply 'concat s)))
(apply #'concat s)))
(defun bindat-vector-to-dec (vect &optional sep)
"Format vector VECT in decimal format separated by dots.

14
lisp/emacs-lisp/byte-run.el
View file

@ -442,7 +442,16 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger
(defmacro define-obsolete-variable-alias (obsolete-name current-name
&optional when docstring)
"Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
This uses `defvaralias' and `make-obsolete-variable' (which see).
WHEN should be a string indicating when the variable was first
made obsolete, for example a date or a release number.
This macro evaluates all its parameters, and both OBSOLETE-NAME
and CURRENT-NAME should be symbols, so a typical usage would look like:
(define-obsolete-variable-alias 'foo-thing 'bar-thing \"27.1\")
This macro uses `defvaralias' and `make-obsolete-variable' (which see).
See the Info node `(elisp)Variable Aliases' for more details.
If CURRENT-NAME is a defcustom or a defvar (more generally, any variable
@ -456,9 +465,6 @@ dumped with Emacs). This is so that any user customizations are
applied before the defcustom tries to initialize the
variable (this is due to the way `defvaralias' works).
WHEN should be a string indicating when the variable was first
made obsolete, for example a date or a release number.
For the benefit of Customize, if OBSOLETE-NAME has
any of the following properties, they are copied to
CURRENT-NAME, if it does not already have them:

70
lisp/emacs-lisp/bytecomp.el
View file

@ -268,6 +268,13 @@ This option is enabled by default because it reduces Emacs memory usage."
(defconst byte-compile-log-buffer "*Compile-Log*"
"Name of the byte-compiler's log buffer.")
(defvar byte-compile--known-dynamic-vars nil
"Variables known to be declared as dynamic, for warning purposes.
Each element is (VAR . FILE), indicating that VAR is declared in FILE.")
(defvar byte-compile--seen-defvars nil
"All dynamic variable declarations seen so far.")
(defcustom byte-optimize-log nil
"If non-nil, the byte-compiler will log its optimizations.
If this is `source', then only source-level optimizations will be logged.
@ -290,7 +297,7 @@ The information is logged to `byte-compile-log-buffer'."
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
obsolete noruntime cl-functions interactive-only
make-local mapcar constants suspicious lexical)
make-local mapcar constants suspicious lexical lexical-dynamic)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"List of warnings that the byte-compiler should issue (t for all).
@ -310,6 +317,8 @@ Elements of the list may be:
interactive-only
commands that normally shouldn't be called from Lisp code.
lexical global/dynamic variables lacking a prefix.
lexical-dynamic
lexically bound variable declared dynamic elsewhere
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect.
constants let-binding of, or assignment to, constants/nonvariables.
@ -1887,10 +1896,9 @@ compile FILENAME. If optional argument ARG is 0, it compiles
the input file even if the `.elc' file does not exist.
Any other non-nil value of ARG means to ask the user.
If optional argument LOAD is non-nil, loads the file after compiling.
If compilation is needed, this functions returns the result of
`byte-compile-file'; otherwise it returns `no-byte-compile'."
(declare (advertised-calling-convention (filename &optional force arg) "28.1"))
(interactive
(let ((file buffer-file-name)
(file-name nil)
@ -1919,11 +1927,24 @@ If compilation is needed, this functions returns the result of
(progn
(if (and noninteractive (not byte-compile-verbose))
(message "Compiling %s..." filename))
(byte-compile-file filename load))
(byte-compile-file filename)
(when load
(load (if (file-exists-p dest) dest filename))))
(when load
(load (if (file-exists-p dest) dest filename)))
'no-byte-compile)))
(defun byte-compile--load-dynvars (file)
(and file (not (equal file ""))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(let ((vars nil)
var)
(while (ignore-errors (setq var (read (current-buffer))))
(push var vars))
vars))))
(defvar byte-compile-level 0 ; bug#13787
"Depth of a recursive byte compilation.")
@ -1932,8 +1953,10 @@ If compilation is needed, this functions returns the result of
"Compile a file of Lisp code named FILENAME into a file of byte code.
The output file's name is generated by passing FILENAME to the
function `byte-compile-dest-file' (which see).
With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
The value is non-nil if there were no errors, nil if errors."
The value is non-nil if there were no errors, nil if errors.
See also `emacs-lisp-byte-compile-and-load'."
(declare (advertised-calling-convention (filename) "28.1"))
;; (interactive "fByte compile file: \nP")
(interactive
(let ((file buffer-file-name)
@ -1962,6 +1985,9 @@ The value is non-nil if there were no errors, nil if errors."
(let ((byte-compile-current-file filename)
(byte-compile-current-group nil)
(set-auto-coding-for-load t)
(byte-compile--seen-defvars nil)
(byte-compile--known-dynamic-vars
(byte-compile--load-dynvars (getenv "EMACS_DYNVARS_FILE")))
target-file input-buffer output-buffer
byte-compile-dest-file)
(setq target-file (byte-compile-dest-file filename))
@ -2096,8 +2122,17 @@ The value is non-nil if there were no errors, nil if errors."
filename))))
(save-excursion
(display-call-tree filename)))
(let ((gen-dynvars (getenv "EMACS_GENERATE_DYNVARS")))
(when (and gen-dynvars (not (equal gen-dynvars ""))
byte-compile--seen-defvars)
(let ((dynvar-file (concat target-file ".dynvars")))
(message "Generating %s" dynvar-file)
(with-temp-buffer
(dolist (var (delete-dups byte-compile--seen-defvars))
(insert (format "%S\n" (cons var filename))))
(write-region (point-min) (point-max) dynvar-file)))))
(if load
(load target-file))
(load target-file))
t))))
;;; compiling a single function
@ -2490,7 +2525,8 @@ list that represents a doc string reference.
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
(byte-compile-warn "Variable `%S' declared after its first use" sym))
(push sym byte-compile-bound-variables))
(push sym byte-compile-bound-variables)
(push sym byte-compile--seen-defvars))
(defun byte-compile-file-form-defvar (form)
(let ((sym (nth 1 form)))
@ -2905,6 +2941,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
(ash nonrest 8)
(ash rest 7)))))
(defun byte-compile--warn-lexical-dynamic (var context)
(when (byte-compile-warning-enabled-p 'lexical-dynamic var)
(byte-compile-warn
"`%s' lexically bound in %s here but declared dynamic in: %s"
var context
(mapconcat #'identity
(mapcan (lambda (v) (and (eq var (car v))
(list (cdr v))))
byte-compile--known-dynamic-vars)
", "))))
(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
"Byte-compile a lambda-expression and return a valid function.
@ -2933,6 +2979,10 @@ for symbols generated by the byte compiler itself."
(if (cdr body)
(setq body (cdr body))))))
(int (assq 'interactive body)))
(when lexical-binding
(dolist (var arglistvars)
(when (assq var byte-compile--known-dynamic-vars)
(byte-compile--warn-lexical-dynamic var 'lambda))))
;; Process the interactive spec.
(when int
(byte-compile-set-symbol-position 'interactive)
@ -4460,6 +4510,8 @@ Return non-nil if the TOS value was popped."
;; VAR is a simple stack-allocated lexical variable.
(progn (push (assq var init-lexenv)
byte-compile--lexical-environment)
(when (assq var byte-compile--known-dynamic-vars)
(byte-compile--warn-lexical-dynamic var 'let))
nil)
;; VAR should be dynamically bound.
(while (assq var byte-compile--lexical-environment)
@ -5289,6 +5341,8 @@ and corresponding effects."
byte-compile-variable-ref))))
nil)
(make-obsolete-variable 'bytecomp-load-hook
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'bytecomp-load-hook)
;;; bytecomp.el ends here

2
lisp/emacs-lisp/chart.el
View file

@ -4,7 +4,7 @@
;; Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; Version: 0.2
;; Old-Version: 0.2
;; Keywords: OO, chart, graph
;; This file is part of GNU Emacs.

2
lisp/emacs-lisp/cl-extra.el
View file

@ -910,6 +910,8 @@ Outputs to the current buffer."
(mapc #'cl--describe-class-slot cslots))))
(make-obsolete-variable 'cl-extra-load-hook
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-extra-load-hook)
;; Local variables:

2
lisp/emacs-lisp/cl-macs.el
View file

@ -3464,6 +3464,8 @@ STRUCT and SLOT-NAME are symbols. INST is a structure instance."
(nth (cl-struct-slot-offset ,struct-type ,slot-name) ,inst)
(aref ,inst (cl-struct-slot-offset ,struct-type ,slot-name)))))))
(make-obsolete-variable 'cl-macs-load-hook
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-macs-load-hook)
;; Local variables:

2
lisp/emacs-lisp/cl-seq.el
View file

@ -1042,6 +1042,8 @@ Atoms are compared by `eql'; cons cells are compared recursively.
(and (not (consp cl-x)) (not (consp cl-y)) (cl--check-match cl-x cl-y)))
(make-obsolete-variable 'cl-seq-load-hook
"use `with-eval-after-load' instead." "28.1")
(run-hooks 'cl-seq-load-hook)
;; Local variables:

10
lisp/emacs-lisp/package.el
View file

@ -2718,6 +2718,7 @@ either a full name or nil, and EMAIL is a valid email address."
(define-key map (kbd "/ s") 'package-menu-filter-by-status)
(define-key map (kbd "/ v") 'package-menu-filter-by-version)
(define-key map (kbd "/ m") 'package-menu-filter-marked)
(define-key map (kbd "/ u") 'package-menu-filter-upgradable)
map)
"Local keymap for `package-menu-mode' buffers.")
@ -3914,6 +3915,15 @@ Unlike other filters, this leaves the marks intact."
(tabulated-list-put-tag (char-to-string mark) t)))
(user-error "No packages found")))))
(defun package-menu-filter-upgradable ()
"Filter \"*Packages*\" buffer to show only upgradable packages."
(interactive)
(let ((pkgs (mapcar #'car (package-menu--find-upgrades))))
(package-menu--filter-by
(lambda (pkg)
(memql (package-desc-name pkg) pkgs))
"upgradable")))
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
(interactive)

2
lisp/emacs-lisp/pcase.el
View file

@ -3,7 +3,7 @@
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
;; Keywords: extensions
;; This file is part of GNU Emacs.

2
lisp/emacs-lisp/regi.el
View file

@ -4,7 +4,7 @@
;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
;; Created: 24-Feb-1993
;; Version: 1.8
;; Old-Version: 1.8
;; Last Modified: 1993/06/01 21:33:00
;; Keywords: extensions, matching

9
lisp/emacs-lisp/seq.el
View file

@ -336,9 +336,11 @@ list."
"Reduce the function FUNCTION across SEQUENCE, starting with INITIAL-VALUE.
Return the result of calling FUNCTION with INITIAL-VALUE and the
first element of SEQUENCE, then calling FUNCTION with that result and
the second element of SEQUENCE, then with that result and the third
element of SEQUENCE, etc.
first element of SEQUENCE, then calling FUNCTION with that result
and the second element of SEQUENCE, then with that result and the
third element of SEQUENCE, etc. FUNCTION will be called with
INITIAL-VALUE (and then the accumulated value) as the first
argument, and the elements from SEQUENCE as the second argument.
If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called."
(if (seq-empty-p sequence)
@ -472,6 +474,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil."
(seq-reverse sequence1)
'()))
;;;###autoload
(cl-defgeneric seq-group-by (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Separate the elements of SEQUENCE into an alist using the results as

11
lisp/emacs-lisp/shortdoc.el
View file

@ -24,7 +24,6 @@
;;; Code:
(require 'macroexp)
(require 'seq)
(eval-when-compile (require 'cl-lib))
@ -34,18 +33,16 @@
(defface shortdoc-section
'((((class color) (background dark))
(:inherit variable-pitch
:background "#303030" :extend t))
:inherit variable-pitch :background "#303030" :extend t)
(((class color) (background light))
(:inherit variable-pitch
:background "#f0f0f0" :extend t)))
:inherit variable-pitch :background "#f0f0f0" :extend t))
"Face used for a section.")
(defface shortdoc-example
'((((class color) (background dark))
(:background "#202020" :extend t))
:background "#202020" :extend t)
(((class color) (background light))
(:background "#e8e8e8" :extend t)))
:background "#e8e8e8" :extend t))
"Face used for examples.")
(defvar shortdoc--groups nil)