Commit 2462470b authored by Stefan Monnier's avatar Stefan Monnier

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.
parent 18613c7e
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;
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment