mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-28 19:42:02 +00:00
Miscellaneous tweaks.
* lisp/emacs-lisp/cl-macs.el (dolist, dotimes): Use the same strategy for lexical scoping as in subr.el's dolist and dotimes. * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Silence compiler warning. * lisp/thingatpt.el (forward-whitespace): Trivial coding style fix. * lisp/subr.el (with-output-to-temp-buffer): Provide an edebug spec. * lisp/international/ccl.el (ccl-compile): Trivial simplification. * lisp/help-fns.el (help-do-arg-highlight): Silence compiler warning. * lisp/emacs-lisp/testcover.el (testcover-end): Remove spurious `printflag' argument. * lisp/emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable): Purecopy the whole obsolescence data.
This commit is contained in:
Stefan Monnier
parent
18613c7e90
commit
2462470b9e
@ -1,3 +1,19 @@
|
||||
2011-06-01 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Miscellaneous tweaks.
|
||||
* emacs-lisp/cl-macs.el (dolist, dotimes): Use the same strategy for
|
||||
lexical scoping as in subr.el's dolist and dotimes.
|
||||
* emacs-lisp/bytecomp.el (byte-compile-unfold-bcf):
|
||||
Silence compiler warning.
|
||||
* thingatpt.el (forward-whitespace): Trivial coding style fix.
|
||||
* subr.el (with-output-to-temp-buffer): Provide an edebug spec.
|
||||
* international/ccl.el (ccl-compile): Trivial simplification.
|
||||
* help-fns.el (help-do-arg-highlight): Silence compiler warning.
|
||||
* emacs-lisp/testcover.el (testcover-end): Remove spurious
|
||||
`printflag' argument.
|
||||
* emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable):
|
||||
Purecopy the whole obsolescence data.
|
||||
|
||||
2011-06-01 Leo Liu <sdl.web@gmail.com>
|
||||
|
||||
* net/rcirc.el (rcirc-decode-coding-system): Revert last change;
|
||||
|
||||
@ -120,13 +120,13 @@ convention was modified."
|
||||
The warning will say that CURRENT-NAME should be used instead.
|
||||
If CURRENT-NAME is a string, that is the `use instead' message
|
||||
\(it should end with a period, and not start with a capital).
|
||||
If provided, WHEN should be a string indicating when the function
|
||||
WHEN should be a string indicating when the function
|
||||
was first made obsolete, for example a date or a release number."
|
||||
(interactive "aMake function obsolete: \nxObsoletion replacement: ")
|
||||
(put obsolete-name 'byte-obsolete-info
|
||||
;; The second entry used to hold the `byte-compile' handler, but
|
||||
;; is not used any more nowadays.
|
||||
(list (purecopy current-name) nil (purecopy when)))
|
||||
(purecopy (list current-name nil when)))
|
||||
obsolete-name)
|
||||
(set-advertised-calling-convention
|
||||
;; New code should always provide the `when' argument.
|
||||
@ -166,10 +166,7 @@ was first made obsolete, for example a date or a release number."
|
||||
(intern str))
|
||||
(car (read-from-string (read-string "Obsoletion replacement: ")))))
|
||||
(put obsolete-name 'byte-obsolete-variable
|
||||
(cons
|
||||
(if (stringp current-name)
|
||||
(purecopy current-name)
|
||||
current-name) (purecopy when)))
|
||||
(purecopy (cons current-name when)))
|
||||
obsolete-name)
|
||||
(set-advertised-calling-convention
|
||||
;; New code should always provide the `when' argument.
|
||||
|
||||
@ -2991,7 +2991,7 @@ That command is designed for interactive use only" fn))
|
||||
(cond
|
||||
((<= (+ alen alen) fmax2)
|
||||
;; Add missing &optional (or &rest) arguments.
|
||||
(dotimes (i (- (/ (1+ fmax2) 2) alen))
|
||||
(dotimes (_ (- (/ (1+ fmax2) 2) alen))
|
||||
(byte-compile-push-constant nil)))
|
||||
((zerop (logand fmax2 1))
|
||||
(byte-compile-log-warning "Too many arguments for inlined function"
|
||||
|
||||
@ -112,16 +112,6 @@
|
||||
;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
|
||||
;; binders)))
|
||||
|
||||
;; (defmacro letrec (binders &rest body)
|
||||
;; ;; Only useful in lexical-binding mode.
|
||||
;; ;; As a special-form, we could implement it more efficiently (and cleanly,
|
||||
;; ;; making the vars actually unbound during evaluation of the binders).
|
||||
;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
|
||||
;; binders)
|
||||
;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder)))
|
||||
;; binders))
|
||||
;; ,@body))
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defconst cconv-liftwhen 6
|
||||
|
||||
@ -1236,14 +1236,29 @@ Then evaluate RESULT to get return value, default nil.
|
||||
|
||||
\(fn (VAR LIST [RESULT]) BODY...)"
|
||||
(let ((temp (make-symbol "--cl-dolist-temp--")))
|
||||
(list 'block nil
|
||||
(list* 'let (list (list temp (nth 1 spec)) (car spec))
|
||||
(list* 'while temp (list 'setq (car spec) (list 'car temp))
|
||||
(append body (list (list 'setq temp
|
||||
(list 'cdr temp)))))
|
||||
(if (cdr (cdr spec))
|
||||
(cons (list 'setq (car spec) nil) (cdr (cdr spec)))
|
||||
'(nil))))))
|
||||
;; FIXME: Copy&pasted from subr.el.
|
||||
`(block nil
|
||||
;; This is not a reliable test, but it does not matter because both
|
||||
;; semantics are acceptable, tho one is slightly faster with dynamic
|
||||
;; scoping and the other is slightly faster (and has cleaner semantics)
|
||||
;; with lexical scoping.
|
||||
,(if lexical-binding
|
||||
`(let ((,temp ,(nth 1 spec)))
|
||||
(while ,temp
|
||||
(let ((,(car spec) (car ,temp)))
|
||||
,@body
|
||||
(setq ,temp (cdr ,temp))))
|
||||
,@(if (cdr (cdr spec))
|
||||
;; FIXME: This let often leads to "unused var" warnings.
|
||||
`((let ((,(car spec) nil)) ,@(cdr (cdr spec))))))
|
||||
`(let ((,temp ,(nth 1 spec))
|
||||
,(car spec))
|
||||
(while ,temp
|
||||
(setq ,(car spec) (car ,temp))
|
||||
,@body
|
||||
(setq ,temp (cdr ,temp)))
|
||||
,@(if (cdr (cdr spec))
|
||||
`((setq ,(car spec) nil) ,@(cddr spec))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro dotimes (spec &rest body)
|
||||
@ -1253,12 +1268,30 @@ to COUNT, exclusive. Then evaluate RESULT to get return value, default
|
||||
nil.
|
||||
|
||||
\(fn (VAR COUNT [RESULT]) BODY...)"
|
||||
(let ((temp (make-symbol "--cl-dotimes-temp--")))
|
||||
(list 'block nil
|
||||
(list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
|
||||
(list* 'while (list '< (car spec) temp)
|
||||
(append body (list (list 'incf (car spec)))))
|
||||
(or (cdr (cdr spec)) '(nil))))))
|
||||
(let ((temp (make-symbol "--cl-dotimes-temp--"))
|
||||
(end (nth 1 spec)))
|
||||
;; FIXME: Copy&pasted from subr.el.
|
||||
`(block nil
|
||||
;; This is not a reliable test, but it does not matter because both
|
||||
;; semantics are acceptable, tho one is slightly faster with dynamic
|
||||
;; scoping and the other has cleaner semantics.
|
||||
,(if lexical-binding
|
||||
(let ((counter '--dotimes-counter--))
|
||||
`(let ((,temp ,end)
|
||||
(,counter 0))
|
||||
(while (< ,counter ,temp)
|
||||
(let ((,(car spec) ,counter))
|
||||
,@body)
|
||||
(setq ,counter (1+ ,counter)))
|
||||
,@(if (cddr spec)
|
||||
;; FIXME: This let often leads to "unused var" warnings.
|
||||
`((let ((,(car spec) ,counter)) ,@(cddr spec))))))
|
||||
`(let ((,temp ,end)
|
||||
(,(car spec) 0))
|
||||
(while (< ,(car spec) ,temp)
|
||||
,@body
|
||||
(incf ,(car spec)))
|
||||
,@(cdr (cdr spec)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro do-symbols (spec &rest body)
|
||||
|
||||
@ -430,7 +430,7 @@ FUN should be `testcover-reinstrument' for compositional functions,
|
||||
"Turn off instrumentation of all macros and functions in FILENAME."
|
||||
(interactive "fStop covering file: ")
|
||||
(let ((buf (find-file-noselect filename)))
|
||||
(eval-buffer buf t)))
|
||||
(eval-buffer buf)))
|
||||
|
||||
|
||||
;;;=========================================================================
|
||||
|
||||
@ -222,7 +222,7 @@ if the variable `help-downcase-arguments' is non-nil."
|
||||
(defun help-do-arg-highlight (doc args)
|
||||
(with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
|
||||
(modify-syntax-entry ?\- "w")
|
||||
(dolist (arg args doc)
|
||||
(dolist (arg args)
|
||||
(setq doc (replace-regexp-in-string
|
||||
;; This is heuristic, but covers all common cases
|
||||
;; except ARG1-ARG2
|
||||
@ -236,7 +236,8 @@ if the variable `help-downcase-arguments' is non-nil."
|
||||
"\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
|
||||
"\\>") ; end of word
|
||||
(help-highlight-arg arg)
|
||||
doc t t 1)))))
|
||||
doc t t 1)))
|
||||
doc))
|
||||
|
||||
(defun help-highlight-arguments (usage doc &rest args)
|
||||
(when (and usage (string-match "^(" usage))
|
||||
|
||||
@ -280,10 +280,10 @@ the current loop.")
|
||||
;;;###autoload
|
||||
(defun ccl-compile (ccl-program)
|
||||
"Return the compiled code of CCL-PROGRAM as a vector of integers."
|
||||
(if (or (null (consp ccl-program))
|
||||
(null (integerp (car ccl-program)))
|
||||
(null (listp (car (cdr ccl-program)))))
|
||||
(error "CCL: Invalid CCL program: %s" ccl-program))
|
||||
(unless (and (consp ccl-program)
|
||||
(integerp (car ccl-program))
|
||||
(listp (car (cdr ccl-program))))
|
||||
(error "CCL: Invalid CCL program: %s" ccl-program))
|
||||
(if (null (vectorp ccl-program-vector))
|
||||
(setq ccl-program-vector (make-vector 8192 0)))
|
||||
(setq ccl-loop-head nil ccl-breaks nil)
|
||||
|
||||
@ -2926,6 +2926,7 @@ with the buffer BUFNAME temporarily current. It runs the hook
|
||||
buffer temporarily current, and the window that was used to display it
|
||||
temporarily selected. But it doesn't run `temp-buffer-show-hook'
|
||||
if it uses `temp-buffer-show-function'."
|
||||
(declare (debug t))
|
||||
(let ((old-dir (make-symbol "old-dir"))
|
||||
(buf (make-symbol "buf")))
|
||||
`(let* ((,old-dir default-directory)
|
||||
|
||||
@ -402,7 +402,7 @@ with angle brackets.")
|
||||
(re-search-forward "[ \t]+\\|\n" nil 'move arg)
|
||||
(while (< arg 0)
|
||||
(if (re-search-backward "[ \t]+\\|\n" nil 'move)
|
||||
(or (eq (char-after (match-beginning 0)) 10)
|
||||
(or (eq (char-after (match-beginning 0)) \n)
|
||||
(skip-chars-backward " \t")))
|
||||
(setq arg (1+ arg)))))
|
||||
|
||||
|
||||
@ -144,7 +144,7 @@ Lisp_Object Qbytecode;
|
||||
#define Bcurrent_column 0151
|
||||
#define Bindent_to 0152
|
||||
#ifdef BYTE_CODE_SAFE
|
||||
#define Bscan_buffer 0153 /* No longer generated as of v18 */
|
||||
#define Bscan_buffer 0153 /* No longer generated as of v18. */
|
||||
#endif
|
||||
#define Beolp 0154
|
||||
#define Beobp 0155
|
||||
@ -956,7 +956,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
save_restriction_save ());
|
||||
break;
|
||||
|
||||
case Bcatch: /* FIXME: ill-suited for lexbind */
|
||||
case Bcatch: /* FIXME: ill-suited for lexbind. */
|
||||
{
|
||||
Lisp_Object v1;
|
||||
BEFORE_POTENTIAL_GC ();
|
||||
@ -966,11 +966,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
break;
|
||||
}
|
||||
|
||||
case Bunwind_protect: /* FIXME: avoid closure for lexbind */
|
||||
case Bunwind_protect: /* FIXME: avoid closure for lexbind. */
|
||||
record_unwind_protect (Fprogn, POP);
|
||||
break;
|
||||
|
||||
case Bcondition_case: /* FIXME: ill-suited for lexbind */
|
||||
case Bcondition_case: /* FIXME: ill-suited for lexbind. */
|
||||
{
|
||||
Lisp_Object handlers, body;
|
||||
handlers = POP;
|
||||
@ -1779,8 +1779,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
|
||||
PUSH (*ptr);
|
||||
break;
|
||||
}
|
||||
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
|
||||
case Bstack_set:
|
||||
/* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */
|
||||
{
|
||||
Lisp_Object *ptr = top - (FETCH);
|
||||
*ptr = POP;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user