summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2012-09-09 21:16:13 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2012-09-09 21:16:13 -0400
commit9b851e2550c1d627413ecc6c626a0dfe1bbbf33b (patch)
tree4f4d0ffa29a1e1f1128db5dde2bb2133bd387702
parentb8b0239fd0485002d1c761067c9047d1f26dbd4c (diff)
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.
-rw-r--r--lisp/ChangeLog15
-rw-r--r--lisp/emacs-lisp/benchmark.el6
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el2
-rw-r--r--lisp/emacs-lisp/cl-macs.el8
-rw-r--r--lisp/emacs-lisp/lisp-mode.el77
-rw-r--r--lisp/gnus/ChangeLog4
-rw-r--r--lisp/gnus/qp.el20
7 files changed, 101 insertions, 31 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 6ec52876d4..8de5987567 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * 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 <juri@jurta.org>
* replace.el (replace-regexp-lax-whitespace): New defcustom.
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 646be3e1b7..9029c81f27 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -53,6 +53,7 @@ FORMS once.
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 @@ See also `benchmark-run-compiled'."
`(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 @@ See also `benchmark-run-compiled'."
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 @@ result. The overhead of the `lambda's is accounted for."
(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)
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index a59beaeb7a..c12e8ccacb 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -260,7 +260,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
;;;;;; 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" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 312c37261e..16ac14f8fe 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1463,8 +1463,15 @@ Valid clauses are:
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 @@ Valid clauses are:
(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)))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 666e31f690..64aac4b81d 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -431,6 +431,61 @@ if that value is non-nil."
(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 #@NNN ....^_ 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 @@ POS specifies the starting position where EXP was found and defaults to point."
(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 @@ if it already has a value.\)
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 @@ rigidly along with this one."
(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 @@ rigidly along with this one."
;; 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 @@ Lisp function does not specify a special indentation."
(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)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index d9f8010343..5644c394f7 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
+2012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction.
+
2012-09-07 Chong Yidong <cyd@gnu.org>
* gnus-util.el
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index bfa1fe0a6d..c4487c68b5 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -53,14 +53,7 @@ them into characters should be done separately."
;; 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 @@ them into characters should be done separately."
(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)))