diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 20 | ||||
| -rw-r--r-- | lisp/emacs-lisp/generic.el | 66 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp-mode.el | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 20 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 29 | ||||
| -rw-r--r-- | lisp/emacs-lisp/regexp-opt.el | 2 | ||||
| -rw-r--r-- | lisp/emacs-lisp/smie.el | 8 |
7 files changed, 102 insertions, 44 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d8ea33a160d..431525431a4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2981,7 +2981,7 @@ for symbols generated by the byte compiler itself." lexenv reserved-csts) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, - ;; t -> a list of forms, + ;; 'progn or t -> a list of forms, ;; 'lambda -> body of a lambda, ;; 'file -> used at file-level. (let ((byte-compile--for-effect for-effect) @@ -3044,19 +3044,21 @@ for symbols generated by the byte compiler itself." ;; a single atom, but that causes confusion if the docstring ;; uses the (file . pos) syntax. Besides, now that we have ;; the Lisp_Compiled type, the compiled form is faster. - ;; eval/nil-> atom, quote or (function atom atom atom) - ;; t -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) + ;; eval -> atom, quote or (function atom atom atom) + ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. - (let (body tmp) + (let (rest + (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. + tmp body) (cond ;; #### This should be split out into byte-compile-nontrivial-function-p. ((or (eq output-type 'lambda) (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output) (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit. (not (setq tmp (assq 'byte-return byte-compile-output))) - (let ((maycall t) ; t if we may make a funcall. - (rest (nreverse - (cdr (memq tmp (reverse byte-compile-output)))))) + (progn + (setq rest (nreverse + (cdr (memq tmp (reverse byte-compile-output))))) (while (cond ((memq (car (car rest)) '(byte-varref byte-constant)) @@ -3065,7 +3067,7 @@ for symbols generated by the byte compiler itself." (or (consp tmp) (and (symbolp tmp) (not (macroexp--const-symbol-p tmp))))) - (if maycall ;;Why? --Stef + (if maycall (setq body (cons (list 'quote tmp) body))) (setq body (cons tmp body)))) ((and maycall @@ -3073,7 +3075,7 @@ for symbols generated by the byte compiler itself." (null (nthcdr 3 rest)) (setq tmp (get (car (car rest)) 'byte-opcode-invert)) (or (null (cdr rest)) - (and (memq output-type '(file t)) + (and (memq output-type '(file progn t)) (cdr (cdr rest)) (eq (car (nth 1 rest)) 'byte-discard) (progn (setq rest (cdr rest)) t)))) diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 3b6ea12ecff..e4ed745b25d 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -234,13 +234,73 @@ Some generic modes are defined in `generic-x.el'." (cond ((characterp end) (setq end (char-to-string end))) ((zerop (length end)) (setq end "\n"))) - (push (list start end) normalized))) + (push (cons start end) normalized))) (nreverse normalized))) +(defun generic-set-comment-syntax (st comment-list) + "Set up comment functionality for generic mode." + (let ((chars nil) + (comstyles) + (comstyle "") + (comment-start nil)) + + ;; Go through all the comments. + (pcase-dolist (`(,start . ,end) comment-list) + (let ((comstyle + ;; Reuse comstyles if necessary. + (or (cdr (assoc start comstyles)) + (cdr (assoc end comstyles)) + ;; Otherwise, use a style not yet in use. + (if (not (rassoc "" comstyles)) "") + (if (not (rassoc "b" comstyles)) "b") + "c"))) + (push (cons start comstyle) comstyles) + (push (cons end comstyle) comstyles) + + ;; Setup the syntax table. + (if (= (length start) 1) + (modify-syntax-entry (aref start 0) + (concat "< " comstyle) st) + (let ((c0 (aref start 0)) (c1 (aref start 1))) + ;; Store the relevant info but don't update yet. + (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) + (push (cons c1 (concat (cdr (assoc c1 chars)) + (concat "2" comstyle))) chars))) + (if (= (length end) 1) + (modify-syntax-entry (aref end 0) + (concat ">" comstyle) st) + (let ((c0 (aref end 0)) (c1 (aref end 1))) + ;; Store the relevant info but don't update yet. + (push (cons c0 (concat (cdr (assoc c0 chars)) + (concat "3" comstyle))) chars) + (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) + + ;; Process the chars that were part of a 2-char comment marker + (with-syntax-table st ;For `char-syntax'. + (dolist (cs (nreverse chars)) + (modify-syntax-entry (car cs) + (concat (char-to-string (char-syntax (car cs))) + " " (cdr cs)) + st))))) + +(defun generic-set-comment-vars (comment-list) + (when comment-list + (setq-local comment-start (caar comment-list)) + (setq-local comment-end + (let ((end (cdar comment-list))) + (if (string-equal end "\n") "" end))) + (setq-local comment-start-skip + (concat (regexp-opt (mapcar #'car comment-list)) + "+[ \t]*")) + (setq-local comment-end-skip + (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list)))))) + (defun generic-mode-set-comments (comment-list) "Set up comment functionality for generic mode." - (let ((st (make-syntax-table))) - (comment-set-syntax st comment-list) + (let ((st (make-syntax-table)) + (comment-list (generic--normalize-comments comment-list))) + (generic-set-comment-syntax st comment-list) + (generic-set-comment-vars comment-list) (set-syntax-table st))) (defun generic-bracket-support () diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index ac47d98359b..fa6dc98d04c 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -237,7 +237,6 @@ (eval-when-compile (concat "(\\(" lisp-mode-symbol-regexp "\\)\\_>")) limit t) - ;; FIXME: If it's indented like `defun' then highlight the first arg! (let ((sym (intern-soft (match-string 1)))) (when (or (special-form-p sym) (and (macrop sym) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5b136bdf489..b60a8a136a1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1163,6 +1163,26 @@ The return result is a `package-desc'." (insert (format "Error while verifying signature %s:\n" sig-file))) (insert "\nCommand output:\n" (epg-context-error-output context)))))) +(defmacro package--with-work-buffer (location file &rest body) + "Run BODY in a buffer containing the contents of FILE at LOCATION. +LOCATION is the base location of a package archive, and should be +one of the URLs (or file names) specified in `package-archives'. +FILE is the name of a file relative to that base location. + +This macro retrieves FILE from LOCATION into a temporary buffer, +and evaluates BODY while that buffer is current. This work +buffer is killed afterwards. Return the last value in BODY." + (declare (indent 2) (debug t) + (obsolete package--with-response-buffer "25.1")) + `(with-temp-buffer + (if (string-match-p "\\`https?:" ,location) + (url-insert-file-contents (concat ,location ,file)) + (unless (file-name-absolute-p ,location) + (error "Archive location %s is not an absolute file name" + ,location)) + (insert-file-contents (expand-file-name ,file ,location))) + ,@body)) + (cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) "Access URL and run BODY in a buffer containing the response. Point is after the headers when BODY runs. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 07beb722fc3..ae2cf8eb02f 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -97,34 +97,11 @@ (declare-function get-edebug-spec "edebug" (symbol)) (declare-function edebug-match "edebug" (cursor specs)) -(defun pcase--get-macroexpander (s) - "Return the macroexpander for pcase pattern head S, or nil" - (let ((em (assoc s (assq :pcase-macroexpander macroexpand-all-environment)))) - (if em (cdr em) - (get s 'pcase-macroexpander)))) - -(defmacro pcase-macrolet (bindings &rest body) - (let ((new-macros (if (consp (car-safe bindings)) - (mapcar (lambda (binding) - (cons (car binding) - (eval (if (cddr binding) - `(lambda ,(cadr binding) - ,@(cddr binding)) - (cadr binding)) - lexical-binding))) - bindings) - (eval bindings lexical-binding))) - (old-pme (assq :pcase-macroexpander macroexpand-all-environment))) - (macroexpand-all (macroexp-progn body) - (cons (cons :pcase-macroexpander - (append new-macros old-pme)) - macroexpand-all-environment)))) - (defun pcase--edebug-match-macro (cursor) (let (specs) (mapatoms (lambda (s) - (let ((m (pcase--get-macroexpander s))) + (let ((m (get s 'pcase-macroexpander))) (when (and m (get-edebug-spec m)) (push (cons (symbol-name s) (get-edebug-spec m)) specs))))) @@ -216,7 +193,7 @@ Emacs Lisp manual for more information and examples." (let (more) ;; Collect all the extensions. (mapatoms (lambda (symbol) - (let ((me (pcase--get-macroexpander symbol))) + (let ((me (get symbol 'pcase-macroexpander))) (when me (push (cons symbol me) more))))) @@ -442,7 +419,7 @@ of the elements of LIST is performed as if by `pcase-let'. ((eq head 'let) `(let ,(pcase--macroexpand (cadr pat)) ,@(cddr pat))) ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) (t - (let* ((expander (pcase--get-macroexpander head)) + (let* ((expander (get head 'pcase-macroexpander)) (npat (if expander (apply expander (cdr pat))))) (if (null npat) (error (if expander diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index a9b5df53c84..00f72e284ad 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -141,7 +141,7 @@ usually more efficient than that of a simplified version: (completion-regexp-list nil) (open (cond ((stringp paren) paren) (paren "\\("))) (sorted-strings (delete-dups - (sort (copy-sequence strings) #'string-lessp))) + (sort (copy-sequence strings) 'string-lessp))) (re (cond ;; No strings: return an unmatchable regexp. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 47265962591..f2163b243ee 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -239,7 +239,7 @@ be either: ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in ;; the repetition, maybe). - (let* ((nts (mapcar #'car bnf)) ;Non-terminals. + (let* ((nts (mapcar 'car bnf)) ;Non-terminals. (first-ops-table ()) (last-ops-table ()) (first-nts-table ()) @@ -258,7 +258,7 @@ be either: (push resolver precs)) (t (error "Unknown resolver %S" resolver)))) (apply #'smie-merge-prec2s over - (mapcar #'smie-precs->prec2 precs)))) + (mapcar 'smie-precs->prec2 precs)))) again) (dolist (rules bnf) (let ((nt (car rules)) @@ -489,7 +489,7 @@ CSTS is a list of pairs representing arcs in a graph." res)) cycle))) (mapconcat - (lambda (elems) (mapconcat #'identity elems "=")) + (lambda (elems) (mapconcat 'identity elems "=")) (append names (list (car names))) " < "))) @@ -559,7 +559,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or ;; Then eliminate trivial constraints iteratively. (let ((i 0)) (while csts - (let ((rhvs (mapcar #'cdr csts)) + (let ((rhvs (mapcar 'cdr csts)) (progress nil)) (dolist (cst csts) (unless (memq (car cst) rhvs) |