[Emacs-diffs] /srv/bzr/emacs/trunk r104465: Miscellaneous tweaks.

[Stefan Monnier]

------------------------------------------------------------
revno: 104465
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Wed 2011-06-01 11:19:45 -0300
message:
  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.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/byte-run.el
  lisp/emacs-lisp/bytecomp.el
  lisp/emacs-lisp/cconv.el
  lisp/emacs-lisp/cl-macs.el
  lisp/emacs-lisp/testcover.el
  lisp/help-fns.el
  lisp/international/ccl.el
  lisp/subr.el
  lisp/thingatpt.el
  src/bytecode.c

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-06-01 08:10:42 +0000
+++ b/lisp/ChangeLog    2011-06-01 14:19:45 +0000
@@ -1,3 +1,19 @@
+2011-06-01  Stefan Monnier  <address@hidden>
+
+       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  <address@hidden>
 
        * net/rcirc.el (rcirc-decode-coding-system): Revert last change;

=== modified file 'lisp/emacs-lisp/byte-run.el'
--- a/lisp/emacs-lisp/byte-run.el       2011-05-23 17:57:17 +0000
+++ b/lisp/emacs-lisp/byte-run.el       2011-06-01 14:19:45 +0000
@@ -120,13 +120,13 @@
 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 @@
       (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.

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el       2011-05-30 17:14:19 +0000
+++ b/lisp/emacs-lisp/bytecomp.el       2011-06-01 14:19:45 +0000
@@ -2991,7 +2991,7 @@
     (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"

=== modified file 'lisp/emacs-lisp/cconv.el'
--- a/lisp/emacs-lisp/cconv.el  2011-04-06 21:55:08 +0000
+++ b/lisp/emacs-lisp/cconv.el  2011-06-01 14:19:45 +0000
@@ -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

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2011-04-01 15:16:50 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2011-06-01 14:19:45 +0000
@@ -1236,14 +1236,29 @@
 
 \(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 @@
 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)

=== modified file 'lisp/emacs-lisp/testcover.el'
--- a/lisp/emacs-lisp/testcover.el      2011-01-25 04:08:28 +0000
+++ b/lisp/emacs-lisp/testcover.el      2011-06-01 14:19:45 +0000
@@ -430,7 +430,7 @@
   "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)))
 
 
 ;;;=========================================================================

=== modified file 'lisp/help-fns.el'
--- a/lisp/help-fns.el  2011-05-28 17:40:37 +0000
+++ b/lisp/help-fns.el  2011-06-01 14:19:45 +0000
@@ -222,7 +222,7 @@
 (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 @@
                          "\\(?:-[{([<`\"].*?\\)?"; 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))

=== modified file 'lisp/international/ccl.el'
--- a/lisp/international/ccl.el 2011-01-25 04:08:28 +0000
+++ b/lisp/international/ccl.el 2011-06-01 14:19:45 +0000
@@ -280,10 +280,10 @@
 ;;;###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)

=== modified file 'lisp/subr.el'
--- a/lisp/subr.el      2011-05-31 18:40:00 +0000
+++ b/lisp/subr.el      2011-06-01 14:19:45 +0000
@@ -2926,6 +2926,7 @@
 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)

=== modified file 'lisp/thingatpt.el'
--- a/lisp/thingatpt.el 2011-05-13 17:02:56 +0000
+++ b/lisp/thingatpt.el 2011-06-01 14:19:45 +0000
@@ -402,7 +402,7 @@
       (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)))))
 

=== modified file 'src/bytecode.c'
--- a/src/bytecode.c    2011-05-12 07:07:06 +0000
+++ b/src/bytecode.c    2011-06-01 14:19:45 +0000
@@ -144,7 +144,7 @@
 #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 @@
                                 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 @@
            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 @@
            PUSH (*ptr);
            break;
          }
+       case Bstack_set:
          /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
-       case Bstack_set:
          {
            Lisp_Object *ptr = top - (FETCH);
            *ptr = POP;