mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-30 19:53:09 +00:00
Use lexical-binding in all of lisp/emacs-lisp
* lisp/emacs-lisp/bindat.el: Use lexical-binding. (bindat--unpack-group, bindat--length-group, bindat--pack-group): Declare `last` and `tag` as dyn-scoped. (bindat-unpack, bindat-pack): Bind `bindat-raw` and `bindat-idx` via `let` rather than via the formal arglist. * lisp/emacs-lisp/package-x.el: * lisp/emacs-lisp/generic.el: * lisp/emacs-lisp/eieio-opt.el: * lisp/emacs-lisp/derived.el: * lisp/emacs-lisp/crm.el: Use lexical-binding. * lisp/emacs-lisp/helper.el: Use lexical-binding. (Helper-help-map): Move initialization into declaration. * lisp/emacs-lisp/regi.el: Use lexical-binding. (regi-interpret): Remove unused var `tstart`. Declare `curframe`, `curentry` and `curline` as dyn-scoped. * lisp/emacs-lisp/shadow.el: Use lexical-binding. (load-path-shadows-find): Remove unused var `file`. Tighten a regexp, use `push`. * lisp/emacs-lisp/tcover-ses.el: Use lexical-binding. Require `ses`. Remove correspondingly redundant declarations. (ses--curcell-overlay): Declare. (ses-exercise): Use `dlet` and use a properly-prefixed var name. Fix name of `curcell-overlay` variable. * lisp/emacs-lisp/unsafep.el: Use lexical-binding. (unsafep): Bind `unsafep-vars` via `let` rather than via the formal arglist.
This commit is contained in:
Stefan Monnier
parent
c8c4d65d65
commit
991c8946b6
@ -267,6 +267,7 @@ nontrivial changes to the build process.
|
||||
lisp/language/tibetan.el
|
||||
lisp/leim/quail/ethiopic.el
|
||||
lisp/leim/quail/tibetan.el
|
||||
lisp/international/titdic-cnv.el
|
||||
|
||||
* binary files
|
||||
|
||||
|
||||
@ -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-2021 Free Software Foundation, Inc.
|
||||
|
||||
@ -198,7 +198,7 @@
|
||||
|
||||
(defun bindat--unpack-u8 ()
|
||||
(prog1
|
||||
(aref bindat-raw bindat-idx)
|
||||
(aref bindat-raw bindat-idx)
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
|
||||
(defun bindat--unpack-u16 ()
|
||||
@ -276,6 +276,8 @@
|
||||
(t nil)))
|
||||
|
||||
(defun bindat--unpack-group (spec)
|
||||
(with-suppressed-warnings ((lexical last))
|
||||
(defvar last))
|
||||
(let (struct last)
|
||||
(while spec
|
||||
(let* ((item (car spec))
|
||||
@ -287,11 +289,11 @@
|
||||
data)
|
||||
(setq spec (cdr spec))
|
||||
(if (and (consp field) (eq (car field) 'eval))
|
||||
(setq field (eval (car (cdr field)))))
|
||||
(setq field (eval (car (cdr field)) t)))
|
||||
(if (and type (consp type) (eq (car type) 'eval))
|
||||
(setq type (eval (car (cdr type)))))
|
||||
(setq type (eval (car (cdr type)) t)))
|
||||
(if (and len (consp len) (eq (car len) 'eval))
|
||||
(setq len (eval (car (cdr len)))))
|
||||
(setq len (eval (car (cdr len)) t)))
|
||||
(if (memq field '(eval fill align struct union))
|
||||
(setq tail 2
|
||||
len type
|
||||
@ -304,48 +306,51 @@
|
||||
(cond
|
||||
((eq type 'eval)
|
||||
(if field
|
||||
(setq data (eval len))
|
||||
(eval len)))
|
||||
(setq data (eval len t))
|
||||
(eval len t)))
|
||||
((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)
|
||||
(setq data (bindat--unpack-group (eval len))))
|
||||
(setq data (bindat--unpack-group (eval len t))))
|
||||
((eq type 'repeat)
|
||||
(let ((index 0) (count len))
|
||||
(while (< index count)
|
||||
(setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
|
||||
(push (bindat--unpack-group (nthcdr tail item)) data)
|
||||
(setq index (1+ index)))
|
||||
(setq data (nreverse data))))
|
||||
((eq type 'union)
|
||||
(with-suppressed-warnings ((lexical tag))
|
||||
(defvar tag))
|
||||
(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)))
|
||||
(and (consp cc) (eval cc t)))
|
||||
(setq data (bindat--unpack-group (cdr case))
|
||||
cases nil)))))
|
||||
(t
|
||||
(setq data (bindat--unpack-item type len vectype)
|
||||
last data)))
|
||||
(if data
|
||||
(if field
|
||||
(setq struct (cons (cons field data) struct))
|
||||
(setq struct (append data struct))))))
|
||||
(setq struct (if field
|
||||
(cons (cons field data) 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))
|
||||
(bindat--unpack-group spec))
|
||||
(let ((bindat-idx (or idx 0))
|
||||
(bindat-raw raw))
|
||||
(bindat--unpack-group spec)))
|
||||
|
||||
(defun bindat-get-field (struct &rest field)
|
||||
"In structured data STRUCT, return value of field named FIELD.
|
||||
@ -373,6 +378,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(ip . 4)))
|
||||
|
||||
(defun bindat--length-group (struct spec)
|
||||
(with-suppressed-warnings ((lexical last))
|
||||
(defvar last))
|
||||
(let (last)
|
||||
(while spec
|
||||
(let* ((item (car spec))
|
||||
@ -383,32 +390,31 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(tail 3))
|
||||
(setq spec (cdr spec))
|
||||
(if (and (consp field) (eq (car field) 'eval))
|
||||
(setq field (eval (car (cdr field)))))
|
||||
(setq field (eval (car (cdr field)) t)))
|
||||
(if (and type (consp type) (eq (car type) 'eval))
|
||||
(setq type (eval (car (cdr type)))))
|
||||
(setq type (eval (car (cdr type)) t)))
|
||||
(if (and len (consp len) (eq (car len) 'eval))
|
||||
(setq len (eval (car (cdr len)))))
|
||||
(setq len (eval (car (cdr len)) t)))
|
||||
(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)))
|
||||
(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))))
|
||||
(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)))
|
||||
(setq struct (cons (cons field (eval len t)) struct))
|
||||
(eval len t)))
|
||||
((eq type 'fill)
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
((eq type 'align)
|
||||
@ -416,7 +422,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
((eq type 'struct)
|
||||
(bindat--length-group
|
||||
(if field (bindat-get-field struct field) struct) (eval len)))
|
||||
(if field (bindat-get-field struct field) struct) (eval len t)))
|
||||
((eq type 'repeat)
|
||||
(let ((index 0) (count len))
|
||||
(while (< index count)
|
||||
@ -425,13 +431,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(nthcdr tail item))
|
||||
(setq index (1+ index)))))
|
||||
((eq type 'union)
|
||||
(with-suppressed-warnings ((lexical tag))
|
||||
(defvar tag))
|
||||
(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)))
|
||||
(and (consp cc) (eval cc t)))
|
||||
(progn
|
||||
(bindat--length-group struct (cdr case))
|
||||
(setq cases nil))))))
|
||||
@ -536,6 +544,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(setq bindat-idx (+ bindat-idx len)))))
|
||||
|
||||
(defun bindat--pack-group (struct spec)
|
||||
(with-suppressed-warnings ((lexical last))
|
||||
(defvar last))
|
||||
(let (last)
|
||||
(while spec
|
||||
(let* ((item (car spec))
|
||||
@ -546,11 +556,11 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(tail 3))
|
||||
(setq spec (cdr spec))
|
||||
(if (and (consp field) (eq (car field) 'eval))
|
||||
(setq field (eval (car (cdr field)))))
|
||||
(setq field (eval (car (cdr field)) t)))
|
||||
(if (and type (consp type) (eq (car type) 'eval))
|
||||
(setq type (eval (car (cdr type)))))
|
||||
(setq type (eval (car (cdr type)) t)))
|
||||
(if (and len (consp len) (eq (car len) 'eval))
|
||||
(setq len (eval (car (cdr len)))))
|
||||
(setq len (eval (car (cdr len)) t)))
|
||||
(if (memq field '(eval fill align struct union))
|
||||
(setq tail 2
|
||||
len type
|
||||
@ -563,8 +573,8 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(cond
|
||||
((eq type 'eval)
|
||||
(if field
|
||||
(setq struct (cons (cons field (eval len)) struct))
|
||||
(eval len)))
|
||||
(setq struct (cons (cons field (eval len t)) struct))
|
||||
(eval len t)))
|
||||
((eq type 'fill)
|
||||
(setq bindat-idx (+ bindat-idx len)))
|
||||
((eq type 'align)
|
||||
@ -572,7 +582,7 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(setq bindat-idx (1+ bindat-idx))))
|
||||
((eq type 'struct)
|
||||
(bindat--pack-group
|
||||
(if field (bindat-get-field struct field) struct) (eval len)))
|
||||
(if field (bindat-get-field struct field) struct) (eval len t)))
|
||||
((eq type 'repeat)
|
||||
(let ((index 0) (count len))
|
||||
(while (< index count)
|
||||
@ -581,13 +591,15 @@ e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
|
||||
(nthcdr tail item))
|
||||
(setq index (1+ index)))))
|
||||
((eq type 'union)
|
||||
(with-suppressed-warnings ((lexical tag))
|
||||
(defvar tag))
|
||||
(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)))
|
||||
(and (consp cc) (eval cc t)))
|
||||
(progn
|
||||
(bindat--pack-group struct (cdr case))
|
||||
(setq cases nil))))))
|
||||
@ -596,19 +608,19 @@ 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
|
||||
Optional third arg 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 fourth arg IDX is the starting offset into 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* ((bindat-idx (or idx 0))
|
||||
(bindat-raw
|
||||
(or raw
|
||||
(make-string (+ bindat-idx (bindat-length spec struct)) 0))))
|
||||
(bindat--pack-group struct spec)
|
||||
(if no-return nil bindat-raw)))
|
||||
(if raw nil bindat-raw)))
|
||||
|
||||
|
||||
;; Misc. format conversions
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; crm.el --- read multiple strings with completion
|
||||
;;; crm.el --- read multiple strings with completion -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1985-1986, 1993-2021 Free Software Foundation, Inc.
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; derived.el --- allow inheritance of major modes
|
||||
;;; derived.el --- allow inheritance of major modes -*- lexical-binding: t; -*-
|
||||
;; (formerly mode-clone.el)
|
||||
|
||||
;; Copyright (C) 1993-1994, 1999, 2001-2021 Free Software Foundation,
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar)
|
||||
;;; eieio-opt.el -- eieio optional functions (debug, printing, speedbar) -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1996, 1998-2003, 2005, 2008-2021 Free Software
|
||||
;; Foundation, Inc.
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; generic.el --- defining simple major modes with comment and font-lock
|
||||
;;; generic.el --- defining simple major modes with comment and font-lock -*- lexical-binding: t; -*-
|
||||
;;
|
||||
;; Copyright (C) 1997, 1999, 2001-2021 Free Software Foundation, Inc.
|
||||
;;
|
||||
@ -245,7 +245,6 @@ Some generic modes are defined in `generic-x.el'."
|
||||
"Set up comment functionality for generic mode."
|
||||
(let ((chars nil)
|
||||
(comstyles)
|
||||
(comstyle "")
|
||||
(comment-start nil))
|
||||
|
||||
;; Go through all the comments.
|
||||
@ -269,14 +268,16 @@ Some generic modes are defined in `generic-x.el'."
|
||||
;; Store the relevant info but don't update yet.
|
||||
(push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars)
|
||||
(push (cons c1 (concat (cdr (assoc c1 chars))
|
||||
(concat "2" comstyle))) chars)))
|
||||
(concat "2" comstyle)))
|
||||
chars)))
|
||||
(if (= (length end) 1)
|
||||
(modify-syntax-entry (aref end 0)
|
||||
(concat ">" comstyle) st)
|
||||
(let ((c0 (aref end 0)) (c1 (aref end 1)))
|
||||
;; Store the relevant info but don't update yet.
|
||||
(push (cons c0 (concat (cdr (assoc c0 chars))
|
||||
(concat "3" comstyle))) chars)
|
||||
(concat "3" comstyle)))
|
||||
chars)
|
||||
(push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars)))))
|
||||
|
||||
;; Process the chars that were part of a 2-char comment marker
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; helper.el --- utility help package supporting help in electric modes
|
||||
;;; helper.el --- utility help package supporting help in electric modes -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc.
|
||||
|
||||
@ -39,20 +39,19 @@
|
||||
;; keymap either.
|
||||
|
||||
|
||||
(defvar Helper-help-map nil)
|
||||
(if Helper-help-map
|
||||
nil
|
||||
(setq Helper-help-map (make-keymap))
|
||||
;(fillarray Helper-help-map 'undefined)
|
||||
(define-key Helper-help-map "m" 'Helper-describe-mode)
|
||||
(define-key Helper-help-map "b" 'Helper-describe-bindings)
|
||||
(define-key Helper-help-map "c" 'Helper-describe-key-briefly)
|
||||
(define-key Helper-help-map "k" 'Helper-describe-key)
|
||||
;(define-key Helper-help-map "f" 'Helper-describe-function)
|
||||
;(define-key Helper-help-map "v" 'Helper-describe-variable)
|
||||
(define-key Helper-help-map "?" 'Helper-help-options)
|
||||
(define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
|
||||
(fset 'Helper-help-map Helper-help-map))
|
||||
(defvar Helper-help-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
;(fillarray map 'undefined)
|
||||
(define-key map "m" 'Helper-describe-mode)
|
||||
(define-key map "b" 'Helper-describe-bindings)
|
||||
(define-key map "c" 'Helper-describe-key-briefly)
|
||||
(define-key map "k" 'Helper-describe-key)
|
||||
;(define-key map "f" 'Helper-describe-function)
|
||||
;(define-key map "v" 'Helper-describe-variable)
|
||||
(define-key map "?" 'Helper-help-options)
|
||||
(define-key map (char-to-string help-char) 'Helper-help-options)
|
||||
(fset 'Helper-help-map map)
|
||||
map))
|
||||
|
||||
(defun Helper-help-scroller ()
|
||||
(let ((blurb (or (and (boundp 'Helper-return-blurb)
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; package-x.el --- Package extras
|
||||
;;; package-x.el --- Package extras -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; regi.el --- REGular expression Interpreting engine
|
||||
;;; regi.el --- REGular expression Interpreting engine -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
|
||||
|
||||
@ -153,7 +153,7 @@ useful information:
|
||||
;; set up the narrowed region
|
||||
(and start
|
||||
end
|
||||
(let* ((tstart start)
|
||||
(let* (;; (tstart start)
|
||||
(start (min start end))
|
||||
(end (max start end)))
|
||||
(narrow-to-region
|
||||
@ -206,30 +206,33 @@ useful information:
|
||||
;; if the line matched, package up the argument list and
|
||||
;; funcall the FUNC
|
||||
(if match-p
|
||||
(let* ((curline (buffer-substring
|
||||
(regi-pos 'bol)
|
||||
(regi-pos 'eol)))
|
||||
(curframe current-frame)
|
||||
(curentry entry)
|
||||
(result (eval func))
|
||||
(step (or (cdr (assq 'step result)) 1))
|
||||
)
|
||||
;; changing frame on the fly?
|
||||
(if (assq 'frame result)
|
||||
(setq working-frame (cdr (assq 'frame result))))
|
||||
(with-suppressed-warnings
|
||||
((lexical curframe curentry curline))
|
||||
(defvar curframe) (defvar curentry) (defvar curline)
|
||||
(let* ((curline (buffer-substring
|
||||
(regi-pos 'bol)
|
||||
(regi-pos 'eol)))
|
||||
(curframe current-frame)
|
||||
(curentry entry)
|
||||
(result (eval func))
|
||||
(step (or (cdr (assq 'step result)) 1))
|
||||
)
|
||||
;; changing frame on the fly?
|
||||
(if (assq 'frame result)
|
||||
(setq working-frame (cdr (assq 'frame result))))
|
||||
|
||||
;; continue processing current frame?
|
||||
(if (memq 'continue result)
|
||||
(setq current-frame (cdr current-frame))
|
||||
(forward-line step)
|
||||
(setq current-frame working-frame))
|
||||
;; continue processing current frame?
|
||||
(if (memq 'continue result)
|
||||
(setq current-frame (cdr current-frame))
|
||||
(forward-line step)
|
||||
(setq current-frame working-frame))
|
||||
|
||||
;; abort current frame?
|
||||
(if (memq 'abort result)
|
||||
(progn
|
||||
(setq donep t)
|
||||
(throw 'regi-throw-top t)))
|
||||
) ; end-let
|
||||
;; abort current frame?
|
||||
(if (memq 'abort result)
|
||||
(progn
|
||||
(setq donep t)
|
||||
(throw 'regi-throw-top t)))
|
||||
)) ; end-let
|
||||
|
||||
;; else if no match occurred, then process the next
|
||||
;; frame-entry on the current line
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;; shadow.el --- locate Emacs Lisp file shadowings
|
||||
;;; shadow.el --- locate Emacs Lisp file shadowings -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 1995, 2001-2021 Free Software Foundation, Inc.
|
||||
|
||||
@ -58,8 +58,7 @@
|
||||
(defcustom load-path-shadows-compare-text nil
|
||||
"If non-nil, then shadowing files are reported only if their text differs.
|
||||
This is slower, but filters out some innocuous shadowing."
|
||||
:type 'boolean
|
||||
:group 'lisp-shadow)
|
||||
:type 'boolean)
|
||||
|
||||
(defun load-path-shadows-find (&optional path)
|
||||
"Return a list of Emacs Lisp files that create shadows.
|
||||
@ -78,8 +77,7 @@ See the documentation for `list-load-path-shadows' for further information."
|
||||
dir-case-insensitive ; `file-name-case-insensitive-p' of dir.
|
||||
curr-files ; This dir's Emacs Lisp files.
|
||||
orig-dir ; Where the file was first seen.
|
||||
files-seen-this-dir ; Files seen so far in this dir.
|
||||
file) ; The current file.
|
||||
files-seen-this-dir) ; Files seen so far in this dir.
|
||||
(dolist (pp (or path load-path))
|
||||
(setq dir (directory-file-name (file-truename (or pp "."))))
|
||||
(if (member dir true-names)
|
||||
@ -109,7 +107,7 @@ See the documentation for `list-load-path-shadows' for further information."
|
||||
|
||||
(dolist (file curr-files)
|
||||
|
||||
(if (string-match "\\.gz$" file)
|
||||
(if (string-match "\\.gz\\'" file)
|
||||
(setq file (substring file 0 -3)))
|
||||
(setq file (substring
|
||||
file 0 (if (string= (substring file -1) "c") -4 -3)))
|
||||
@ -125,9 +123,13 @@ See the documentation for `list-load-path-shadows' for further information."
|
||||
;; XXX.elc (or vice-versa) when they are in the same directory.
|
||||
(setq files-seen-this-dir (cons file files-seen-this-dir))
|
||||
|
||||
(if (setq orig-dir (assoc file files
|
||||
(when dir-case-insensitive
|
||||
(lambda (f1 f2) (eq (compare-strings f1 nil nil f2 nil nil t) t)))))
|
||||
(if (setq orig-dir
|
||||
(assoc file files
|
||||
(when dir-case-insensitive
|
||||
(lambda (f1 f2)
|
||||
(eq (compare-strings f1 nil nil
|
||||
f2 nil nil t)
|
||||
t)))))
|
||||
;; This file was seen before, we have a shadowing.
|
||||
;; Report it unless the files are identical.
|
||||
(let ((base1 (concat (cdr orig-dir) "/" (car orig-dir)))
|
||||
@ -142,7 +144,7 @@ See the documentation for `list-load-path-shadows' for further information."
|
||||
(append shadows (list base1 base2)))))
|
||||
|
||||
;; Not seen before, add it to the list of seen files.
|
||||
(setq files (cons (cons file dir) files)))))))
|
||||
(push (cons file dir) files))))))
|
||||
;; Return the list of shadowings.
|
||||
shadows))
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;;; testcover-ses.el -- Example use of `testcover' to test "SES"
|
||||
;;;; testcover-ses.el -- Example use of `testcover' to test "SES" -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
|
||||
|
||||
@ -19,21 +19,14 @@
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; FIXME: Convert to ERT and move to `test/'?
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'testcover)
|
||||
|
||||
(defvar ses-initial-global-parameters)
|
||||
(defvar ses-mode-map)
|
||||
|
||||
(declare-function ses-set-curcell "ses")
|
||||
(declare-function ses-update-cells "ses")
|
||||
(declare-function ses-load "ses")
|
||||
(declare-function ses-vector-delete "ses")
|
||||
(declare-function ses-create-header-string "ses")
|
||||
(declare-function ses-read-cell "ses")
|
||||
(declare-function ses-read-symbol "ses")
|
||||
(declare-function ses-command-hook "ses")
|
||||
(declare-function ses-jump "ses")
|
||||
|
||||
(require 'ses)
|
||||
|
||||
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
|
||||
;;;macros to pause after each step.
|
||||
@ -652,6 +645,7 @@ spreadsheet files with invalid formatting."
|
||||
(testcover-start "ses.el" t))
|
||||
(require 'unsafep)) ;In case user has safe-functions = t!
|
||||
|
||||
(defvar ses--curcell-overlay)
|
||||
|
||||
;;;#########################################################################
|
||||
(defun ses-exercise ()
|
||||
@ -674,8 +668,8 @@ spreadsheet files with invalid formatting."
|
||||
(ses-load))
|
||||
;;ses-vector-delete is always called from buffer-undo-list with the same
|
||||
;;symbol as argument. We'll give it a different one here.
|
||||
(let ((x [1 2 3]))
|
||||
(ses-vector-delete 'x 0 0))
|
||||
(dlet ((tcover-ses--x [1 2 3]))
|
||||
(ses-vector-delete 'tcover-ses--x 0 0))
|
||||
;;ses-create-header-string behaves differently in a non-window environment
|
||||
;;but we always test under windows.
|
||||
(let ((window-system (not window-system)))
|
||||
@ -704,7 +698,7 @@ spreadsheet files with invalid formatting."
|
||||
(ses-mode)))))
|
||||
;;Test error-handling in command hook, outside a macro.
|
||||
;;This will ring the bell.
|
||||
(let (curcell-overlay)
|
||||
(let (ses--curcell-overlay)
|
||||
(ses-command-hook))
|
||||
;;Due to use of run-with-timer, ses-command-hook sometimes gets called
|
||||
;;after we switch to another buffer.
|
||||
@ -720,4 +714,4 @@ spreadsheet files with invalid formatting."
|
||||
;;Could do this here: (testcover-end "ses.el")
|
||||
(message "Done"))
|
||||
|
||||
;; testcover-ses.el ends here.
|
||||
;;; testcover-ses.el ends here.
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate
|
||||
;;;; unsafep.el -- Determine whether a Lisp form is safe to evaluate -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2002-2021 Free Software Foundation, Inc.
|
||||
|
||||
@ -129,15 +129,16 @@ in the parse.")
|
||||
(put x 'safe-function t))
|
||||
|
||||
;;;###autoload
|
||||
(defun unsafep (form &optional unsafep-vars)
|
||||
(defun unsafep (form &optional vars)
|
||||
"Return nil if evaluating FORM couldn't possibly do any harm.
|
||||
Otherwise result is a reason why FORM is unsafe.
|
||||
UNSAFEP-VARS is a list of symbols with local bindings."
|
||||
VARS is a list of symbols with local bindings like `unsafep-vars'."
|
||||
(catch 'unsafep
|
||||
(if (or (eq safe-functions t) ;User turned off safety-checking
|
||||
(atom form)) ;Atoms are never unsafe
|
||||
(throw 'unsafep nil))
|
||||
(let* ((fun (car form))
|
||||
(let* ((unsafep-vars vars)
|
||||
(fun (car form))
|
||||
(reason (unsafep-function fun))
|
||||
arg)
|
||||
(cond
|
||||
|
||||
Loading…
Reference in New Issue
Block a user