Commit 9b851e25 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent b8b0239f
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.
......
......@@ -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)
......
......@@ -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" "\
......
......@@ -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)))
......
......@@ -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)
......
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
......
......@@ -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)))
......
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