[Emacs-diffs] /srv/bzr/emacs/trunk r109963: New emacs-lisp-byte-code-mode; misc minor changes.

[Stefan Monnier]

------------------------------------------------------------
revno: 109963
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sun 2012-09-09 21:16:13 -0400
message:
  New emacs-lisp-byte-code-mode; misc minor changes.
  * lisp/emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var.
  (emacs-lisp-byte-code-comment)
  (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode):
  New functions.
  (eval-sexp-add-defvars): Don't skip defvars in column >0.
  (eval-defun-2): Remove bogus interactive spec.
  (lisp-indent-line): Remove redundant whole-exp code, now done in
  indent-according-to-mode.
  (save-match-data): Remove redundant indent data.
  * lisp/emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled):
  Use `declare'.
  * lisp/gnus/qp.el (quoted-printable-decode-region):
  Inline+CSE+strength-reduction.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/benchmark.el
  lisp/emacs-lisp/cl-loaddefs.el
  lisp/emacs-lisp/cl-macs.el
  lisp/emacs-lisp/lisp-mode.el
  lisp/gnus/ChangeLog
  lisp/gnus/qp.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-09-09 22:15:24 +0000
+++ b/lisp/ChangeLog    2012-09-10 01:16:13 +0000
@@ -1,3 +1,18 @@
+2012-09-10  Stefan Monnier  <address@hidden>
+
+       * emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var.
+       (emacs-lisp-byte-code-comment)
+       (emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode):
+       New functions.
+       (eval-sexp-add-defvars): Don't skip defvars in column >0.
+       (eval-defun-2): Remove bogus interactive spec.
+       (lisp-indent-line): Remove redundant whole-exp code, now done in
+       indent-according-to-mode.
+       (save-match-data): Remove redundant indent data.
+
+       * emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled):
+       Use `declare'.
+
 2012-09-09  Juri Linkov  <address@hidden>
 
        * replace.el (replace-regexp-lax-whitespace): New defcustom.

=== modified file 'lisp/emacs-lisp/benchmark.el'
--- a/lisp/emacs-lisp/benchmark.el      2012-01-19 07:21:25 +0000
+++ b/lisp/emacs-lisp/benchmark.el      2012-09-10 01:16:13 +0000
@@ -53,6 +53,7 @@
 Return a list of the total elapsed time for execution, the number of
 garbage collections that ran, and the time taken by garbage collection.
 See also `benchmark-run-compiled'."
+  (declare (indent 1) (debug t))
   (unless (natnump repetitions)
     (setq forms (cons repetitions forms)
          repetitions 1))
@@ -69,8 +70,6 @@
                `(benchmark-elapse ,@forms))
             (- gcs-done ,gcs)
             (- gc-elapsed ,gc)))))
-(put 'benchmark-run 'edebug-form-spec t)
-(put 'benchmark-run 'lisp-indent-function 2)
 
 ;;;###autoload
 (defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@@ -78,6 +77,7 @@
 This is like `benchmark-run', but what is timed is a funcall of the
 byte code obtained by wrapping FORMS in a `lambda' and compiling the
 result.  The overhead of the `lambda's is accounted for."
+  (declare (indent 1) (debug t))
   (unless (natnump repetitions)
     (setq forms (cons repetitions forms)
          repetitions 1))
@@ -96,8 +96,6 @@
                                          (funcall ,lambda-code))))
                `(benchmark-elapse (funcall ,code)))
             (- gcs-done ,gcs) (- gc-elapsed ,gc)))))
-(put 'benchmark-run-compiled 'edebug-form-spec t)
-(put 'benchmark-run-compiled 'lisp-indent-function 2)
 
 ;;;###autoload
 (defun benchmark (repetitions form)

=== modified file 'lisp/emacs-lisp/cl-loaddefs.el'
--- a/lisp/emacs-lisp/cl-loaddefs.el    2012-09-07 08:58:31 +0000
+++ b/lisp/emacs-lisp/cl-loaddefs.el    2012-09-10 01:16:13 +0000
@@ -260,7 +260,7 @@
 ;;;;;;  cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
 ;;;;;;  cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
 ;;;;;;  cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
-;;;;;;  "cl-macs" "cl-macs.el" "9f9bae5b8ccaf325bd59ba9be2b27c44")
+;;;;;;  "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'cl--compiler-macro-list* "cl-macs" "\

=== modified file 'lisp/emacs-lisp/cl-macs.el'
--- a/lisp/emacs-lisp/cl-macs.el        2012-09-06 15:35:08 +0000
+++ b/lisp/emacs-lisp/cl-macs.el        2012-09-10 01:16:13 +0000
@@ -1463,8 +1463,15 @@
          cl--loop-accum-var))))
 
 (defun cl--loop-build-ands (clauses)
+  "Return various representations of (and . CLAUSES).
+CLAUSES is a list of Elisp expressions, where clauses of the form
+\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
+The return value has shape (COND BODY COMBO)
+such that COMBO is equivalent to (and . CLAUSES)."
   (let ((ands nil)
        (body nil))
+    ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
+    ;; into (progn ,@A ,@B) ,@C.
     (while clauses
       (if (and (eq (car-safe (car clauses)) 'progn)
               (eq (car (last (car clauses))) t))
@@ -1475,6 +1482,7 @@
                                             (cl-cdadr clauses)
                                           (list (cadr clauses))))
                                  (cddr clauses)))
+            ;; A final (progn ,@A t) is moved outside of the `and'.
            (setq body (cdr (butlast (pop clauses)))))
        (push (pop clauses) ands)))
     (setq ands (or (nreverse ands) (list t)))

=== modified file 'lisp/emacs-lisp/lisp-mode.el'
--- a/lisp/emacs-lisp/lisp-mode.el      2012-08-08 18:56:01 +0000
+++ b/lisp/emacs-lisp/lisp-mode.el      2012-09-10 01:16:13 +0000
@@ -431,6 +431,61 @@
   (add-hook 'completion-at-point-functions
             'lisp-completion-at-point nil 'local))
 
+;;; Emacs Lisp Byte-Code mode
+
+(eval-and-compile
+  (defconst emacs-list-byte-code-comment-re
+    (concat "\\(#\\)@\\([0-9]+\\) "
+            ;; Make sure it's a docstring and not a lazy-loaded byte-code.
+            "\\(?:[^(]\\|([^\"]\\)")))
+
+(defun emacs-lisp-byte-code-comment (end &optional _point)
+  "Try to syntactically mark the address@hidden ....^_ docstrings in byte-code 
files."
+  (let ((ppss (syntax-ppss)))
+    (when (and (nth 4 ppss)
+               (eq (char-after (nth 8 ppss)) ?#))
+      (let* ((n (save-excursion
+                  (goto-char (nth 8 ppss))
+                  (when (looking-at emacs-list-byte-code-comment-re)
+                    (string-to-number (match-string 2)))))
+             ;; `maxdiff' tries to make sure the loop below terminates.
+             (maxdiff n))
+        (when n
+          (let* ((bchar (match-end 2))
+                 (b (position-bytes bchar)))
+            (goto-char (+ b n))
+            (while (let ((diff (- (position-bytes (point)) b n)))
+                     (unless (zerop diff)
+                       (when (> diff maxdiff) (setq diff maxdiff))
+                       (forward-char (- diff))
+                       (setq maxdiff (if (> diff 0) diff
+                                       (max (1- maxdiff) 1)))
+                       t))))
+          (if (<= (point) end)
+              (put-text-property (1- (point)) (point)
+                                 'syntax-table
+                                 (string-to-syntax "> b"))
+            (goto-char end)))))))
+
+(defun emacs-lisp-byte-code-syntax-propertize (start end)
+  (emacs-lisp-byte-code-comment end (point))
+  (funcall
+   (syntax-propertize-rules
+    (emacs-list-byte-code-comment-re
+     (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
+   start end))
+
+(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
+(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
+  "Elisp-Byte-Code"
+  "Major mode for *.elc files."
+  ;; TODO: Add way to disassemble byte-code under point.
+  (setq-local open-paren-in-column-0-is-defun-start nil)
+  (setq-local syntax-propertize-function
+              #'emacs-lisp-byte-code-syntax-propertize))
+
+;;; Generic Lisp mode.
+
 (defvar lisp-mode-map
   (let ((map (make-sparse-keymap))
        (menu-map (make-sparse-keymap "Lisp")))
@@ -730,10 +785,12 @@
       (let ((vars ()))
         (goto-char (point-min))
         (while (re-search-forward
-                "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
+                "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
                 pos t)
           (let ((var (intern (match-string 1))))
-            (unless (special-variable-p var)
+            (and (not (special-variable-p var))
+                 (save-excursion
+                   (zerop (car (syntax-ppss (match-beginning 0)))))
               (push var vars))))
         `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
 
@@ -820,7 +877,6 @@
 
 With argument, insert value in current buffer after the defun.
 Return the result of evaluation."
-  (interactive "P")
   ;; FIXME: the print-length/level bindings should only be applied while
   ;; printing, not while evaluating.
   (let ((debug-on-error eval-expression-debug-on-error)
@@ -925,6 +981,7 @@
     (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
        ;; Don't alter indentation of a ;;; comment line
        ;; or a line that starts in a string.
+        ;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
        (goto-char (- (point-max) pos))
       (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
          ;; Single-semicolon comment lines should be indented
@@ -939,18 +996,7 @@
       ;; If initial point was within line's indentation,
       ;; position after the indentation.  Else stay at same point in text.
       (if (> (- (point-max) pos) (point))
-         (goto-char (- (point-max) pos)))
-      ;; If desired, shift remaining lines of expression the same amount.
-      (and whole-exp (not (zerop shift-amt))
-          (save-excursion
-            (goto-char beg)
-            (forward-sexp 1)
-            (setq end (point))
-            (goto-char beg)
-            (forward-line 1)
-            (setq beg (point))
-            (> end beg))
-          (indent-code-rigidly beg end shift-amt)))))
+         (goto-char (- (point-max) pos))))))
 
 (defvar calculate-lisp-indent-last-sexp)
 
@@ -1230,7 +1276,6 @@
 (put 'prog2 'lisp-indent-function 2)
 (put 'save-excursion 'lisp-indent-function 0)
 (put 'save-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
 (put 'save-current-buffer 'lisp-indent-function 0)
 (put 'let 'lisp-indent-function 1)
 (put 'let* 'lisp-indent-function 1)

=== modified file 'lisp/gnus/ChangeLog'
--- a/lisp/gnus/ChangeLog       2012-09-07 04:07:00 +0000
+++ b/lisp/gnus/ChangeLog       2012-09-10 01:16:13 +0000
@@ -1,3 +1,7 @@
+2012-09-10  Stefan Monnier  <address@hidden>
+
+       * qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction.
+
 2012-09-07  Chong Yidong  <address@hidden>
 
        * gnus-util.el

=== modified file 'lisp/gnus/qp.el'
--- a/lisp/gnus/qp.el   2012-09-06 01:45:33 +0000
+++ b/lisp/gnus/qp.el   2012-09-10 01:16:13 +0000
@@ -53,14 +53,7 @@
       ;; or both of which are lowercase letters in "abcdef", is
       ;; formally illegal. A robust implementation might choose to
       ;; recognize them as the corresponding uppercase letters.''
-      (let ((case-fold-search t)
-           (decode-hex #'(lambda (n1 n2)
-                           (+ (* (if (<= n1 ?9) (- n1 ?0)
-                                   (if (<= n1 ?F) (+ (- n1 ?A) 10)
-                                     (+ (- n1 ?a) 10))) 16)
-                              (if (<= n2 ?9) (- n2 ?0)
-                                (if (<= n2 ?F) (+ (- n2 ?A) 10)
-                                  (+ (- n2 ?a) 10)))))))
+      (let ((case-fold-search t))
        (narrow-to-region from to)
        ;; Do this in case we're called from Gnus, say, in a buffer
        ;; which already contains non-ASCII characters which would
@@ -78,8 +71,15 @@
                 (let* ((n (/ (- (match-end 0) (point)) 3))
                        (str (make-string n 0)))
                   (dotimes (i n)
-                    (aset str i (funcall decode-hex (char-after (1+ (point)))
-                                         (char-after (+ 2 (point)))))
+                     (let ((n1 (char-after (1+ (point))))
+                           (n2 (char-after (+ 2 (point)))))
+                       (aset str i
+                             (+ (* 16 (- n1 (if (<= n1 ?9) ?0
+                                              (if (<= n1 ?F) (- ?A 10)
+                                                (- ?a 10)))))
+                                (- n2 (if (<= n2 ?9) ?0
+                                        (if (<= n2 ?F) (- ?A 10)
+                                          (- ?a 10)))))))
                     (forward-char 3))
                   (delete-region (match-beginning 0) (match-end 0))
                   (insert str)))