summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2011-06-01 11:19:45 -0300
committerStefan Monnier <monnier@iro.umontreal.ca>2011-06-01 11:19:45 -0300
commit2462470b9ec3876a54f1ce4c70561c478ceaf714 (patch)
tree1a2f4e03d44dca8c018b85005dbbbdc09a2584f8
parent18613c7e90dbb95c077dfaee632ad4910c512db5 (diff)
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.
-rw-r--r--lisp/ChangeLog16
-rw-r--r--lisp/emacs-lisp/byte-run.el9
-rw-r--r--lisp/emacs-lisp/bytecomp.el2
-rw-r--r--lisp/emacs-lisp/cconv.el10
-rw-r--r--lisp/emacs-lisp/cl-macs.el61
-rw-r--r--lisp/emacs-lisp/testcover.el2
-rw-r--r--lisp/help-fns.el5
-rw-r--r--lisp/international/ccl.el8
-rw-r--r--lisp/subr.el1
-rw-r--r--lisp/thingatpt.el2
-rw-r--r--src/bytecode.c10
11 files changed, 82 insertions, 44 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1769629115..4b2a175181 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -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;
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index c76cdffd62..e61f841da6 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -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.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 0dae6748c2..08d484fc87 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -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"
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 38584c437b..742a98f5e7 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -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
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9ce3dd6a7f..2813cc4f06 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -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)
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 08f757819f..2f168180cf 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -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)))
;;;=========================================================================
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index ed1bd836fb..50e60f94c8 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -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))
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index 2cae126252..9614479072 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -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)
diff --git a/lisp/subr.el b/lisp/subr.el
index 08099dc1fd..74c9ce57d8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -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)
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index a2aeb2e6d6..22370aa916 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -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)))))
diff --git a/src/bytecode.c b/src/bytecode.c
index c3cd3d4307..74cf401bf1 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -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;