summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bindat.el180
-rw-r--r--lisp/emacs-lisp/byte-run.el14
-rw-r--r--lisp/emacs-lisp/bytecomp.el17
-rw-r--r--lisp/emacs-lisp/chart.el2
-rw-r--r--lisp/emacs-lisp/cl-extra.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el2
-rw-r--r--lisp/emacs-lisp/cl-seq.el2
-rw-r--r--lisp/emacs-lisp/package.el10
-rw-r--r--lisp/emacs-lisp/regi.el2
-rw-r--r--lisp/emacs-lisp/seq.el1
-rw-r--r--lisp/emacs-lisp/shortdoc.el11
11 files changed, 132 insertions, 111 deletions
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index d168c255121..95581c40a46 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -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.
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 5279a57cd0c..27f54d0ca2a 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -432,7 +432,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
@@ -446,9 +455,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:
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 90809a929b9..a547b672b1a 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1845,10 +1845,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)
@@ -1877,7 +1876,9 @@ 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)))
@@ -1901,8 +1902,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)
@@ -2068,7 +2071,7 @@ The value is non-nil if there were no errors, nil if errors."
(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
@@ -5256,6 +5259,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
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index 964836a32ac..177710038a0 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -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.
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 5bf74792c08..23c784f9f8e 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -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:
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 147a0a8f5a4..1501ed43082 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3430,6 +3430,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:
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index f90cce9b471..d34d50172df 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -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:
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 7b192d640b2..23692aab32a 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2708,6 +2708,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.")
@@ -3904,6 +3905,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)
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 61af5e51bda..11b28b72cf3 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -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
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 9073f9c7a51..4656277ea16 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -474,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
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index f6309c7652e..7ae6d53a21b 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -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)
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-07 21:34:59 +0000