* 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.
lisp/language/tibetan.el
lisp/leim/quail/ethiopic.el
lisp/leim/quail/tibetan.el
+ lisp/international/titdic-cnv.el
* binary files
-;;; 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.
(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 ()
(t nil)))
(defun bindat--unpack-group (spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (struct last)
(while spec
(let* ((item (car spec))
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
(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.
(ip . 4)))
(defun bindat--length-group (struct spec)
+ (with-suppressed-warnings ((lexical last))
+ (defvar last))
(let (last)
(while spec
(let* ((item (car spec))
(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)
(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)
(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))))))
(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))
(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
(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)
(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)
(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))))))
(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
-;;; 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.
-;;; 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,
-;;; 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.
-;;; 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.
;;
"Set up comment functionality for generic mode."
(let ((chars nil)
(comstyles)
- (comstyle "")
(comment-start nil))
;; Go through all the comments.
;; 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
-;;; 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.
;; 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)
-;;; package-x.el --- Package extras
+;;; package-x.el --- Package extras -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2021 Free Software Foundation, Inc.
-;;; regi.el --- REGular expression Interpreting engine
+;;; regi.el --- REGular expression Interpreting engine -*- lexical-binding: t; -*-
;; Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc.
;; 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
;; 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))))
-
- ;; 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
+ (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))
+
+ ;; 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
-;;; 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.
(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.
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)
(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)))
;; 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)))
(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))
-;;;; 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.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-(require 'testcover)
+;;; Commentary:
-(defvar ses-initial-global-parameters)
-(defvar ses-mode-map)
+;; FIXME: Convert to ERT and move to `test/'?
-(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")
+;;; Code:
+(require 'testcover)
+(require 'ses)
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
(testcover-start "ses.el" t))
(require 'unsafep)) ;In case user has safe-functions = t!
+(defvar ses--curcell-overlay)
;;;#########################################################################
(defun ses-exercise ()
(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)))
(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.
;;Could do this here: (testcover-end "ses.el")
(message "Done"))
-;; testcover-ses.el ends here.
+;;; testcover-ses.el ends here.
-;;;; 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.
(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
projects / emacs.git / commitdiff