mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-12 09:00:40 -08:00
Merge from savannah/master
This commit is contained in:
Pip Cet
commit
f2316fff3f
308 changed files with 9562 additions and 6441 deletions
|
|
@ -750,7 +750,7 @@ Format it according to VIEW."
|
|||
(let ((fun-and-args (cons fun args)))
|
||||
(insert (backtrace--print-to-string fun-and-args)))
|
||||
;; Skip the open-paren.
|
||||
(cl-incf fun-beg)))
|
||||
(incf fun-beg)))
|
||||
(when fun-file
|
||||
(make-text-button fun-beg
|
||||
(or fun-end
|
||||
|
|
|
|||
|
|
@ -682,7 +682,7 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
(cl-defmethod bindat--type (op (_ (eql 'byte)))
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-u8))
|
||||
(`(length . ,_) `(cl-incf bindat-idx 1))
|
||||
(`(length . ,_) `(incf bindat-idx 1))
|
||||
(`(pack . ,args) `(bindat--pack-u8 . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql 'uint)) n &optional le)
|
||||
|
|
@ -690,7 +690,7 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
(bindat--pcase op
|
||||
('unpack
|
||||
`(if ,le (bindat--unpack-uintr ,n) (bindat--unpack-uint ,n)))
|
||||
(`(length . ,_) `(cl-incf bindat-idx (/ ,n 8)))
|
||||
(`(length . ,_) `(incf bindat-idx (/ ,n 8)))
|
||||
(`(pack . ,args)
|
||||
`(if ,le (bindat--pack-uintr ,n . ,args)
|
||||
(bindat--pack-uint ,n . ,args))))))
|
||||
|
|
@ -698,14 +698,14 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
(cl-defmethod bindat--type (op (_ (eql 'str)) len)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-str ,len))
|
||||
(`(length . ,_) `(cl-incf bindat-idx ,len))
|
||||
(`(length . ,_) `(incf bindat-idx ,len))
|
||||
(`(pack . ,args) `(bindat--pack-str ,len . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (op (_ (eql 'strz)) &optional len)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-strz ,len))
|
||||
(`(length ,val)
|
||||
`(cl-incf bindat-idx ,(cond
|
||||
`(incf bindat-idx ,(cond
|
||||
;; Optimizations if len is a literal number or nil.
|
||||
((null len) `(1+ (length ,val)))
|
||||
((numberp len) len)
|
||||
|
|
@ -716,11 +716,11 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
|
||||
(bindat--pcase op
|
||||
('unpack `(bindat--unpack-bits ,len))
|
||||
(`(length . ,_) `(cl-incf bindat-idx ,len))
|
||||
(`(length . ,_) `(incf bindat-idx ,len))
|
||||
(`(pack . ,args) `(bindat--pack-bits ,len . ,args))))
|
||||
|
||||
(cl-defmethod bindat--type (_op (_ (eql 'fill)) len)
|
||||
`(progn (cl-incf bindat-idx ,len) nil))
|
||||
`(progn (incf bindat-idx ,len) nil))
|
||||
|
||||
(cl-defmethod bindat--type (_op (_ (eql 'align)) len)
|
||||
`(progn (cl-callf bindat--align bindat-idx ,len) nil))
|
||||
|
|
@ -747,7 +747,7 @@ is the name of a variable that will hold the value we need to pack.")
|
|||
(let `#'(lambda (,val) (setq bindat-idx (+ bindat-idx ,len))) fun)
|
||||
(guard (not (macroexp--fgrep `((,val)) len))))
|
||||
;; Optimize the case where the size of each element is constant.
|
||||
`(cl-incf bindat-idx (* ,count ,len)))
|
||||
`(incf bindat-idx (* ,count ,len)))
|
||||
;; FIXME: It's tempting to use `(mapc (lambda (,val) ,exp) ,val)'
|
||||
;; which would be more efficient when `val' is a list,
|
||||
;; but that's only right if length of `val' is indeed `count'.
|
||||
|
|
|
|||
|
|
@ -2052,7 +2052,7 @@ also be compiled."
|
|||
(not (member source (dir-locals--all-files directory)))
|
||||
;; File is requested to be ignored
|
||||
(not (string-match-p ignore-files-regexp source)))
|
||||
(progn (cl-incf
|
||||
(progn (incf
|
||||
(pcase (byte-recompile-file source force arg)
|
||||
('no-byte-compile skip-count)
|
||||
('t file-count)
|
||||
|
|
@ -3773,7 +3773,7 @@ This assumes the function has the `important-return-value' property."
|
|||
;; Add missing &optional (or &rest) arguments.
|
||||
(dotimes (_ (- (/ (1+ fmax2) 2) alen))
|
||||
(byte-compile-push-constant nil)))
|
||||
((zerop (logand fmax2 1))
|
||||
((evenp fmax2)
|
||||
(byte-compile-report-error
|
||||
(format "Too many arguments for inlined function %S" form))
|
||||
(byte-compile-discard (- alen (/ fmax2 2))))
|
||||
|
|
|
|||
|
|
@ -347,7 +347,7 @@ of the drawing."
|
|||
(odd nil)
|
||||
p1)
|
||||
(while s
|
||||
(setq odd (= (% (length s) 2) 1))
|
||||
(setq odd (oddp (length s)))
|
||||
(setq r (chart-translate-namezone (oref a chart) i))
|
||||
(if (eq dir 'vertical)
|
||||
(setq p (/ (+ (car r) (cdr r)) 2))
|
||||
|
|
@ -633,7 +633,7 @@ argument to `chart-sort' to sort the lists if desired."
|
|||
(m (member s extlst)))
|
||||
(unless (null s)
|
||||
(if m
|
||||
(cl-incf (car (nthcdr (- (length extlst) (length m)) cntlst)))
|
||||
(incf (car (nthcdr (- (length extlst) (length m)) cntlst)))
|
||||
(setq extlst (cons s extlst)
|
||||
cntlst (cons 1 cntlst))))))
|
||||
;; Let's create the chart!
|
||||
|
|
|
|||
|
|
@ -322,6 +322,14 @@ variable `checkdoc-common-verbs-wrong-voice' if you wish to add your own."
|
|||
Do not set this by hand, use a function like `checkdoc-current-buffer'
|
||||
with a universal argument.")
|
||||
|
||||
(defcustom checkdoc-allow-quoting-nil-and-t nil
|
||||
"If non-nil, don't warn when the symbols nil and t are quoted.
|
||||
|
||||
In other words, it allows writing them like this: \\=`nil\\=', \\=`t\\='."
|
||||
:type 'boolean
|
||||
:version "31.1")
|
||||
;;;###autoload(put 'checkdoc-allow-quoting-nil-and-t 'safe-local-variable #'booleanp)
|
||||
|
||||
(defcustom checkdoc-symbol-words
|
||||
'("beginning-of-buffer" "beginning-of-line" "byte-code"
|
||||
"byte-compile" "command-line" "end-of-buffer" "end-of-line"
|
||||
|
|
@ -1956,17 +1964,18 @@ Replace with \"%s\"?" original replace)
|
|||
(length ms)))
|
||||
nil)))
|
||||
;; t and nil case
|
||||
(save-excursion
|
||||
(if (re-search-forward "\\([`‘]\\(t\\|nil\\)['’]\\)" e t)
|
||||
(if (checkdoc-autofix-ask-replace
|
||||
(match-beginning 1) (match-end 1)
|
||||
(format "%s should not appear in quotes. Remove?"
|
||||
(match-string 2))
|
||||
(match-string 2) t)
|
||||
nil
|
||||
(checkdoc-create-error
|
||||
"Symbols t and nil should not appear in single quotes"
|
||||
(match-beginning 1) (match-end 1)))))
|
||||
(unless checkdoc-allow-quoting-nil-and-t
|
||||
(save-excursion
|
||||
(if (re-search-forward "\\([`‘]\\(t\\|nil\\)['’]\\)" e t)
|
||||
(if (checkdoc-autofix-ask-replace
|
||||
(match-beginning 1) (match-end 1)
|
||||
(format "%s should not appear in quotes. Remove?"
|
||||
(match-string 2))
|
||||
(match-string 2) t)
|
||||
nil
|
||||
(checkdoc-create-error
|
||||
"Symbols t and nil should not appear in single quotes"
|
||||
(match-beginning 1) (match-end 1))))))
|
||||
;; Here is some basic sentence formatting
|
||||
(checkdoc-sentencespace-region-engine (point) e)
|
||||
;; Here are common proper nouns that should always appear capitalized.
|
||||
|
|
@ -2109,7 +2118,7 @@ The text checked is between START and LIMIT."
|
|||
(goto-char start)
|
||||
(while (and (< (point) p) (re-search-forward "\\\\\"" limit t))
|
||||
(setq c (1+ c)))
|
||||
(and (< 0 c) (= (% c 2) 0))))))
|
||||
(and (< 0 c) (evenp c))))))
|
||||
|
||||
(defun checkdoc-in-abbreviation-p (begin)
|
||||
"Return non-nil if point is at an abbreviation.
|
||||
|
|
|
|||
|
|
@ -392,7 +392,7 @@ With two arguments, return rounding and remainder of their quotient."
|
|||
(res (cl-floor (+ x hy) y)))
|
||||
(if (and (= (car (cdr res)) 0)
|
||||
(= (+ hy hy) y)
|
||||
(/= (% (car res) 2) 0))
|
||||
(oddp (car res)))
|
||||
(list (1- (car res)) hy)
|
||||
(list (car res) (- (car (cdr res)) hy))))
|
||||
(let ((q (round (/ x y))))
|
||||
|
|
@ -441,8 +441,8 @@ as an integer unless JUNK-ALLOWED is non-nil."
|
|||
(setq start (1+ start)))))
|
||||
(skip-whitespace)
|
||||
(let ((sign (cl-case (and (< start end) (aref string start))
|
||||
(?+ (cl-incf start) +1)
|
||||
(?- (cl-incf start) -1)
|
||||
(?+ (incf start) +1)
|
||||
(?- (incf start) -1)
|
||||
(t +1)))
|
||||
digit sum)
|
||||
(while (and (< start end)
|
||||
|
|
@ -908,7 +908,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
|
|||
`(space :align-to ,(+ col col-space)))
|
||||
"%s")
|
||||
formats)
|
||||
(cl-incf col (+ col-space (aref cols i))))
|
||||
(incf col (+ col-space (aref cols i))))
|
||||
(let ((format (mapconcat #'identity (nreverse formats))))
|
||||
(insert (apply #'format format
|
||||
(mapcar (lambda (str) (propertize str 'face 'italic))
|
||||
|
|
|
|||
|
|
@ -509,7 +509,7 @@ Presumes point is at the end of the `cl-defmethod' symbol."
|
|||
(let ((n 2))
|
||||
(while (and (ignore-errors (forward-sexp 1) t)
|
||||
(not (eq (char-before) ?\))))
|
||||
(cl-incf n))
|
||||
(incf n))
|
||||
n)))
|
||||
|
||||
;;;###autoload
|
||||
|
|
|
|||
|
|
@ -179,13 +179,13 @@ the standard Lisp indent package."
|
|||
(when (and (eq lisp-indent-backquote-substitution-mode 'corrected))
|
||||
(save-excursion
|
||||
(goto-char (elt state 1))
|
||||
(cl-incf loop-indentation
|
||||
(cond ((eq (char-before) ?,) -1)
|
||||
((and (eq (char-before) ?@)
|
||||
(progn (backward-char)
|
||||
(eq (char-before) ?,)))
|
||||
-2)
|
||||
(t 0)))))
|
||||
(incf loop-indentation
|
||||
(cond ((eq (char-before) ?,) -1)
|
||||
((and (eq (char-before) ?@)
|
||||
(progn (backward-char)
|
||||
(eq (char-before) ?,)))
|
||||
-2)
|
||||
(t 0)))))
|
||||
|
||||
(goto-char indent-point)
|
||||
(beginning-of-line)
|
||||
|
|
@ -400,9 +400,9 @@ instead."
|
|||
;; ",(...)" or ",@(...)"
|
||||
(when (eq lisp-indent-backquote-substitution-mode
|
||||
'corrected)
|
||||
(cl-incf sexp-column -1)
|
||||
(incf sexp-column -1)
|
||||
(when (eq (char-after (1- containing-sexp)) ?\@)
|
||||
(cl-incf sexp-column -1)))
|
||||
(incf sexp-column -1)))
|
||||
(cond (lisp-indent-backquote-substitution-mode
|
||||
(setf tentative-calculated normal-indent)
|
||||
(setq depth lisp-indent-maximum-backtracking)
|
||||
|
|
@ -706,7 +706,7 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\
|
|||
(forward-sexp 2)
|
||||
(skip-chars-forward " \t\n")
|
||||
(while (looking-at "\\sw\\|\\s_")
|
||||
(cl-incf nqual)
|
||||
(incf nqual)
|
||||
(forward-sexp)
|
||||
(skip-chars-forward " \t\n"))
|
||||
(> nqual 0)))
|
||||
|
|
|
|||
|
|
@ -105,29 +105,27 @@ a future Emacs interpreter will be able to use it.")
|
|||
;; can safely be used in init files.
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-incf (place &optional x)
|
||||
(defalias 'cl-incf #'incf
|
||||
"Increment PLACE by X (1 by default).
|
||||
PLACE may be a symbol, or any generalized variable allowed by `setf'.
|
||||
The return value is the incremented value of PLACE.
|
||||
|
||||
If X is specified, it should be an expression that should
|
||||
evaluate to a number."
|
||||
(declare (debug (place &optional form)))
|
||||
(if (symbolp place)
|
||||
(list 'setq place (if x (list '+ place x) (list '1+ place)))
|
||||
(list 'cl-callf '+ place (or x 1))))
|
||||
evaluate to a number.
|
||||
|
||||
(defmacro cl-decf (place &optional x)
|
||||
This macro is considered deprecated in favor of the built-in macro
|
||||
`incf' that was added in Emacs 31.1.")
|
||||
|
||||
(defalias 'cl-decf #'decf
|
||||
"Decrement PLACE by X (1 by default).
|
||||
PLACE may be a symbol, or any generalized variable allowed by `setf'.
|
||||
The return value is the decremented value of PLACE.
|
||||
|
||||
If X is specified, it should be an expression that should
|
||||
evaluate to a number."
|
||||
(declare (debug cl-incf))
|
||||
(if (symbolp place)
|
||||
(list 'setq place (if x (list '- place x) (list '1- place)))
|
||||
(list 'cl-callf '- place (or x 1))))
|
||||
evaluate to a number.
|
||||
|
||||
This macro is considered deprecated in favor of the built-in macro
|
||||
`decf' that was added in Emacs 31.1.")
|
||||
|
||||
(defmacro cl-pushnew (x place &rest keys)
|
||||
"Add X to the list stored in PLACE unless X is already in the list.
|
||||
|
|
@ -164,9 +162,9 @@ to an element already in the list stored in PLACE.
|
|||
val))
|
||||
|
||||
(defun cl--set-substring (str start end val)
|
||||
(if end (if (< end 0) (cl-incf end (length str)))
|
||||
(if end (if (< end 0) (incf end (length str)))
|
||||
(setq end (length str)))
|
||||
(if (< start 0) (cl-incf start (length str)))
|
||||
(if (< start 0) (incf start (length str)))
|
||||
(concat (and (> start 0) (substring str 0 start))
|
||||
val
|
||||
(and (< end (length str)) (substring str end))))
|
||||
|
|
@ -270,27 +268,29 @@ so that they are registered at compile-time as well as run-time."
|
|||
|
||||
(define-obsolete-function-alias 'cl-floatp-safe 'floatp "24.4")
|
||||
|
||||
(defsubst cl-plusp (number)
|
||||
"Return t if NUMBER is positive."
|
||||
(declare (side-effect-free t))
|
||||
(> number 0))
|
||||
(defalias 'cl-plusp #'plusp
|
||||
"Return t if NUMBER is positive.
|
||||
|
||||
(defsubst cl-minusp (number)
|
||||
"Return t if NUMBER is negative."
|
||||
(declare (side-effect-free t))
|
||||
(< number 0))
|
||||
This function is considered deprecated in favor of the built-in function
|
||||
`plusp' that was added in Emacs 31.1.")
|
||||
|
||||
(defun cl-oddp (integer)
|
||||
"Return t if INTEGER is odd."
|
||||
(declare (side-effect-free t)
|
||||
(compiler-macro (lambda (_) `(eq (logand ,integer 1) 1))))
|
||||
(eq (logand integer 1) 1))
|
||||
(defalias 'cl-minusp #'minusp
|
||||
"Return t if NUMBER is negative.
|
||||
|
||||
(defun cl-evenp (integer)
|
||||
"Return t if INTEGER is even."
|
||||
(declare (side-effect-free t)
|
||||
(compiler-macro (lambda (_) `(eq (logand ,integer 1) 0))))
|
||||
(eq (logand integer 1) 0))
|
||||
This function is considered deprecated in favor of the built-in function
|
||||
`minusp' that was added in Emacs 31.1.")
|
||||
|
||||
(defalias 'cl-oddp #'oddp
|
||||
"Return t if INTEGER is odd.
|
||||
|
||||
This function is considered deprecated in favor of the built-in function
|
||||
`oddp' that was added in Emacs 31.1.")
|
||||
|
||||
(defalias 'cl-evenp #'evenp
|
||||
"Return t if INTEGER is even.
|
||||
|
||||
This function is considered deprecated in favor of the built-in function
|
||||
`evenp' that was added in Emacs 31.1.")
|
||||
|
||||
(defconst cl-digit-char-table
|
||||
(let* ((digits (make-vector 256 nil))
|
||||
|
|
@ -456,7 +456,7 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
|
|||
;;With optional argument N, returns Nth-to-last link (default 1)."
|
||||
;; (if n
|
||||
;; (let ((m 0) (p x))
|
||||
;; (while (consp p) (cl-incf m) (pop p))
|
||||
;; (while (consp p) (incf m) (pop p))
|
||||
;; (if (<= n 0) p
|
||||
;; (if (< n m) (nthcdr (- m n) x) x)))
|
||||
;; (while (consp (cdr x)) (pop x))
|
||||
|
|
|
|||
|
|
@ -336,7 +336,7 @@ FORM is of the form (ARGS . BODY)."
|
|||
(format "%S" (cons 'fn (cl--make-usage-args
|
||||
orig-args))))))))
|
||||
(when (memq '&optional simple-args)
|
||||
(cl-decf slen))
|
||||
(decf slen))
|
||||
(setq header
|
||||
(cons
|
||||
(if (eq :documentation (car-safe (car header)))
|
||||
|
|
@ -1598,12 +1598,12 @@ For more details, see Info node `(cl)Loop Facility'.
|
|||
((memq word '(sum summing))
|
||||
(let ((what (pop cl--loop-args))
|
||||
(var (cl--loop-handle-accum 0)))
|
||||
(push `(progn (cl-incf ,var ,what) t) cl--loop-body)))
|
||||
(push `(progn (incf ,var ,what) t) cl--loop-body)))
|
||||
|
||||
((memq word '(count counting))
|
||||
(let ((what (pop cl--loop-args))
|
||||
(var (cl--loop-handle-accum 0)))
|
||||
(push `(progn (if ,what (cl-incf ,var)) t) cl--loop-body)))
|
||||
(push `(progn (if ,what (incf ,var)) t) cl--loop-body)))
|
||||
|
||||
((memq word '(minimize minimizing maximize maximizing))
|
||||
(push `(progn ,(macroexp-let2 macroexp-copyable-p temp
|
||||
|
|
@ -2624,10 +2624,8 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C).
|
|||
;;; Declarations.
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-locally (&rest body)
|
||||
"Equivalent to `progn'."
|
||||
(declare (debug t))
|
||||
(cons 'progn body))
|
||||
(define-obsolete-function-alias 'cl-locally #'progn "31.1")
|
||||
|
||||
;;;###autoload
|
||||
(defmacro cl-the (type form)
|
||||
"Return FORM. If type-checking is enabled, assert that it is of TYPE."
|
||||
|
|
@ -2701,7 +2699,7 @@ Example:
|
|||
(let ((speed (assq (nth 1 (assq 'speed (cdr spec)))
|
||||
'((0 nil) (1 t) (2 t) (3 t))))
|
||||
(safety (assq (nth 1 (assq 'safety (cdr spec)))
|
||||
'((0 t) (1 t) (2 t) (3 nil)))))
|
||||
'((0 t) (1 nil) (2 nil) (3 nil)))))
|
||||
(if speed (setq cl--optimize-speed (car speed)
|
||||
byte-optimize (nth 1 speed)))
|
||||
(if safety (setq cl--optimize-safety (car safety)
|
||||
|
|
@ -3259,7 +3257,7 @@ To see the documentation for a defined struct type, use
|
|||
(declare (side-effect-free t))
|
||||
,access-body)
|
||||
forms)
|
||||
(when (cl-oddp (length desc))
|
||||
(when (oddp (length desc))
|
||||
(push
|
||||
(macroexp-warn-and-return
|
||||
(format-message
|
||||
|
|
|
|||
|
|
@ -161,7 +161,7 @@
|
|||
(car slot) (nth 1 slot)
|
||||
type props)))
|
||||
(puthash (car slot) (+ i offset) index-table)
|
||||
(cl-incf i))
|
||||
(incf i))
|
||||
v))
|
||||
(class (cl--struct-new-class
|
||||
name docstring
|
||||
|
|
|
|||
|
|
@ -100,7 +100,7 @@ Print the contents hidden by the ellipsis to STREAM."
|
|||
(cl-print-object (pop object) stream)
|
||||
(cl-print-insert-ellipsis object t stream)
|
||||
(setq object nil))
|
||||
(cl-incf count))
|
||||
(incf count))
|
||||
(when object
|
||||
(princ " . " stream) (cl-print-object object stream))))
|
||||
|
||||
|
|
@ -123,7 +123,7 @@ Print the contents hidden by the ellipsis to STREAM."
|
|||
(while (< i limit)
|
||||
(unless (= i start) (princ " " stream))
|
||||
(cl-print-object (aref object i) stream)
|
||||
(cl-incf i))
|
||||
(incf i))
|
||||
(when (< limit len)
|
||||
(princ " " stream)
|
||||
(cl-print-insert-ellipsis object limit stream))))
|
||||
|
|
@ -298,7 +298,7 @@ into a button whose action shows the function's disassembly.")
|
|||
(princ (cl--slot-descriptor-name slot) stream)
|
||||
(princ " " stream)
|
||||
(cl-print-object (aref object (1+ i)) stream))
|
||||
(cl-incf i))
|
||||
(incf i))
|
||||
(when (< limit len)
|
||||
(princ " " stream)
|
||||
(cl-print-insert-ellipsis object limit stream))))
|
||||
|
|
@ -369,7 +369,7 @@ primitives such as `prin1'.")
|
|||
(princ start-pos stream)
|
||||
(princ " " stream) (princ end-pos stream)
|
||||
(princ " " stream) (cl-print-object props stream)
|
||||
(cl-incf interval-count))
|
||||
(incf interval-count))
|
||||
(setq start-pos end-pos
|
||||
end-pos (next-property-change start-pos object len))))
|
||||
(when (< start-pos len)
|
||||
|
|
@ -636,10 +636,10 @@ abbreviating it with ellipses to fit within a size limit."
|
|||
(throw 'done (buffer-string)))
|
||||
(let* ((ratio (/ result limit))
|
||||
(delta-level (max 1 (min (- print-level 2) ratio))))
|
||||
(cl-decf print-level delta-level)
|
||||
(cl-decf print-length (* delta-length delta-level))
|
||||
(decf print-level delta-level)
|
||||
(decf print-length (* delta-length delta-level))
|
||||
(when cl-print-string-length
|
||||
(cl-decf cl-print-string-length
|
||||
(decf cl-print-string-length
|
||||
(ceiling cl-print-string-length 4.0))))))))))
|
||||
|
||||
(provide 'cl-print)
|
||||
|
|
|
|||
|
|
@ -171,7 +171,7 @@ FUNCTION is also reversed.
|
|||
(if (listp cl-seq)
|
||||
(let ((p (nthcdr cl-start cl-seq))
|
||||
(n (and cl-end (- cl-end cl-start))))
|
||||
(while (and p (or (null n) (>= (cl-decf n) 0)))
|
||||
(while (and p (or (null n) (>= (decf n) 0)))
|
||||
(setcar p cl-item)
|
||||
(setq p (cdr p))))
|
||||
(or cl-end (setq cl-end (length cl-seq)))
|
||||
|
|
@ -206,7 +206,7 @@ SEQ1 is destructively modified, then returned.
|
|||
(min cl-n1 (- cl-end2 cl-start2)))
|
||||
((and cl-n1 (null cl-end2)) cl-n1)
|
||||
((and (null cl-n1) cl-end2) (- cl-end2 cl-start2)))))
|
||||
(while (and cl-p1 cl-p2 (or (null cl-n) (>= (cl-decf cl-n) 0)))
|
||||
(while (and cl-p1 cl-p2 (or (null cl-n) (>= (decf cl-n) 0)))
|
||||
(setcar cl-p1 (car cl-p2))
|
||||
(setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
|
||||
(setq cl-end2 (if (null cl-n1)
|
||||
|
|
@ -439,8 +439,8 @@ to avoid corrupting the original SEQ.
|
|||
(setq cl-seq (copy-sequence cl-seq))
|
||||
(unless cl-from-end
|
||||
(setf (elt cl-seq cl-i) cl-new)
|
||||
(cl-incf cl-i)
|
||||
(cl-decf cl-count))
|
||||
(incf cl-i)
|
||||
(decf cl-count))
|
||||
(apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count
|
||||
:start cl-i cl-keys))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -448,12 +448,12 @@ Return them as multiple value."
|
|||
do
|
||||
(when (zerop nest)
|
||||
(setf low i))
|
||||
(cl-incf nest)
|
||||
(incf nest)
|
||||
else
|
||||
do
|
||||
(when (= nest 1)
|
||||
(push `(,(comp-range-1+ low) . ,i) res))
|
||||
(cl-decf nest)
|
||||
(decf nest)
|
||||
finally return (reverse res)))
|
||||
|
||||
(defun comp--range-intersection (&rest ranges)
|
||||
|
|
@ -477,7 +477,7 @@ Return them as multiple value."
|
|||
(cl-return '()))
|
||||
if (eq x 'l)
|
||||
do
|
||||
(cl-incf nest)
|
||||
(incf nest)
|
||||
(when (= nest n-ranges)
|
||||
(setf low i))
|
||||
else
|
||||
|
|
@ -485,7 +485,7 @@ Return them as multiple value."
|
|||
(when (= nest n-ranges)
|
||||
(push `(,low . ,i)
|
||||
res))
|
||||
(cl-decf nest)
|
||||
(decf nest)
|
||||
finally return (reverse res)))
|
||||
|
||||
(defun comp--range-negation (range)
|
||||
|
|
|
|||
|
|
@ -334,14 +334,14 @@ Useful to hook into pass checkers.")
|
|||
"Append ELT into VEC.
|
||||
Returns ELT."
|
||||
(puthash (comp-vec-end vec) elt (comp-vec-data vec))
|
||||
(cl-incf (comp-vec-end vec))
|
||||
(incf (comp-vec-end vec))
|
||||
elt)
|
||||
|
||||
(defsubst comp-vec-prepend (vec elt)
|
||||
"Prepend ELT into VEC.
|
||||
Returns ELT."
|
||||
(puthash (1- (comp-vec-beg vec)) elt (comp-vec-data vec))
|
||||
(cl-decf (comp-vec-beg vec))
|
||||
(decf (comp-vec-beg vec))
|
||||
elt)
|
||||
|
||||
|
||||
|
|
@ -492,7 +492,7 @@ non local exit (ends with an `unreachable' insn)."))
|
|||
"Return a sequential number generator."
|
||||
(let ((n -1))
|
||||
(lambda ()
|
||||
(cl-incf n))))
|
||||
(incf n))))
|
||||
|
||||
(cl-defstruct (comp-func (:copier nil))
|
||||
"LIMPLE representation of a function."
|
||||
|
|
@ -1302,7 +1302,7 @@ and the annotation emission."
|
|||
;; ,(concat "LAP op " op-name)))
|
||||
;; Emit the stack adjustment if present.
|
||||
,(when (and sp-delta (not (eq 0 sp-delta)))
|
||||
`(cl-incf (comp--sp) ,sp-delta))
|
||||
`(incf (comp--sp) ,sp-delta))
|
||||
,@(comp--body-eff body op-name sp-delta))
|
||||
else
|
||||
collect `(',op (signal 'native-ice
|
||||
|
|
@ -1336,7 +1336,7 @@ and the annotation emission."
|
|||
(make--comp-mvar :constant arg)
|
||||
(comp--slot+1))))
|
||||
(byte-call
|
||||
(cl-incf (comp--sp) (- arg))
|
||||
(incf (comp--sp) (- arg))
|
||||
(comp--emit-set-call (comp--callref 'funcall (1+ arg) (comp--sp))))
|
||||
(byte-unbind
|
||||
(comp--emit (comp--call 'helper_unbind_n
|
||||
|
|
@ -1491,19 +1491,19 @@ and the annotation emission."
|
|||
(byte-numberp auto)
|
||||
(byte-integerp auto)
|
||||
(byte-listN
|
||||
(cl-incf (comp--sp) (- 1 arg))
|
||||
(incf (comp--sp) (- 1 arg))
|
||||
(comp--emit-set-call (comp--callref 'list arg (comp--sp))))
|
||||
(byte-concatN
|
||||
(cl-incf (comp--sp) (- 1 arg))
|
||||
(incf (comp--sp) (- 1 arg))
|
||||
(comp--emit-set-call (comp--callref 'concat arg (comp--sp))))
|
||||
(byte-insertN
|
||||
(cl-incf (comp--sp) (- 1 arg))
|
||||
(incf (comp--sp) (- 1 arg))
|
||||
(comp--emit-set-call (comp--callref 'insert arg (comp--sp))))
|
||||
(byte-stack-set
|
||||
(comp--copy-slot (1+ (comp--sp)) (- (comp--sp) arg -1)))
|
||||
(byte-stack-set2 (cl-assert nil)) ;; TODO
|
||||
(byte-discardN
|
||||
(cl-incf (comp--sp) (- arg)))
|
||||
(incf (comp--sp) (- arg)))
|
||||
(byte-switch
|
||||
;; Assume to follow the emission of a setimm.
|
||||
;; This is checked into comp--emit-switch.
|
||||
|
|
@ -1513,7 +1513,7 @@ and the annotation emission."
|
|||
(byte-constant
|
||||
(comp--emit-setimm arg))
|
||||
(byte-discardN-preserve-tos
|
||||
(cl-incf (comp--sp) (- arg))
|
||||
(incf (comp--sp) (- arg))
|
||||
(comp--copy-slot (+ arg (comp--sp)))))))
|
||||
|
||||
(defun comp--emit-narg-prologue (minarg nonrest rest)
|
||||
|
|
@ -1543,7 +1543,7 @@ and the annotation emission."
|
|||
(comp--emit `(set-rest-args-to-local ,(comp--slot-n nonrest)))
|
||||
(setf (comp--sp) nonrest)
|
||||
(when (and (> nonrest 8) (null rest))
|
||||
(cl-decf (comp--sp))))
|
||||
(decf (comp--sp))))
|
||||
|
||||
(defun comp--limplify-finalize-function (func)
|
||||
"Reverse insns into all basic blocks of FUNC."
|
||||
|
|
@ -1722,7 +1722,7 @@ into the C code forwarding the compilation unit."
|
|||
for inst = (car inst-cell)
|
||||
for next-inst = (car-safe (cdr inst-cell))
|
||||
do (comp--limplify-lap-inst inst)
|
||||
(cl-incf (comp-limplify-pc comp-pass))
|
||||
(incf (comp-limplify-pc comp-pass))
|
||||
when (comp--lap-fall-through-p inst)
|
||||
do (pcase next-inst
|
||||
(`(TAG ,_label . ,label-sp)
|
||||
|
|
@ -1755,7 +1755,7 @@ into the C code forwarding the compilation unit."
|
|||
(let ((args (comp-func-l-args func)))
|
||||
(if (comp-args-p args)
|
||||
(cl-loop for i below (comp-args-max args)
|
||||
do (cl-incf (comp--sp))
|
||||
do (incf (comp--sp))
|
||||
(comp--emit `(set-par-to-local ,(comp--slot) ,i)))
|
||||
(comp--emit-narg-prologue (comp-args-base-min args)
|
||||
(comp-nargs-nonrest args)
|
||||
|
|
@ -1901,7 +1901,7 @@ Return OP otherwise."
|
|||
(if-let* ((match (eql (comp-mvar-slot op) (comp-mvar-slot cmp-res)))
|
||||
(new-mvar (make--comp-mvar
|
||||
:slot
|
||||
(- (cl-incf (comp-func-vframe-size comp-func))))))
|
||||
(- (incf (comp-func-vframe-size comp-func))))))
|
||||
(progn
|
||||
(push `(assume ,new-mvar ,op) (cdr insns-seq))
|
||||
new-mvar)
|
||||
|
|
@ -2768,7 +2768,7 @@ Return t if something was changed."
|
|||
(comp--copy-insn insn))
|
||||
do
|
||||
(comp--fwprop-insn insn)
|
||||
(cl-incf i)
|
||||
(incf i)
|
||||
when (and (null modified) (not (equal insn orig-insn)))
|
||||
do (setf modified t))
|
||||
when (> i comp--fwprop-max-insns-scan)
|
||||
|
|
|
|||
|
|
@ -47,21 +47,22 @@ A `cond*' construct is a series of clauses, and a clause
|
|||
normally has the form (CONDITION BODY...).
|
||||
|
||||
CONDITION can be a Lisp expression, as in `cond'.
|
||||
Or it can be one of `(pcase* PATTERN DATUM)',
|
||||
`(bind* BINDINGS...)', or `(match* PATTERN DATUM)',
|
||||
Or it can be one of`(bind* BINDINGS...)', `(match* PATTERN DATUM)',
|
||||
or `(pcase* PATTERN DATUM)',
|
||||
|
||||
`(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*')
|
||||
for the body of the clause, and all subsequent clauses, since the `bind*'
|
||||
clause is always a non-exit clause. As a condition, it counts as true
|
||||
and runs the body of the clause if the first binding's value is non-nil.
|
||||
|
||||
`(match* PATTERN DATUM)' means to match DATUM against the pattern PATTERN
|
||||
For its patterns, see `match*'.
|
||||
The condition counts as true if PATTERN matches DATUM.
|
||||
|
||||
`(pcase* PATTERN DATUM)' means to match DATUM against the
|
||||
pattern PATTERN, using the same pattern syntax as `pcase'.
|
||||
The condition counts as true if PATTERN matches DATUM.
|
||||
|
||||
`(bind* BINDINGS...)' means to bind BINDINGS (as if they were in `let*')
|
||||
for the body of the clause. As a condition, it counts as true
|
||||
if the first binding's value is non-nil. All the bindings are made
|
||||
unconditionally for whatever scope they cover.
|
||||
|
||||
`(match* PATTERN DATUM)' is an alternative to `pcase*' that uses another
|
||||
syntax for its patterns, see `match*'.
|
||||
|
||||
When a clause's condition is true, and it exits the `cond*'
|
||||
or is the last clause, the value of the last expression
|
||||
in its body becomes the return value of the `cond*' construct.
|
||||
|
|
@ -69,7 +70,7 @@ in its body becomes the return value of the `cond*' construct.
|
|||
Non-exit clause:
|
||||
|
||||
If a clause has only one element, or if its first element is
|
||||
a `bind*' clause, this clause never exits the `cond*' construct.
|
||||
t or a `bind*' clause, this clause never exits the `cond*' construct.
|
||||
Instead, control always falls through to the next clause (if any).
|
||||
All bindings made in CONDITION for the BODY of the non-exit clause
|
||||
are passed along to the rest of the clauses in this `cond*' construct.
|
||||
|
|
@ -149,10 +150,9 @@ ATOM (meaning any other kind of non-list not described above)
|
|||
(and (cdr-safe clause)
|
||||
;; Starts with t.
|
||||
(or (eq (car clause) t)
|
||||
;; Begins with keyword.
|
||||
(keywordp (car clause))))
|
||||
;; Ends with keyword.
|
||||
(keywordp (car (last clause)))))
|
||||
;; Starts with a `bind*' pseudo-form.
|
||||
(and (consp (car clause))
|
||||
(eq (caar clause) 'bind*))))))
|
||||
|
||||
(defun cond*-non-exit-clause-substance (clause)
|
||||
"For a non-exit cond* clause CLAUSE, return its substance.
|
||||
|
|
|
|||
|
|
@ -4255,7 +4255,7 @@ code location is known."
|
|||
(let ((new-frame (copy-edebug--frame frame))
|
||||
(fun (edebug--frame-fun frame))
|
||||
(args (edebug--frame-args frame)))
|
||||
(cl-decf index) ;; FIXME: Not used?
|
||||
(decf index) ;; FIXME: Not used?
|
||||
(pcase fun
|
||||
('edebug-enter
|
||||
(setq skip-next-lambda t
|
||||
|
|
@ -4594,8 +4594,8 @@ With prefix argument, make it a temporary breakpoint."
|
|||
(let ((s 1))
|
||||
(while (memq (nth 1 (backtrace-frame i 'called-interactively-p))
|
||||
'(edebug-enter edebug-default-enter))
|
||||
(cl-incf s)
|
||||
(cl-incf i))
|
||||
(incf s)
|
||||
(incf i))
|
||||
s)))
|
||||
|
||||
;; Finally, hook edebug into the rest of Emacs.
|
||||
|
|
|
|||
|
|
@ -115,10 +115,10 @@ and reference them using the function `class-option'."
|
|||
(cl-check-type superclasses list)
|
||||
|
||||
(cond ((and (stringp (car options-and-doc))
|
||||
(/= 1 (% (length options-and-doc) 2)))
|
||||
(evenp (length options-and-doc)))
|
||||
(error "Too many arguments to `defclass'"))
|
||||
((and (symbolp (car options-and-doc))
|
||||
(/= 0 (% (length options-and-doc) 2)))
|
||||
(oddp (length options-and-doc)))
|
||||
(error "Too many arguments to `defclass'")))
|
||||
|
||||
(if (stringp (car options-and-doc))
|
||||
|
|
|
|||
|
|
@ -903,7 +903,7 @@ the docstrings eventually produced, using
|
|||
interactive))
|
||||
(make-callback
|
||||
(method origin)
|
||||
(let ((pos (prog1 howmany (cl-incf howmany))))
|
||||
(let ((pos (prog1 howmany (incf howmany))))
|
||||
(cl-ecase method
|
||||
(:enthusiast
|
||||
(lambda (string &rest plist)
|
||||
|
|
@ -920,10 +920,10 @@ the docstrings eventually produced, using
|
|||
nil #'display-doc))
|
||||
t))
|
||||
(:patient
|
||||
(cl-incf want)
|
||||
(incf want)
|
||||
(lambda (string &rest plist)
|
||||
(register-doc pos string plist origin)
|
||||
(when (zerop (cl-decf want)) (display-doc))
|
||||
(when (zerop (decf want)) (display-doc))
|
||||
t))
|
||||
(:eager
|
||||
(lambda (string &rest plist)
|
||||
|
|
|
|||
|
|
@ -798,7 +798,7 @@ CODE can be a lambda expression, a macro, or byte-compiled code."
|
|||
|
||||
(defun elint-check-setq-form (form env)
|
||||
"Lint the setq FORM in ENV."
|
||||
(or (= (mod (length form) 2) 1)
|
||||
(or (oddp (length form))
|
||||
;; (setq foo) is valid and equivalent to (setq foo nil).
|
||||
(elint-warning "Missing value in setq: %s" form))
|
||||
(let ((newenv env)
|
||||
|
|
@ -833,7 +833,7 @@ CODE can be a lambda expression, a macro, or byte-compiled code."
|
|||
"Lint the defcustom FORM in ENV."
|
||||
(if (and (> (length form) 3)
|
||||
;; even no. of keyword/value args ?
|
||||
(zerop (logand (length form) 1)))
|
||||
(evenp (length form)))
|
||||
(elint-env-add-global-var (elint-form (nth 2 form) env)
|
||||
(car (cdr form)))
|
||||
(elint-error "Malformed variable declaration: %s" form)
|
||||
|
|
|
|||
|
|
@ -395,11 +395,11 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
|
|||
;; we are recording times
|
||||
(let (enter-time)
|
||||
;; increment the call-counter
|
||||
(cl-incf (aref info 0))
|
||||
(incf (aref info 0))
|
||||
(setq enter-time (current-time)
|
||||
result (apply func args))
|
||||
;; calculate total time in function
|
||||
(cl-incf (aref info 1) (elp-elapsed-time enter-time nil))
|
||||
(incf (aref info 1) (elp-elapsed-time enter-time nil))
|
||||
))
|
||||
;; turn off recording if this is the master function
|
||||
(if (and elp-master
|
||||
|
|
|
|||
|
|
@ -140,7 +140,7 @@ BODY."
|
|||
(maphash (lambda (buffer _dummy)
|
||||
(when (or (not (buffer-live-p buffer))
|
||||
(kill-buffer buffer))
|
||||
(cl-incf count)))
|
||||
(incf count)))
|
||||
ert--test-buffers)
|
||||
(message "%s out of %s test buffers killed"
|
||||
count (hash-table-count ert--test-buffers)))
|
||||
|
|
@ -260,7 +260,7 @@ structure with the plists in ARGS."
|
|||
(string (let ((begin (point)))
|
||||
(insert x)
|
||||
(set-text-properties begin (point) current-plist)))
|
||||
(list (unless (zerop (mod (length x) 2))
|
||||
(list (unless (evenp (length x))
|
||||
(error "Odd number of args in plist: %S" x))
|
||||
(setq current-plist x))))
|
||||
(buffer-string)))
|
||||
|
|
|
|||
|
|
@ -576,7 +576,7 @@ Return nil if they are."
|
|||
|
||||
(defun ert--significant-plist-keys (plist)
|
||||
"Return the keys of PLIST that have non-null values, in order."
|
||||
(cl-assert (zerop (mod (length plist) 2)) t)
|
||||
(cl-assert (evenp (length plist)) t)
|
||||
(cl-loop for (key value . rest) on plist by #'cddr
|
||||
unless (or (null value) (memq key accu)) collect key into accu
|
||||
finally (cl-return accu)))
|
||||
|
|
@ -587,8 +587,8 @@ Return nil if they are."
|
|||
Returns nil if they are equivalent, i.e., have the same value for
|
||||
each key, where absent values are treated as nil. The order of
|
||||
key/value pairs in each list does not matter."
|
||||
(cl-assert (zerop (mod (length a) 2)) t)
|
||||
(cl-assert (zerop (mod (length b) 2)) t)
|
||||
(cl-assert (evenp (length a)) t)
|
||||
(cl-assert (evenp (length b)) t)
|
||||
;; Normalizing the plists would be another way to do this but it
|
||||
;; requires a total ordering on all lisp objects (since any object
|
||||
;; is valid as a text property key). Perhaps defining such an
|
||||
|
|
@ -1159,21 +1159,21 @@ Also changes the counters in STATS to match."
|
|||
(aref results pos))
|
||||
(cl-etypecase (aref results pos)
|
||||
(ert-test-passed
|
||||
(cl-incf (ert--stats-passed-expected stats) d))
|
||||
(incf (ert--stats-passed-expected stats) d))
|
||||
(ert-test-failed
|
||||
(cl-incf (ert--stats-failed-expected stats) d))
|
||||
(incf (ert--stats-failed-expected stats) d))
|
||||
(ert-test-skipped
|
||||
(cl-incf (ert--stats-skipped stats) d))
|
||||
(incf (ert--stats-skipped stats) d))
|
||||
(null)
|
||||
(ert-test-aborted-with-non-local-exit)
|
||||
(ert-test-quit))
|
||||
(cl-etypecase (aref results pos)
|
||||
(ert-test-passed
|
||||
(cl-incf (ert--stats-passed-unexpected stats) d))
|
||||
(incf (ert--stats-passed-unexpected stats) d))
|
||||
(ert-test-failed
|
||||
(cl-incf (ert--stats-failed-unexpected stats) d))
|
||||
(incf (ert--stats-failed-unexpected stats) d))
|
||||
(ert-test-skipped
|
||||
(cl-incf (ert--stats-skipped stats) d))
|
||||
(incf (ert--stats-skipped stats) d))
|
||||
(null)
|
||||
(ert-test-aborted-with-non-local-exit)
|
||||
(ert-test-quit)))))
|
||||
|
|
@ -1419,7 +1419,7 @@ Returns the stats object."
|
|||
(message "%9s %S%s"
|
||||
(ert-string-for-test-result result nil)
|
||||
(ert-test-name test)
|
||||
(if (cl-plusp
|
||||
(if (plusp
|
||||
(length (getenv "EMACS_TEST_VERBOSE")))
|
||||
(ert-reason-for-test-result result)
|
||||
""))))
|
||||
|
|
@ -1432,7 +1432,7 @@ Returns the stats object."
|
|||
(message "%9s %S%s"
|
||||
(ert-string-for-test-result result nil)
|
||||
(ert-test-name test)
|
||||
(if (cl-plusp
|
||||
(if (plusp
|
||||
(length (getenv "EMACS_TEST_VERBOSE")))
|
||||
(ert-reason-for-test-result result)
|
||||
""))))
|
||||
|
|
@ -1684,8 +1684,8 @@ test packages depend on each other, it might be helpful.")
|
|||
(insert " </error>\n"
|
||||
" </testcase>\n"
|
||||
" </testsuite>\n")
|
||||
(cl-incf errors 1)
|
||||
(cl-incf id 1)))
|
||||
(incf errors 1)
|
||||
(incf id 1)))
|
||||
|
||||
(insert-file-contents-literally test-report)
|
||||
(when (looking-at-p
|
||||
|
|
@ -1693,15 +1693,15 @@ test packages depend on each other, it might be helpful.")
|
|||
(delete-region (point) (line-beginning-position 2)))
|
||||
(when (looking-at
|
||||
"<testsuites name=\".+\" tests=\"\\(.+\\)\" errors=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">")
|
||||
(cl-incf tests (string-to-number (match-string 1)))
|
||||
(cl-incf errors (string-to-number (match-string 2)))
|
||||
(cl-incf failures (string-to-number (match-string 3)))
|
||||
(cl-incf skipped (string-to-number (match-string 4)))
|
||||
(cl-incf time (string-to-number (match-string 5)))
|
||||
(incf tests (string-to-number (match-string 1)))
|
||||
(incf errors (string-to-number (match-string 2)))
|
||||
(incf failures (string-to-number (match-string 3)))
|
||||
(incf skipped (string-to-number (match-string 4)))
|
||||
(incf time (string-to-number (match-string 5)))
|
||||
(delete-region (point) (line-beginning-position 2)))
|
||||
(when (looking-at " <testsuite id=\"\\(0\\)\"")
|
||||
(replace-match (number-to-string id) nil nil nil 1)
|
||||
(cl-incf id 1))
|
||||
(incf id 1))
|
||||
(goto-char (point-max))
|
||||
(beginning-of-line 0)
|
||||
(when (looking-at-p "</testsuites>")
|
||||
|
|
@ -2123,7 +2123,7 @@ non-nil, returns the face for expected results.."
|
|||
(defun ert-face-for-stats (stats)
|
||||
"Return a face that represents STATS."
|
||||
(cond ((ert--stats-aborted-p stats) 'nil)
|
||||
((cl-plusp (ert-stats-completed-unexpected stats))
|
||||
((plusp (ert-stats-completed-unexpected stats))
|
||||
(ert-face-for-test-result nil))
|
||||
((eql (ert-stats-completed-expected stats) (ert-stats-total stats))
|
||||
(ert-face-for-test-result t))
|
||||
|
|
|
|||
|
|
@ -25,7 +25,6 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
;; Provide an easy hook to tell if we are running with floats or not.
|
||||
;; Define pi and e via math-lib calls (much less prone to killer typos).
|
||||
(defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).")
|
||||
(with-suppressed-warnings ((lexical pi))
|
||||
|
|
|
|||
|
|
@ -294,7 +294,7 @@ The return value is the last VAL in the list.
|
|||
|
||||
\(fn PLACE VAL PLACE VAL ...)"
|
||||
(declare (debug (&rest [gv-place form])))
|
||||
(if (/= (logand (length args) 1) 0)
|
||||
(if (oddp (length args))
|
||||
(signal 'wrong-number-of-arguments (list 'setf (length args))))
|
||||
(if (and args (null (cddr args)))
|
||||
(let ((place (pop args))
|
||||
|
|
@ -315,17 +315,29 @@ The return value is the last VAL in the list.
|
|||
;; `(if (member ,v ,getter) nil
|
||||
;; ,(funcall setter `(cons ,v ,getter))))))
|
||||
|
||||
;; (defmacro gv-inc! (place &optional val)
|
||||
;; "Increment PLACE by VAL (default to 1)."
|
||||
;; (declare (debug (gv-place &optional form)))
|
||||
;; (gv-letplace (getter setter) place
|
||||
;; (funcall setter `(+ ,getter ,(or val 1)))))
|
||||
;;;###autoload
|
||||
(defmacro incf (place &optional delta)
|
||||
"Increment PLACE by DELTA (default to 1).
|
||||
|
||||
;; (defmacro gv-dec! (place &optional val)
|
||||
;; "Decrement PLACE by VAL (default to 1)."
|
||||
;; (declare (debug (gv-place &optional form)))
|
||||
;; (gv-letplace (getter setter) place
|
||||
;; (funcall setter `(- ,getter ,(or val 1)))))
|
||||
The DELTA is first added to PLACE, and then stored in PLACE.
|
||||
Return the incremented value of PLACE.
|
||||
|
||||
See also `decf'."
|
||||
(declare (debug (gv-place &optional form)))
|
||||
(gv-letplace (getter setter) place
|
||||
(funcall setter `(+ ,getter ,(or delta 1)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro decf (place &optional delta)
|
||||
"Decrement PLACE by DELTA (default to 1).
|
||||
|
||||
The DELTA is first subtracted from PLACE, and then stored in PLACE.
|
||||
Return the decremented value of PLACE.
|
||||
|
||||
See also `incf'."
|
||||
(declare (debug (gv-place &optional form)))
|
||||
(gv-letplace (getter setter) place
|
||||
(funcall setter `(- ,getter ,(or delta 1)))))
|
||||
|
||||
;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
|
||||
;; for normal expressions, and then give it a gv-expander to DTRT.
|
||||
|
|
|
|||
|
|
@ -80,7 +80,7 @@
|
|||
(recenter))
|
||||
((and (or (eq continue 'backspace)
|
||||
(eq continue ?\177))
|
||||
(zerop (% state 2)))
|
||||
(evenp state))
|
||||
(scroll-down))
|
||||
(t (setq continue nil))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -435,7 +435,7 @@ Assumes the caller has bound `macroexpand-all-environment'."
|
|||
;; Malformed code is translated to code that signals an error
|
||||
;; at run time.
|
||||
(let ((nargs (length args)))
|
||||
(if (/= (logand nargs 1) 0)
|
||||
(if (oddp nargs)
|
||||
(macroexp-warn-and-return
|
||||
(format-message "odd number of arguments in `setq' form")
|
||||
`(signal 'wrong-number-of-arguments '(setq ,nargs))
|
||||
|
|
|
|||
|
|
@ -168,7 +168,7 @@ by counted more than once."
|
|||
(total 0))
|
||||
(mapatoms
|
||||
(lambda (symbol)
|
||||
(cl-incf total (memory-report--object-size
|
||||
(incf total (memory-report--object-size
|
||||
counted (symbol-plist symbol))))
|
||||
obarray)
|
||||
(list
|
||||
|
|
@ -217,16 +217,16 @@ by counted more than once."
|
|||
(let ((total 0)
|
||||
(size (memory-report--size 'cons)))
|
||||
(while value
|
||||
(cl-incf total size)
|
||||
(incf total size)
|
||||
(setf (gethash value counted) t)
|
||||
(when (car value)
|
||||
(cl-incf total (memory-report--object-size counted (car value))))
|
||||
(incf total (memory-report--object-size counted (car value))))
|
||||
(let ((next (cdr value)))
|
||||
(setq value (when next
|
||||
(if (consp next)
|
||||
(unless (gethash next counted)
|
||||
(cdr value))
|
||||
(cl-incf total (memory-report--object-size
|
||||
(incf total (memory-report--object-size
|
||||
counted next))
|
||||
nil)))))
|
||||
total))
|
||||
|
|
@ -235,7 +235,7 @@ by counted more than once."
|
|||
(let ((total (+ (memory-report--size 'vector)
|
||||
(* (memory-report--size 'object) (length value)))))
|
||||
(cl-loop for elem across value
|
||||
do (cl-incf total (memory-report--object-size counted elem)))
|
||||
do (incf total (memory-report--object-size counted elem)))
|
||||
total))
|
||||
|
||||
(cl-defmethod memory-report--object-size-1 (counted (value hash-table))
|
||||
|
|
@ -243,8 +243,8 @@ by counted more than once."
|
|||
(* (memory-report--size 'object) (hash-table-size value)))))
|
||||
(maphash
|
||||
(lambda (key elem)
|
||||
(cl-incf total (memory-report--object-size counted key))
|
||||
(cl-incf total (memory-report--object-size counted elem)))
|
||||
(incf total (memory-report--object-size counted key))
|
||||
(incf total (memory-report--object-size counted elem)))
|
||||
value)
|
||||
total))
|
||||
|
||||
|
|
|
|||
|
|
@ -125,7 +125,7 @@
|
|||
(it (make-hash-table :test #'eq)))
|
||||
(dolist (desc slotdescs)
|
||||
(let* ((slot (cl--slot-descriptor-name desc)))
|
||||
(cl-incf i)
|
||||
(incf i)
|
||||
(when (gethash slot it)
|
||||
(error "Duplicate slot name: %S" slot))
|
||||
(setf (gethash slot it) i)))
|
||||
|
|
@ -305,7 +305,7 @@ list of slot properties. The currently known properties are the following:
|
|||
;; Always use a double hyphen: if users wants to
|
||||
;; make it public, they can do so with an alias.
|
||||
(aname (intern (format "%S--%S" name slot))))
|
||||
(cl-incf i)
|
||||
(incf i)
|
||||
(if (not mutable)
|
||||
`(defalias ',aname
|
||||
;; We use `oclosure--copy' instead of
|
||||
|
|
|
|||
|
|
@ -271,7 +271,11 @@ asynchronously."
|
|||
(defun package-vc--generate-description-file (pkg-desc pkg-file)
|
||||
"Generate a package description file for PKG-DESC and write it to PKG-FILE."
|
||||
(let ((name (package-desc-name pkg-desc)))
|
||||
;; Infer the subject if missing.
|
||||
(when (equal (package-desc-summary pkg-desc) package--default-summary)
|
||||
;; We unset the package description if it is just the default
|
||||
;; summary, so that the following heuristic can take effect.
|
||||
(setf (package-desc-summary pkg-desc) nil))
|
||||
;; Infer the package description if missing.
|
||||
(unless (package-desc-summary pkg-desc)
|
||||
(setf (package-desc-summary pkg-desc)
|
||||
(let ((main-file (package-vc--main-file pkg-desc)))
|
||||
|
|
@ -413,7 +417,7 @@ this function successfully installs all given dependencies)."
|
|||
"Attempt to find all dependencies for PKG."
|
||||
(cond
|
||||
((assq (car pkg) to-install)) ;inhibit cycles
|
||||
((package-installed-p (car pkg)))
|
||||
((package-installed-p (car pkg) (cadr pkg)))
|
||||
((let* ((pac package-archive-contents)
|
||||
(desc (cadr (assoc (car pkg) pac))))
|
||||
(if desc
|
||||
|
|
|
|||
|
|
@ -2665,7 +2665,7 @@ in a clean environment."
|
|||
(list
|
||||
(cl-loop for c in
|
||||
(completing-read-multiple
|
||||
"Packages to isolate, as comma-separated list: " table
|
||||
"Packages to isolate: " table
|
||||
nil t)
|
||||
collect (alist-get c table nil nil #'string=))
|
||||
current-prefix-arg)))
|
||||
|
|
@ -3982,7 +3982,7 @@ Return nil if there were no errors; non-nil otherwise."
|
|||
(package-menu--transaction-status))
|
||||
(dolist (pkg install-list)
|
||||
(setq package-menu--transaction-status
|
||||
(format status-format (cl-incf i)))
|
||||
(format status-format (incf i)))
|
||||
(force-mode-line-update)
|
||||
(redisplay 'force)
|
||||
;; Don't mark as selected, `package-menu-execute' already
|
||||
|
|
@ -4289,7 +4289,7 @@ string, show all packages.
|
|||
When called interactively, prompt for ARCHIVE. To specify
|
||||
several archives, type their names separated by commas."
|
||||
(interactive (list (completing-read-multiple
|
||||
"Filter by archive (comma separated): "
|
||||
"Filter by archive: "
|
||||
(mapcar #'car package-archives)))
|
||||
package-menu-mode)
|
||||
(package--ensure-package-menu-mode)
|
||||
|
|
@ -4333,7 +4333,7 @@ or \"built-in\" or \"obsolete\".
|
|||
When called interactively, prompt for KEYWORD. To specify several
|
||||
keywords, type them separated by commas."
|
||||
(interactive (list (completing-read-multiple
|
||||
"Keywords (comma separated): "
|
||||
"Keywords: "
|
||||
(package-all-keywords)))
|
||||
package-menu-mode)
|
||||
(package--ensure-package-menu-mode)
|
||||
|
|
@ -4525,7 +4525,7 @@ of an installed ELPA package.
|
|||
The return value is a string (or nil in case we can't find it).
|
||||
It works in more cases if the call is in the file which contains
|
||||
the `Version:' header."
|
||||
;; In a sense, this is a lie, but it does just what we want: precompute
|
||||
;; In a sense, this is a lie, but it does just what we want: precomputes
|
||||
;; the version at compile time and hardcodes it into the .elc file!
|
||||
(declare (pure t))
|
||||
;; Hack alert!
|
||||
|
|
|
|||
|
|
@ -370,7 +370,7 @@ undetected, binding variables to arbitrary values, such as nil.
|
|||
(cond
|
||||
(args
|
||||
(let ((arg-length (length args)))
|
||||
(unless (= 0 (mod arg-length 2))
|
||||
(unless (evenp arg-length)
|
||||
(signal 'wrong-number-of-arguments
|
||||
(list 'pcase-setq (+ 2 arg-length)))))
|
||||
(let ((result))
|
||||
|
|
|
|||
|
|
@ -577,7 +577,7 @@ the bounds of a region containing Lisp code to pretty-print."
|
|||
(insert ")")))
|
||||
|
||||
(defun pp--format-definition (sexp indent edebug)
|
||||
(while (and (cl-plusp indent)
|
||||
(while (and (plusp indent)
|
||||
sexp)
|
||||
(insert " ")
|
||||
;; We don't understand all the edebug specs.
|
||||
|
|
@ -592,7 +592,7 @@ the bounds of a region containing Lisp code to pretty-print."
|
|||
(pp--insert-lisp (car sexp)))
|
||||
(pop sexp))
|
||||
(pop edebug)
|
||||
(cl-decf indent))
|
||||
(decf indent))
|
||||
(when (stringp (car sexp))
|
||||
(insert "\n")
|
||||
(prin1 (pop sexp) (current-buffer)))
|
||||
|
|
|
|||
|
|
@ -1072,7 +1072,7 @@ Return (REGEXP . PRECEDENCE)."
|
|||
"Expand `eval' arguments. Return a new rx form."
|
||||
(unless (and body (null (cdr body)))
|
||||
(error "rx `eval' form takes exactly one argument"))
|
||||
(eval (car body)))
|
||||
(eval (car body) lexical-binding))
|
||||
|
||||
(defun rx--translate-eval (body)
|
||||
"Translate the `eval' form. Return (REGEXP . PRECEDENCE)."
|
||||
|
|
|
|||
|
|
@ -278,17 +278,17 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
|
|||
:args (function map)
|
||||
:eval (map-values-apply #'1+ (list '(1 . 2) '(3 . 4))))
|
||||
(map-filter
|
||||
:eval (map-filter (lambda (k _) (cl-oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-filter (lambda (k v) (cl-evenp (+ k v))) (list '(1 . 2) '(4 . 6))))
|
||||
:eval (map-filter (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-filter (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6))))
|
||||
(map-remove
|
||||
:eval (map-remove (lambda (k _) (cl-oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-remove (lambda (k v) (cl-evenp (+ k v))) (list '(1 . 2) '(4 . 6))))
|
||||
:eval (map-remove (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-remove (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6))))
|
||||
(map-some
|
||||
:eval (map-some (lambda (k _) (cl-oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-some (lambda (k v) (cl-evenp (+ k v))) (list '(1 . 2) '(4 . 6))))
|
||||
:eval (map-some (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-some (lambda (k v) (evenp (+ k v))) (list '(1 . 2) '(4 . 6))))
|
||||
(map-every-p
|
||||
:eval (map-every-p (lambda (k _) (cl-oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-every-p (lambda (k v) (cl-evenp (+ k v))) (list '(1 . 3) '(4 . 6))))
|
||||
:eval (map-every-p (lambda (k _) (oddp k)) (list '(1 . 2) '(4 . 6)))
|
||||
:eval (map-every-p (lambda (k v) (evenp (+ k v))) (list '(1 . 3) '(4 . 6))))
|
||||
"Combining and changing maps"
|
||||
(map-merge
|
||||
:eval (map-merge 'alist '(1 2 3 4) #s(hash-table data (5 6 7 8)))
|
||||
|
|
@ -1375,9 +1375,17 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
|
|||
:eval (mod 10 6)
|
||||
:eval (mod 10.5 6))
|
||||
(1+
|
||||
:eval (1+ 2))
|
||||
:eval (1+ 2)
|
||||
:eval (let ((x 2)) (1+ x) x))
|
||||
(1-
|
||||
:eval (1- 4))
|
||||
:eval (1- 4)
|
||||
:eval (let ((x 4)) (1- x) x))
|
||||
(incf
|
||||
:eval (let ((x 2)) (incf x) x)
|
||||
:eval (let ((x 2)) (incf x 2) x))
|
||||
(decf
|
||||
:eval (let ((x 4)) (decf x) x)
|
||||
:eval (let ((x 4)) (decf x 2)) x)
|
||||
"Predicates"
|
||||
(=
|
||||
:args (number &rest numbers)
|
||||
|
|
@ -1412,16 +1420,16 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
|
|||
:eval (natnump -1)
|
||||
:eval (natnump 0)
|
||||
:eval (natnump 23))
|
||||
(cl-plusp
|
||||
:eval (cl-plusp 0)
|
||||
:eval (cl-plusp 1))
|
||||
(cl-minusp
|
||||
:eval (cl-minusp 0)
|
||||
:eval (cl-minusp -1))
|
||||
(cl-oddp
|
||||
:eval (cl-oddp 3))
|
||||
(cl-evenp
|
||||
:eval (cl-evenp 6))
|
||||
(plusp
|
||||
:eval (plusp 0)
|
||||
:eval (plusp 1))
|
||||
(minusp
|
||||
:eval (minusp 0)
|
||||
:eval (minusp -1))
|
||||
(oddp
|
||||
:eval (oddp 3))
|
||||
(evenp
|
||||
:eval (evenp 6))
|
||||
(bignump
|
||||
:eval (bignump 4)
|
||||
:eval (bignump (expt 2 90)))
|
||||
|
|
|
|||
|
|
@ -176,7 +176,7 @@
|
|||
;; don't hide real conflicts.
|
||||
(puthash key (gethash key override) table)
|
||||
(display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))
|
||||
(cl-incf smie-warning-count))
|
||||
(incf smie-warning-count))
|
||||
(puthash key val table))))
|
||||
|
||||
(defun smie-precs->prec2 (precs)
|
||||
|
|
@ -585,13 +585,13 @@ PREC2 is a table as returned by `smie-precs->prec2' or
|
|||
(unless (caar cst)
|
||||
(setcar (car cst) i)
|
||||
;; (smie-check-grammar table prec2 'step1)
|
||||
(cl-incf i))
|
||||
(incf i))
|
||||
(setq csts (delq cst csts))))
|
||||
(unless progress
|
||||
(error "Can't resolve the precedence cycle: %s"
|
||||
(smie-debug--describe-cycle
|
||||
table (smie-debug--prec2-cycle csts)))))
|
||||
(cl-incf i 10))
|
||||
(incf i 10))
|
||||
;; Propagate equality constraints back to their sources.
|
||||
(dolist (eq (nreverse eqs))
|
||||
(when (null (cadr eq))
|
||||
|
|
@ -602,7 +602,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or
|
|||
;; So set it here rather than below since doing it below
|
||||
;; makes it more difficult to obey the equality constraints.
|
||||
(setcar (cdr eq) i)
|
||||
(cl-incf i))
|
||||
(incf i))
|
||||
(cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
|
||||
(setcar (car eq) (cadr eq))
|
||||
;; (smie-check-grammar table prec2 'step2)
|
||||
|
|
@ -612,10 +612,10 @@ PREC2 is a table as returned by `smie-precs->prec2' or
|
|||
(dolist (x table)
|
||||
(unless (nth 1 x)
|
||||
(setf (nth 1 x) i)
|
||||
(cl-incf i)) ;See other (cl-incf i) above.
|
||||
(incf i)) ;See other (incf i) above.
|
||||
(unless (nth 2 x)
|
||||
(setf (nth 2 x) i)
|
||||
(cl-incf i)))) ;See other (cl-incf i) above.
|
||||
(incf i)))) ;See other (incf i) above.
|
||||
;; Mark closers and openers.
|
||||
(dolist (x (gethash :smie-open/close-alist prec2))
|
||||
(let* ((token (car x))
|
||||
|
|
@ -2157,7 +2157,7 @@ position corresponding to each rule."
|
|||
(trace (mapcar #'cdr (cdr itrace)))
|
||||
(cur (current-indentation)))
|
||||
(when (numberp nindent) ;Skip `noindent' and friends.
|
||||
(cl-incf (gethash (cons (- cur nindent) trace) otraces 0)))))
|
||||
(incf (gethash (cons (- cur nindent) trace) otraces 0)))))
|
||||
(forward-line 1)))
|
||||
(progress-reporter-done pr)
|
||||
|
||||
|
|
@ -2193,14 +2193,14 @@ position corresponding to each rule."
|
|||
(let ((data (list 0 nil nil)))
|
||||
(puthash sig data sigs)
|
||||
data))))
|
||||
(cl-incf (nth 0 sig-data) count)
|
||||
(incf (nth 0 sig-data) count)
|
||||
(push (cons count otrace) (nth 2 sig-data))
|
||||
(let ((sig-off-data
|
||||
(or (assq offset (nth 1 sig-data))
|
||||
(let ((off-data (cons offset 0)))
|
||||
(push off-data (nth 1 sig-data))
|
||||
off-data))))
|
||||
(cl-incf (cdr sig-off-data) count))))))))
|
||||
(incf (cdr sig-off-data) count))))))))
|
||||
otraces)
|
||||
|
||||
;; Finally, guess the indentation rules.
|
||||
|
|
@ -2240,8 +2240,8 @@ position corresponding to each rule."
|
|||
(push off-data (nth 1 sig-data))
|
||||
off-data))))
|
||||
(cl-assert (>= (cdr ooff-data) count))
|
||||
(cl-decf (cdr ooff-data) count)
|
||||
(cl-incf (cdr noff-data) count))))))))))
|
||||
(decf (cdr ooff-data) count)
|
||||
(incf (cdr noff-data) count))))))))))
|
||||
rules))
|
||||
|
||||
(defun smie-config-guess ()
|
||||
|
|
|
|||
|
|
@ -276,7 +276,7 @@ all RULES in total."
|
|||
;; If there's more than 1 rule, and the rule want to apply
|
||||
;; highlight to match 0, create an extra group to be able to
|
||||
;; tell when *this* match 0 has succeeded.
|
||||
(cl-incf offset)
|
||||
(incf offset)
|
||||
(setq re (concat "\\(" re "\\)")))
|
||||
(setq re (syntax-propertize--shift-groups-and-backrefs re offset))
|
||||
(let ((code '())
|
||||
|
|
@ -356,7 +356,7 @@ all RULES in total."
|
|||
code))))
|
||||
(push (cons condition (nreverse code))
|
||||
branches))
|
||||
(cl-incf offset (regexp-opt-depth orig-re))
|
||||
(incf offset (regexp-opt-depth orig-re))
|
||||
re))
|
||||
rules
|
||||
"\\|")))
|
||||
|
|
@ -586,8 +586,8 @@ The rest is only useful if you're interested in tweaking the algorithm.")
|
|||
syntax-ppss-stats))
|
||||
(defun syntax-ppss--update-stats (i old new)
|
||||
(let ((pair (aref syntax-ppss-stats i)))
|
||||
(cl-incf (car pair))
|
||||
(cl-incf (cdr pair) (- new old))))
|
||||
(incf (car pair))
|
||||
(incf (cdr pair) (- new old))))
|
||||
|
||||
(defun syntax-ppss--data ()
|
||||
(if (eq (point-min) 1)
|
||||
|
|
|
|||
|
|
@ -594,14 +594,14 @@ Details logged to `track-changes--error-log'")
|
|||
(track-changes--trace)
|
||||
(cl-assert track-changes--state)
|
||||
(let ((offset (- (- end beg) len)))
|
||||
(cl-incf track-changes--buffer-size offset)
|
||||
(incf track-changes--buffer-size offset)
|
||||
(if (and (eq track-changes--before-clean 'unset)
|
||||
(not track-changes--before-no))
|
||||
;; This can be a sign that a `before-change-functions' went missing,
|
||||
;; or that we called `track-changes--clean-state' between
|
||||
;; a `before-change-functions' and `after-change-functions'.
|
||||
(track-changes--before beg end)
|
||||
(cl-incf track-changes--before-end offset))
|
||||
(incf track-changes--before-end offset))
|
||||
(setq track-changes--before-clean nil)
|
||||
(if (not (or track-changes--before-no
|
||||
(save-restriction
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue