From 056548283884d61b1b9637c3e56855ce3a17274d Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 14 Mar 2017 13:52:40 +0100 Subject: Make cl-defstruct use records. * lisp/emacs-lisp/cl-extra.el (cl--describe-class) (cl--describe-class-slots): Use the new `type-of'. * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Use type-of. (cl--generic-struct-specializers): Adjust to new tag. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): When type is nil, use records. Use the type symbol as the tag. Use copy-record to copy structs. (cl--defstruct-predicate): New function. (cl--pcase-mutually-exclusive-p): Use it. (cl-struct-sequence-type): Can now return `record'. * lisp/emacs-lisp/cl-preloaded.el (cl--make-slot-desc): Adjust ad-hoc code to new format. (cl--struct-register-child): Work with records. (cl-struct-define): Don't touch the tag's symbol-value and symbol-function slots when we use the type as tag. * lisp/emacs-lisp/cl-print.el (cl-print-object): Adjust to new tag. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-defstruct-record): New test. * doc/lispref/records.texi, doc/misc/cl.texi: Update for records. --- lisp/emacs-lisp/cl-extra.el | 6 ++-- lisp/emacs-lisp/cl-generic.el | 24 +++------------- lisp/emacs-lisp/cl-macs.el | 62 ++++++++++++++++++++++++++++------------- lisp/emacs-lisp/cl-preloaded.el | 6 ++-- lisp/emacs-lisp/cl-print.el | 2 +- 5 files changed, 53 insertions(+), 47 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 021ef232749..3852ceb6c31 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -775,8 +775,7 @@ including `cl-block' and `cl-eval-when'." (defun cl--describe-class (type &optional class) (unless class (setq class (cl--find-class type))) (let ((location (find-lisp-object-file-name type 'define-type)) - ;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch. - (metatype (cl--class-name (symbol-value (aref class 0))))) + (metatype (type-of class))) (insert (symbol-name type) (substitute-command-keys " is a type (of kind `")) (help-insert-xref-button (symbol-name metatype) @@ -901,8 +900,7 @@ including `cl-block' and `cl-eval-when'." "Print help description for the slots in CLASS. Outputs to the current buffer." (let* ((slots (cl--class-slots class)) - ;; FIXME: Add a `cl-class-of' or `cl-typeof' or somesuch. - (metatype (cl--class-name (symbol-value (aref class 0)))) + (metatype (type-of class)) ;; ¡For EIEIO! (cslots (condition-case nil (cl-struct-slot-value metatype 'class-slots class) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 8c6d3d5d51f..e15c94242fb 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1082,24 +1082,8 @@ These match if the argument is `eql' to VAL." ;;; Support for cl-defstructs specializers. (defun cl--generic-struct-tag (name &rest _) - ;; It's tempting to use (and (vectorp ,name) (aref ,name 0)) - ;; but that would suffer from some problems: - ;; - the vector may have size 0. - ;; - when called on an actual vector (rather than an object), we'd - ;; end up returning an arbitrary value, possibly colliding with - ;; other tagcode's values. - ;; - it can also result in returning all kinds of irrelevant - ;; values which would end up filling up the method-cache with - ;; lots of irrelevant/redundant entries. - ;; FIXME: We could speed this up by introducing a dedicated - ;; vector type at the C level, so we could do something like - ;; (and (vector-objectp ,name) (aref ,name 0)) - `(and (vectorp ,name) - (> (length ,name) 0) - (let ((tag (aref ,name 0))) - (and (symbolp tag) - (eq (symbol-function tag) :quick-object-witness-check) - tag)))) + ;; Use exactly the same code as for `typeof'. + `(if ,name (type-of ,name) 'null)) (defun cl--generic-class-parents (class) (let ((parents ()) @@ -1113,8 +1097,8 @@ These match if the argument is `eql' to VAL." (nreverse parents))) (defun cl--generic-struct-specializers (tag &rest _) - (and (symbolp tag) (boundp tag) - (let ((class (symbol-value tag))) + (and (symbolp tag) + (let ((class (get tag 'cl--class))) (when (cl-typep class 'cl-structure-class) (cl--generic-class-parents class))))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 58bcdd52acf..c282938a9bf 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2604,11 +2604,24 @@ non-nil value, that slot cannot be set via `setf'. (print-func nil) (print-auto nil) (safety (if (cl--compiling-file) cl--optimize-safety 3)) (include nil) - (tag (intern (format "cl-struct-%s" name))) + ;; There are 4 types of structs: + ;; - `vector' type: means we should use a vector, which can come + ;; with or without a tag `name', which is usually in slot 0 + ;; but obeys :initial-offset. + ;; - `list' type: same as `vector' but using lists. + ;; - `record' type: means we should use a record, which necessarily + ;; comes tagged in slot 0. Currently we'll use the `name' as + ;; the tag, but we may want to change it so that the class object + ;; is used as the tag. + ;; - nil type: this is the "pre-record default", which uses a vector + ;; with a tag in slot 0 which is a symbol of the form + ;; `cl-struct-NAME'. We need to still support this for backward + ;; compatibility with old .elc files. + (tag name) (tag-symbol (intern (format "cl-struct-%s-tags" name))) (include-descs nil) (include-name nil) - (type nil) + (type nil) ;nil here means not specified explicitly. (named nil) (forms nil) (docstring (if (stringp (car descs)) (pop descs))) @@ -2648,7 +2661,9 @@ non-nil value, that slot cannot be set via `setf'. ((eq opt :print-function) (setq print-func (car args))) ((eq opt :type) - (setq type (car args))) + (setq type (car args)) + (unless (memq type '(vector list)) + (error "Invalid :type specifier: %s" type))) ((eq opt :named) (setq named t)) ((eq opt :initial-offset) @@ -2680,13 +2695,11 @@ non-nil value, that slot cannot be set via `setf'. (pop include-descs))) (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) type inc-type - named (if type (assq 'cl-tag-slot descs) 'true)) - (if (cl--struct-class-named include) (setq tag name named t))) - (if type - (progn - (or (memq type '(vector list)) - (error "Invalid :type specifier: %s" type)) - (if named (setq tag name))) + named (if (memq type '(vector list)) + (assq 'cl-tag-slot descs) + 'true)) + (if (cl--struct-class-named include) (setq named t))) + (unless type (setq named 'true))) (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) (when (and (null predicate) named) @@ -2696,7 +2709,9 @@ non-nil value, that slot cannot be set via `setf'. (length (memq (assq 'cl-tag-slot descs) descs))))) (cond - ((memq type '(nil vector)) + ((null type) ;Record type. + `(memq (type-of cl-x) ,tag-symbol)) + ((eq type 'vector) `(and (vectorp cl-x) (>= (length cl-x) ,(length descs)) (memq (aref cl-x ,pos) ,tag-symbol))) @@ -2793,7 +2808,9 @@ non-nil value, that slot cannot be set via `setf'. (setq slots (nreverse slots) defaults (nreverse defaults)) (and copier - (push `(defalias ',copier #'copy-sequence) forms)) + (push `(defalias ',copier + ,(if (null type) '#'copy-record '#'copy-sequence)) + forms)) (if constructor (push (list constructor (cons '&key (delq nil (copy-sequence slots)))) @@ -2808,7 +2825,7 @@ non-nil value, that slot cannot be set via `setf'. (format "Constructor for objects of type `%s'." name)) ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs))) '((declare (side-effect-free t)))) - (,(or type #'vector) ,@make)) + (,(or type #'record) ,@make)) forms))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) ;; Don't bother adding to cl-custom-print-functions since it's not used @@ -2866,6 +2883,15 @@ is a shorthand for (NAME NAME)." ,pat))) fields))) +(defun cl--defstruct-predicate (type) + (let ((cons (assq (cl-struct-sequence-type type) + `((list . consp) + (vector . vectorp) + (nil . recordp))))) + (if cons + (cdr cons) + 'recordp))) + (defun cl--pcase-mutually-exclusive-p (orig pred1 pred2) "Extra special cases for `cl-typep' predicates." (let* ((x1 pred1) (x2 pred2) @@ -2888,14 +2914,12 @@ is a shorthand for (NAME NAME)." (memq c2 (cl--struct-all-parents c1))))))) (let ((c1 (and (symbolp t1) (cl--find-class t1)))) (and c1 (cl--struct-class-p c1) - (funcall orig (if (eq 'list (cl-struct-sequence-type t1)) - 'consp 'vectorp) + (funcall orig (cl--defstruct-predicate t1) pred2))) (let ((c2 (and (symbolp t2) (cl--find-class t2)))) (and c2 (cl--struct-class-p c2) (funcall orig pred1 - (if (eq 'list (cl-struct-sequence-type t2)) - 'consp 'vectorp)))) + (cl--defstruct-predicate t2)))) (funcall orig pred1 pred2)))) (advice-add 'pcase--mutually-exclusive-p :around #'cl--pcase-mutually-exclusive-p) @@ -2903,8 +2927,8 @@ is a shorthand for (NAME NAME)." (defun cl-struct-sequence-type (struct-type) "Return the sequence used to build STRUCT-TYPE. -STRUCT-TYPE is a symbol naming a struct type. Return `vector' or -`list', or nil if STRUCT-TYPE is not a struct type. " +STRUCT-TYPE is a symbol naming a struct type. Return `record', +`vector`, or `list' if STRUCT-TYPE is a struct type, nil otherwise." (declare (side-effect-free t) (pure t)) (cl--struct-class-type (cl--struct-get-class struct-type))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 482b579f11a..7432dd4978d 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -64,7 +64,7 @@ ;; cl--slot-descriptor. ;; BEWARE: Obviously, it's important to keep the two in sync! (lambda (name &optional initform type props) - (vector 'cl-struct-cl-slot-descriptor + (record 'cl-slot-descriptor name initform type props))) (defun cl--struct-get-class (name) @@ -101,7 +101,7 @@ (defun cl--struct-register-child (parent tag) ;; Can't use (cl-typep parent 'cl-structure-class) at this stage ;; because `cl-structure-class' is defined later. - (while (vectorp parent) + (while (recordp parent) (add-to-list (cl--struct-class-children-sym parent) tag) ;; Only register ourselves as a child of the leftmost parent since structs ;; can only only have one parent. @@ -150,7 +150,7 @@ parent name)))) (add-to-list 'current-load-list `(define-type . ,name)) (cl--struct-register-child parent-class tag) - (unless (eq named t) + (unless (or (eq named t) (eq tag name)) ;; We used to use `defconst' instead of `set' but that ;; has a side-effect of purecopying during the dump, so that the ;; class object stored in the tag ends up being a *copy* of the diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 8a8d4a4c1af..65c86d2b65e 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -137,7 +137,7 @@ call other entry points instead, such as `cl-prin1'." (cl-defmethod cl-print-object ((object cl-structure-object) stream) (princ "#s(" stream) - (let* ((class (symbol-value (aref object 0))) + (let* ((class (cl-find-class (type-of object))) (slots (cl--struct-class-slots class))) (princ (cl--struct-class-name class) stream) (dotimes (i (length slots)) -- cgit v1.2.3 From 8e6f204f44b6183ba73c7d1bec5841f2b7b8bdd0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 15 Mar 2017 22:48:28 -0400 Subject: Make EIEIO use records. * lisp/emacs-lisp/eieio-compat.el (eieio--generic-static-object-generalizer): Adjust to new tags. * lisp/emacs-lisp/eieio-core.el: Use records, and place the class object directly as tag. (eieio--object-class): Adjust to new tag representation. (eieio-object-p): Rewrite, and adapt to new `type-of' behavior. (eieio-defclass-internal): Use `make-record'. (eieio--generic-generalizer): Adjust generalizer code accordingly. * lisp/emacs-lisp/eieio.el (make-instance, clone): Use copy-record. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Add `recordp'. * doc/lispref/records.texi, doc/misc/eieio.texi: Update for records. --- doc/lispref/records.texi | 3 ++- doc/misc/eieio.texi | 8 +++---- lisp/emacs-lisp/eieio-base.el | 3 +-- lisp/emacs-lisp/eieio-compat.el | 2 +- lisp/emacs-lisp/eieio-core.el | 50 +++++++++++++---------------------------- lisp/emacs-lisp/eieio.el | 12 +++++----- lisp/emacs-lisp/pcase.el | 6 +++++ 7 files changed, 35 insertions(+), 49 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi index 618f30a72ce..822fd2bf36e 100644 --- a/doc/lispref/records.texi +++ b/doc/lispref/records.texi @@ -9,7 +9,8 @@ The purpose of records is to allow programmers to create objects with new types that are not built into Emacs. They are used as the -underlying representation of @code{cl-defstruct} instances. +underlying representation of @code{cl-defstruct} and @code{defclass} +instances. Internally, a record object is much like a vector; its slots can be accessed using @code{aref}. However, the first slot is used to hold diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index dfae565deed..7076c244222 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -1017,7 +1017,7 @@ If @var{errorp} is non-@code{nil}, @code{wrong-argument-type} is signaled. @defun class-p class @anchor{class-p} -Return @code{t} if @var{class} is a valid class vector. +Return @code{t} if @var{class} is a valid class object. @var{class} is a symbol. @end defun @@ -1055,7 +1055,7 @@ Will fetch the documentation string for @code{eieio-default-superclass}. Return a string of the form @samp{#} for @var{obj}. This should look like Lisp symbols from other parts of Emacs such as buffers and processes, and is shorter and cleaner than printing the -object's vector. It is more useful to use @code{object-print} to get +object's record. It is more useful to use @code{object-print} to get and object's print form, as this allows the object to add extra display information into the symbol. @end defun @@ -1212,7 +1212,7 @@ items defined in this second slot. Introspection permits a programmer to peek at the contents of a class without any previous knowledge of that class. While @eieio{} implements -objects on top of vectors, and thus everything is technically visible, +objects on top of records, and thus everything is technically visible, some functions have been provided. None of these functions are a part of CLOS. @@ -1525,7 +1525,7 @@ Currently, the default superclass is defined as follows: nil "Default parent class for classes with no specified parent class. Its slots are automatically adopted by classes with no specified -parents. This class is not stored in the `parent' slot of a class vector." +parents. This class is not stored in the `parent' slot of a class object." :abstract t) @end example diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 986d0285172..33c71ec5807 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -294,8 +294,7 @@ Second, any text properties will be stripped from strings." (cond ((consp proposed-value) ;; Lists with something in them need special treatment. (let* ((slot-idx (- (eieio--slot-name-index class slot) - (eval-when-compile - (length (cl-struct-slot-info 'eieio--object))))) + (eval-when-compile eieio--object-num-slots))) (type (cl--slot-descriptor-type (aref (eieio--class-slots class) slot-idx))) (classtype (eieio-persistent-slot-type-is-class-p type))) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 888d85f6038..d6eb0b416f8 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -145,7 +145,7 @@ Summary: ;; interleaved list comes before the class's non-interleaved list. 51 #'cl--generic-struct-tag (lambda (tag &rest _) - (and (symbolp tag) (boundp tag) (setq tag (symbol-value tag)) + (and (symbolp tag) (setq tag (cl--find-class tag)) (eieio--class-p tag) (let ((superclasses (eieio--class-precedence-list tag)) (specializers ())) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 5cc6d020eaf..c59f85d6fb2 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -108,21 +108,14 @@ Currently under control of this var: (cl-declaim (optimize (safety 1)))) -(cl-defstruct (eieio--object - (:type vector) ;We manage our own tagging system. - (:constructor nil) - (:copier nil)) - ;; `class-tag' holds a symbol, which is not the class name, but is instead - ;; properly prefixed as an internal EIEIO thingy and which holds the class - ;; object/struct in its `symbol-value' slot. - class-tag) +(eval-and-compile + (defconst eieio--object-num-slots 1)) -(eval-when-compile - (defconst eieio--object-num-slots - (length (cl-struct-slot-info 'eieio--object)))) +(defsubst eieio--object-class-tag (obj) + (aref obj 0)) (defsubst eieio--object-class (obj) - (symbol-value (eieio--object-class-tag obj))) + (eieio--object-class-tag obj)) ;;; Important macros used internally in eieio. @@ -166,13 +159,8 @@ Return nil if that option doesn't exist." (defun eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." - (and (vectorp obj) - (> (length obj) 0) - (let ((tag (eieio--object-class-tag obj))) - (and (symbolp tag) - ;; (eq (symbol-function tag) :quick-object-witness-check) - (boundp tag) - (eieio--class-p (symbol-value tag)))))) + (and (recordp obj) + (eieio--class-p (eieio--object-class-tag obj)))) (define-obsolete-function-alias 'object-p 'eieio-object-p "25.1") @@ -496,18 +484,11 @@ See `defclass' for more information." (if clearparent (setf (eieio--class-parents newc) nil)) ;; Create the cached default object. - (let ((cache (make-vector (+ (length (eieio--class-slots newc)) - (eval-when-compile eieio--object-num-slots)) - nil)) - ;; We don't strictly speaking need to use a symbol, but the old - ;; code used the class's name rather than the class's object, so - ;; we follow this preference for using a symbol, which is probably - ;; convenient to keep the printed representation of such Elisp - ;; objects readable. - (tag (intern (format "eieio-class-tag--%s" cname)))) - (set tag newc) - (fset tag :quick-object-witness-check) - (setf (eieio--object-class-tag cache) tag) + (let ((cache (make-record newc + (+ (length (eieio--class-slots newc)) + (eval-when-compile eieio--object-num-slots) + -1) + nil))) (let ((eieio-skip-typecheck t)) ;; All type-checking has been done to our satisfaction ;; before this call. Don't waste our time in this call.. @@ -1060,9 +1041,10 @@ method invocation orders of the involved classes." ;; part of the dispatch code. 50 #'cl--generic-struct-tag (lambda (tag &rest _) - (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) - (mapcar #'eieio--class-name - (eieio--class-precedence-list (symbol-value tag)))))) + (let ((class (cl--find-class tag))) + (and (eieio--class-p class) + (mapcar #'eieio--class-name + (eieio--class-precedence-list class)))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) "Support for dispatch on types defined by EIEIO's `defclass'." diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1a6d5e9d7c1..858b2fdaa04 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -337,14 +337,12 @@ variable name of the same name as the slot." ;; hard-coded in random .elc files. (defun eieio-pcase-slot-index-table (obj) "Return some data structure from which can be extracted the slot offset." - (eieio--class-index-table - (symbol-value (eieio--object-class-tag obj)))) + (eieio--class-index-table (eieio--object-class obj))) (defun eieio-pcase-slot-index-from-index-table (index-table slot) "Find the index to pass to `aref' to access SLOT." (let ((index (gethash slot index-table))) - (if index (+ (eval-when-compile - (length (cl-struct-slot-info 'eieio--object))) + (if index (+ (eval-when-compile eieio--object-num-slots) index)))) (pcase-defmacro eieio (&rest fields) @@ -701,8 +699,8 @@ SLOTS are the initialization slots used by `initialize-instance'. This static method is called when an object is constructed. It allocates the vector used to represent an EIEIO object, and then calls `initialize-instance' on that object." - (let* ((new-object (copy-sequence (eieio--class-default-object-cache - (eieio--class-object class))))) + (let* ((new-object (copy-record (eieio--class-default-object-cache + (eieio--class-object class))))) (if (and slots (let ((x (car slots))) (or (stringp x) (null x)))) @@ -806,7 +804,7 @@ first and modify the returned object.") (cl-defmethod clone ((obj eieio-default-superclass) &rest params) "Make a copy of OBJ, and then apply PARAMS." - (let ((nobj (copy-sequence obj))) + (let ((nobj (copy-record obj))) (if (stringp (car params)) (funcall (if eieio-backward-compatibility #'ignore #'message) "Obsolete name %S passed to clone" (pop params))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index fc5474ecc43..4a06ab25d3e 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -503,24 +503,30 @@ MATCH is the pattern that needs to be matched, of the form: (symbolp . vectorp) (symbolp . stringp) (symbolp . byte-code-function-p) + (symbolp . recordp) (integerp . consp) (integerp . arrayp) (integerp . vectorp) (integerp . stringp) (integerp . byte-code-function-p) + (integerp . recordp) (numberp . consp) (numberp . arrayp) (numberp . vectorp) (numberp . stringp) (numberp . byte-code-function-p) + (numberp . recordp) (consp . arrayp) (consp . atom) (consp . vectorp) (consp . stringp) (consp . byte-code-function-p) + (consp . recordp) (arrayp . byte-code-function-p) (vectorp . byte-code-function-p) + (vectorp . recordp) (stringp . vectorp) + (stringp . recordp) (stringp . byte-code-function-p))) (defun pcase--mutually-exclusive-p (pred1 pred2) -- cgit v1.2.3 From 2c68192c6b029bb839193c81cf2a16dad26305c6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 24 Mar 2017 09:21:52 -0400 Subject: Backward compatibility with pre-existing struct instances. * lisp/emacs-lisp/cl-lib.el (cl--old-struct-type-of): New function. (cl-old-struct-compat-mode): New minor mode. * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Pass `record' to cl-struct-define to signal use of record objects. * lisp/emacs-lisp/cl-preloaded.el (cl--struct-get-class, cl-struct-define): Enable legacy defstruct compatibility. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-old-struct, old-struct): New tests. * doc/lispref/elisp.texi, doc/lispref/records.texi: Document `old-struct-compat'. --- doc/lispref/elisp.texi | 1 + doc/lispref/records.texi | 17 ++++++++++++++++- lisp/emacs-lisp/cl-lib.el | 36 ++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/cl-macs.el | 4 ++-- lisp/emacs-lisp/cl-preloaded.el | 6 ++++++ test/lisp/emacs-lisp/cl-lib-tests.el | 23 +++++++++++++++++++++++ 6 files changed, 84 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 0f7efb6f187..3a348aae98e 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -423,6 +423,7 @@ Sequences, Arrays, and Vectors Records * Record Functions:: Functions for records. +* Backward Compatibility:: Compatibility for cl-defstruct. Hash Tables diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi index 822fd2bf36e..9a5d900cfc9 100644 --- a/doc/lispref/records.texi +++ b/doc/lispref/records.texi @@ -26,7 +26,8 @@ evaluating it is the same record. This does not evaluate or even examine the slots. @xref{Self-Evaluating Forms}. @menu -* Record Functions:: Functions for records. +* Record Functions:: Functions for records. +* Backward Compatibility:: Compatibility for cl-defstruct. @end menu @node Record Functions @@ -98,3 +99,17 @@ the copied record, are also visible in the original record. @end group @end example @end defun + +@node Backward Compatibility +@section Backward Compatibility + + Code compiled with older versions of @code{cl-defstruct} that +doesn't use records may run into problems when used in a new Emacs. +To alleviate this, Emacs detects when an old @code{cl-defstruct} is +used, and enables a mode in which @code{type-of} handles old struct +objects as if they were records. + +@defun cl-old-struct-compat-mode arg +If @var{arg} is positive, enable backward compatibility with old-style +structs. +@end defun diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 8c4455a3dad..1f8615fad3e 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -639,6 +639,42 @@ If ALIST is non-nil, the new pairs are prepended to it." (require 'cl-macs) (require 'cl-seq)) +(defun cl--old-struct-type-of (orig-fun object) + (or (and (vectorp object) + (let ((tag (aref object 0))) + (when (and (symbolp tag) + (string-prefix-p "cl-struct-" (symbol-name tag))) + (unless (eq (symbol-function tag) + :quick-object-witness-check) + ;; Old-style old-style struct: + ;; Convert to new-style old-style struct! + (let* ((type (intern (substring (symbol-name tag) + (length "cl-struct-")))) + (class (cl--struct-get-class type))) + ;; If the `cl-defstruct' was recompiled after the code + ;; which constructed `object', `cl--struct-get-class' may + ;; not have called `cl-struct-define' and setup the tag + ;; symbol for us. + (unless (eq (symbol-function tag) + :quick-object-witness-check) + (set tag class) + (fset tag :quick-object-witness-check)))) + (cl--class-name (symbol-value tag))))) + (funcall orig-fun object))) + +;;;###autoload +(define-minor-mode cl-old-struct-compat-mode + "Enable backward compatibility with old-style structs. +This can be needed when using code byte-compiled using the old +macro-expansion of `cl-defstruct' that used vectors objects instead +of record objects." + :global t + (cond + (cl-old-struct-compat-mode + (advice-add 'type-of :around #'cl--old-struct-type-of)) + (t + (advice-remove 'type-of #'cl--old-struct-type-of)))) + ;; Local variables: ;; byte-compile-dynamic: t ;; End: diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c282938a9bf..25c9f999920 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2847,8 +2847,8 @@ non-nil value, that slot cannot be set via `setf'. ;; struct as a parent. (eval-and-compile (cl-struct-define ',name ,docstring ',include-name - ',type ,(eq named t) ',descs ',tag-symbol ',tag - ',print-auto)) + ',(or type 'record) ,(eq named t) ',descs + ',tag-symbol ',tag ',print-auto)) ',name))) ;;; Add cl-struct support to pcase diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 7432dd4978d..ab6354de7cd 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -110,6 +110,12 @@ ;;;###autoload (defun cl-struct-define (name docstring parent type named slots children-sym tag print) + (unless type + ;; Legacy defstruct, using tagged vectors. Enable backward compatibility. + (cl-old-struct-compat-mode 1)) + (if (eq type 'record) + ;; Defstruct using record objects. + (setq type nil)) (cl-assert (or type (not named))) (if (boundp children-sym) (add-to-list children-sym tag) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 6b930a8d17a..564ddab67db 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -526,4 +526,27 @@ (should (eq (type-of x) 'foo)) (should (eql (foo-x x) 42)))) +(ert-deftest old-struct () + (cl-defstruct foo x) + (let ((x [cl-struct-foo]) + (saved cl-old-struct-compat-mode)) + (cl-old-struct-compat-mode -1) + (should (eq (type-of x) 'vector)) + + (cl-old-struct-compat-mode 1) + (let ((cl-struct-foo (cl--struct-get-class 'foo))) + (setf (symbol-function 'cl-struct-foo) :quick-object-witness-check) + (should (eq (type-of x) 'foo)) + (should (eq (type-of [foo]) 'vector))) + + (cl-old-struct-compat-mode (if saved 1 -1)))) + +(ert-deftest cl-lib-old-struct () + (let ((saved cl-old-struct-compat-mode)) + (cl-old-struct-compat-mode -1) + (cl-struct-define 'foo "" 'cl-structure-object nil nil nil + 'cl-struct-foo-tags 'cl-struct-foo t) + (should cl-old-struct-compat-mode) + (cl-old-struct-compat-mode (if saved 1 -1)))) + ;;; cl-lib.el ends here -- cgit v1.2.3 From 048133d4886d2e7fa547879478127edc9a9243f6 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 4 Apr 2017 19:04:52 -0400 Subject: Default to https for elpa.gnu.org if gnutls available * lisp/emacs-lisp/package.el (package-archives): Default to https for elpa.gnu.org if gnutls is available. Ref: http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00130.html --- lisp/emacs-lisp/package.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 8d5fac96cfb..fadd869c9d9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -194,14 +194,16 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")." :risky t :version "24.1") -(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) +(defcustom package-archives `(("gnu" . + ,(format "http%s://elpa.gnu.org/packages/" + (if (gnutls-available-p) "s" "")))) "An alist of archives from which to fetch. The default value points to the GNU Emacs package repository. Each element has the form (ID . LOCATION). ID is an archive name, as a string. LOCATION specifies the base location for the archive. - If it starts with \"http:\", it is treated as a HTTP URL; + If it starts with \"http(s):\", it is treated as an HTTP(S) URL; otherwise it should be an absolute directory name. (Other types of URL are currently not supported.) @@ -210,7 +212,7 @@ a package can run arbitrary code." :type '(alist :key-type (string :tag "Archive name") :value-type (string :tag "URL or directory name")) :risky t - :version "24.1") + :version "26.1") ; gnutls test (defcustom package-menu-hide-low-priority 'archive "If non-nil, hide low priority packages from the packages menu. -- cgit v1.2.3 From f981c611e26e906a88ee52806c78e07bbaa2b14b Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 4 Apr 2017 19:39:57 -0400 Subject: Advertise https for homepage of gnu.org packages * lisp/emacs-lisp/package.el (describe-package-1): Use https, if supported, for the homepage of packages on gnu.org. --- lisp/emacs-lisp/package.el | 7 +++++++ 1 file changed, 7 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fadd869c9d9..85acf60d08e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2354,6 +2354,13 @@ Otherwise no newline is inserted." (package-desc-name pkg)))) (insert "\n"))) (when homepage + ;; Prefer https for the homepage of packages on gnu.org. + (let ((gnu (cdr (assoc "gnu" package-archives)))) + (and gnu + (string-match-p "^https" gnu) + (string-match-p "^http://\\(elpa\\|www\\)\\.gnu\\.org/" homepage) + (setq homepage + (replace-regexp-in-string "^http" "https" homepage)))) (package--print-help-section "Homepage") (help-insert-xref-button homepage 'help-url homepage) (insert "\n")) -- cgit v1.2.3 From ab0a27517c9f9cc9d7a29171558247471ebe1152 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 4 Apr 2017 20:19:24 -0400 Subject: ; * lisp/emacs-lisp/package.el (describe-package-1): Tweak recent. --- lisp/emacs-lisp/package.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 85acf60d08e..769856262b4 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2355,12 +2355,11 @@ Otherwise no newline is inserted." (insert "\n"))) (when homepage ;; Prefer https for the homepage of packages on gnu.org. - (let ((gnu (cdr (assoc "gnu" package-archives)))) - (and gnu - (string-match-p "^https" gnu) - (string-match-p "^http://\\(elpa\\|www\\)\\.gnu\\.org/" homepage) - (setq homepage - (replace-regexp-in-string "^http" "https" homepage)))) + (if (string-match-p "^http://\\(elpa\\|www\\)\\.gnu\\.org/" homepage) + (let ((gnu (cdr (assoc "gnu" package-archives)))) + (and gnu (string-match-p "^https" gnu) + (setq homepage + (replace-regexp-in-string "^http" "https" homepage))))) (package--print-help-section "Homepage") (help-insert-xref-button homepage 'help-url homepage) (insert "\n")) -- cgit v1.2.3 From 473a42010c5b37e30d9bfb81cae77de6a95073eb Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Thu, 23 Mar 2017 11:32:59 -0600 Subject: make smie.el respect prog-first-column * lisp/emacs-lisp/smie.el (smie-indent-bob): Call prog-first-column. --- lisp/emacs-lisp/smie.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 4d02b751afe..7baccbc7524 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -123,6 +123,8 @@ (eval-when-compile (require 'cl-lib)) +(require 'prog-mode) + (defgroup smie nil "Simple Minded Indentation Engine." :group 'languages) @@ -1455,7 +1457,7 @@ in order to figure out the indentation of some other (further down) point." ;; Start the file at column 0. (save-excursion (forward-comment (- (point))) - (if (bobp) 0))) + (if (bobp) (prog-first-column)))) (defun smie-indent-close () ;; Align close paren with opening paren. -- cgit v1.2.3 From a2b3fea957440b8358d3632a4a05e41dee964b5d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 7 Apr 2017 18:54:40 -0700 Subject: Deprecate copy-record in favor of copy-sequence Since copy-sequence seems to be needed anyway for records, have it work on records, and remove copy-record as being superfluous. * doc/lispref/records.texi (Records, Record Functions): * lisp/emacs-lisp/cl-macs.el (cl-defstruct): * lisp/emacs-lisp/eieio.el (make-instance, clone): * test/src/alloc-tests.el (record-3): Use copy-sequence, not copy-record, to copy records. * doc/lispref/sequences.texi (Sequence Functions) (Array Functions): Document that aref and copy-sequence work on records. * etc/NEWS: Omit copy-record. * src/alloc.c (Fcopy_record): Remove. * src/data.c (Faref): Document that arg can be a record. * src/fns.c (Fcopy_sequence): Copy records, too. --- doc/lispref/records.texi | 37 +++---------------------------------- doc/lispref/sequences.texi | 23 +++++++++++------------ etc/NEWS | 6 +++--- lisp/emacs-lisp/cl-macs.el | 3 +-- lisp/emacs-lisp/eieio.el | 6 +++--- src/alloc.c | 14 -------------- src/data.c | 4 ++-- src/fns.c | 12 +++++++++--- test/src/alloc-tests.el | 2 +- 9 files changed, 33 insertions(+), 74 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi index 2533a8a4ca1..7cc36f14068 100644 --- a/doc/lispref/records.texi +++ b/doc/lispref/records.texi @@ -13,8 +13,9 @@ underlying representation of @code{cl-defstruct} and @code{defclass} instances. Internally, a record object is much like a vector; its slots can be -accessed using @code{aref}. However, the first slot is used to hold -its type as returned by @code{type-of}. Also, in the current +accessed using @code{aref} and it can be copied using +@code{copy-sequence}. However, the first slot is used to hold its +type as returned by @code{type-of}. Also, in the current implementation records can have at most 4096 slots, whereas vectors can be much larger. Like arrays, records use zero-origin indexing: the first slot has index 0. @@ -74,38 +75,6 @@ This function returns a new record with type @var{type} and @end example @end defun -@defun copy-record record -This function returns a shallow copy of @var{record}. The copy is the -same type as the original record, and it has the same slots in the -same order. - - Storing a new slot into the copy does not affect the original -@var{record}, and vice versa. However, the slots of the new record -are not copies; they are identical (@code{eq}) to the slots of the -original. Therefore, changes made within these slots, as found via -the copied record, are also visible in the original record. - -@example -@group -(setq x (record 'foo 1 2)) - @result{} #s(foo 1 2) -@end group -@group -(setq y (copy-record x)) - @result{} #s(foo 1 2) -@end group - -@group -(eq x y) - @result{} nil -@end group -@group -(equal x y) - @result{} t -@end group -@end example -@end defun - @node Backward Compatibility @section Backward Compatibility diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 2c88ee38cb1..93e8fa8a5fa 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -151,20 +151,19 @@ This function generalizes @code{aref} (@pxref{Array Functions}) and @code{nth} (@pxref{Definition of nth}). @end defun -@defun copy-sequence sequence +@defun copy-sequence seqr @cindex copying sequences -This function returns a copy of @var{sequence}. The copy is the same -type of object as the original sequence, and it has the same elements -in the same order. +This function returns a copy of @var{seqr}, which should be either a +sequence or a record. The copy is the same type of object as the +original, and it has the same elements in the same order. Storing a new element into the copy does not affect the original -@var{sequence}, and vice versa. However, the elements of the new -sequence are not copies; they are identical (@code{eq}) to the elements +@var{seqr}, and vice versa. However, the elements of the copy +are not copies; they are identical (@code{eq}) to the elements of the original. Therefore, changes made within these elements, as -found via the copied sequence, are also visible in the original -sequence. +found via the copy, are also visible in the original. -If the sequence is a string with text properties, the property list in +If the argument is a string with text properties, the property list in the copy is itself a copy, not shared with the original's property list. However, the actual values of the properties are shared. @xref{Text Properties}. @@ -1148,10 +1147,10 @@ vector, a string, a bool-vector or a char-table). @end example @end defun -@defun aref array index +@defun aref arr index @cindex array elements -This function returns the @var{index}th element of @var{array}. The -first element is at index zero. +This function returns the @var{index}th element of the array or record +@var{arr}. The first element is at index zero. @example @group diff --git a/etc/NEWS b/etc/NEWS index aaca229d5cd..e351abc159f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -863,9 +863,9 @@ instead of its first. +++ ** Emacs now supports records for user-defined types, via the new -functions 'copy-record', 'make-record', 'record', and 'recordp'. -Records are now used internally to represent cl-defstruct and defclass -instances, for example. +functions 'make-record', 'record', and 'recordp'. Records are now +used internally to represent cl-defstruct and defclass instances, for +example. +++ ** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 25c9f999920..ecb89fd51d7 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2808,8 +2808,7 @@ non-nil value, that slot cannot be set via `setf'. (setq slots (nreverse slots) defaults (nreverse defaults)) (and copier - (push `(defalias ',copier - ,(if (null type) '#'copy-record '#'copy-sequence)) + (push `(defalias ',copier #'copy-sequence) forms)) (if constructor (push (list constructor diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 858b2fdaa04..e21d46e5289 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -699,8 +699,8 @@ SLOTS are the initialization slots used by `initialize-instance'. This static method is called when an object is constructed. It allocates the vector used to represent an EIEIO object, and then calls `initialize-instance' on that object." - (let* ((new-object (copy-record (eieio--class-default-object-cache - (eieio--class-object class))))) + (let* ((new-object (copy-sequence (eieio--class-default-object-cache + (eieio--class-object class))))) (if (and slots (let ((x (car slots))) (or (stringp x) (null x)))) @@ -804,7 +804,7 @@ first and modify the returned object.") (cl-defmethod clone ((obj eieio-default-superclass) &rest params) "Make a copy of OBJ, and then apply PARAMS." - (let ((nobj (copy-record obj))) + (let ((nobj (copy-sequence obj))) (if (stringp (car params)) (funcall (if eieio-backward-compatibility #'ignore #'message) "Obsolete name %S passed to clone" (pop params))) diff --git a/src/alloc.c b/src/alloc.c index fad84b8a0b3..88a1a1ed660 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3440,19 +3440,6 @@ usage: (record TYPE &rest SLOTS) */) } -DEFUN ("copy-record", Fcopy_record, Scopy_record, 1, 1, 0, - doc: /* Return a new record that is a shallow copy of the argument RECORD. */) - (Lisp_Object record) -{ - CHECK_RECORD (record); - ptrdiff_t size = ASIZE (record) & PSEUDOVECTOR_SIZE_MASK; - struct Lisp_Vector *new = allocate_record (size); - memcpy (new->contents, XVECTOR (record)->contents, - size * sizeof (Lisp_Object)); - return make_lisp_ptr (new, Lisp_Vectorlike); -} - - DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, doc: /* Return a newly created vector of length LENGTH, with each element being INIT. See also the function `vector'. */) @@ -7523,7 +7510,6 @@ The time is in seconds as a floating point value. */); defsubr (&Slist); defsubr (&Svector); defsubr (&Srecord); - defsubr (&Scopy_record); defsubr (&Sbool_vector); defsubr (&Smake_byte_code); defsubr (&Smake_list); diff --git a/src/data.c b/src/data.c index 3ffca54658d..903e809d235 100644 --- a/src/data.c +++ b/src/data.c @@ -2266,8 +2266,8 @@ function chain of symbols. */) /* Extract and set vector and string elements. */ DEFUN ("aref", Faref, Saref, 2, 2, 0, - doc: /* Return the element of ARRAY at index IDX. -ARRAY may be a vector, a string, a char-table, a bool-vector, + doc: /* Return the element of ARG at index IDX. +ARG may be a vector, a string, a char-table, a bool-vector, a record, or a byte-code object. IDX starts at 0. */) (register Lisp_Object array, Lisp_Object idx) { diff --git a/src/fns.c b/src/fns.c index 47da5f8b4bc..2f07c2ccfb7 100644 --- a/src/fns.c +++ b/src/fns.c @@ -475,13 +475,19 @@ usage: (vconcat &rest SEQUENCES) */) DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, - doc: /* Return a copy of a list, vector, string or char-table. -The elements of a list or vector are not copied; they are shared -with the original. */) + doc: /* Return a copy of a list, vector, string, char-table or record. +The elements of a list, vector or record are not copied; they are +shared with the original. */) (Lisp_Object arg) { if (NILP (arg)) return arg; + if (RECORDP (arg)) + { + ptrdiff_t size = ASIZE (arg) & PSEUDOVECTOR_SIZE_MASK; + return Frecord (size, XVECTOR (arg)->contents); + } + if (CHAR_TABLE_P (arg)) { return copy_char_table (arg); diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el index 8b4ef8ce7d2..1cf1fc3be5c 100644 --- a/test/src/alloc-tests.el +++ b/test/src/alloc-tests.el @@ -47,7 +47,7 @@ (ert-deftest record-3 () (let* ((x (record 'foo 1 2 3)) - (y (copy-record x))) + (y (copy-sequence x))) (should-not (eq x y)) (dotimes (i 4) (should (eql (aref x i) (aref y i)))))) -- cgit v1.2.3 From fd4b83ca7c20a68060772ec13aadbe29db612b3f Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Sat, 8 Apr 2017 11:30:36 -0400 Subject: Adjust the edebug spec of if-let* This was fixed in Bug#24748, but now looking more closely, using gate in the spec seems correct. See (info "(elisp) Backtracking"). * lisp/emacs-lisp/subr-x.el (if-let*): Use gate in edebug spec. --- lisp/emacs-lisp/subr-x.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 1d729f94092..5ad482d1eac 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -126,7 +126,8 @@ In the special case you only want to bind a single value, VARLIST can just be a plain tuple. \n(fn VARLIST THEN ELSE...)" (declare (indent 2) - (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)] + (debug ([&or (&rest &or symbolp (gate symbolp &optional form)) + (symbolp form)] form body))) (when (and (<= (length bindings) 2) (not (listp (car bindings)))) -- cgit v1.2.3 From 695eacc21ea08b7fa080a232eadae881b5295bef Mon Sep 17 00:00:00 2001 From: Jens Lechtenboerger Date: Tue, 11 Apr 2017 12:27:37 +0300 Subject: Introduce customizable variable 'package-gnupghome-dir' * lisp/emacs-lisp/package.el (package-import-keyring) (package--check-signature-content, package-check-signature): Use new variable package-gnupghome-dir to control which GnuPG homedir to use. * doc/emacs/package.texi: Mention package-gnupghome-dir. * etc/NEWS: Mention package-gnupghome-dir. --- doc/emacs/package.texi | 15 +++++++++++---- etc/NEWS | 7 +++++++ lisp/emacs-lisp/package.el | 35 ++++++++++++++++++++++++++--------- 3 files changed, 44 insertions(+), 13 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index d6f88aaec3c..ecc955d3efe 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -193,15 +193,22 @@ and use only third parties that you think you can trust! can have in their packages by @dfn{signing} them. They generate a private/public pair of cryptographic keys, and use the private key to create a @dfn{signature file} for each package. With the public key, you -can use the signature files to verify who created the package, and -that it has not been modified. A valid signature is not a cast-iron +can use the signature files to verify the package creator and make sure +the package has not been tampered with. Signature verification uses +@uref{https://www.gnupg.org/, the GnuPG package} via the EasyPG +interface (@pxref{Top,, EasyPG, epa, Emacs EasyPG Assistant Manual}). +A valid signature is not a cast-iron guarantee that a package is not malicious, so you should still exercise caution. Package archives should provide instructions on how you can obtain their public key. One way is to download the key from a server such as @url{http://pgp.mit.edu/}. Use @kbd{M-x package-import-keyring} to import the key into Emacs. -Emacs stores package keys in the @file{gnupg} subdirectory -of @code{package-user-dir}. +Emacs stores package keys in the directory specified by the variable +@code{package-gnupghome-dir}, by default in the @file{gnupg} +subdirectory of @code{package-user-dir}, which causes Emacs to invoke +GnuPG with the option @samp{--homedir} when verifying signatures. +If @code{package-gnupghome-dir} is @code{nil}, GnuPG's option +@samp{--homedir} is omitted. The public key for the GNU package archive is distributed with Emacs, in the @file{etc/package-keyring.gpg}. Emacs uses it automatically. diff --git a/etc/NEWS b/etc/NEWS index b36db07360b..3c328ac58a2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -644,6 +644,13 @@ In 'visual-line-mode' it will look for the true beginning of a header while in non-'visual-line-mode' it will move the point to the indented header's value. +** Package + ++++ +*** The new variable 'package-gnupghome-dir' has been added to control +where the GnuPG home directory (used for signature verification) is +located and whether GnuPG's option "--homedir" is used or not. + ** Tramp +++ diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 769856262b4..bef1e8dd59b 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -307,6 +307,23 @@ contrast, `package-user-dir' contains packages for personal use." (declare-function epg-find-configuration "epg-config" (protocol &optional no-cache program-alist)) +(defcustom package-gnupghome-dir (expand-file-name "gnupg" package-user-dir) + "Directory containing GnuPG keyring or nil. +This variable specifies the GnuPG home directory used by package. +That directory is passed via the option \"--homedir\" to GnuPG. +If nil, do not use the option \"--homedir\", but stick with GnuPG's +default directory." + :type `(choice + (const + :tag "Default Emacs package management GnuPG home directory" + ,(expand-file-name "gnupg" package-user-dir)) + (const + :tag "Default GnuPG directory (GnuPG option --homedir not used)" + nil) + (directory :tag "A specific GnuPG --homedir")) + :risky t + :version "26.1") + (defcustom package-check-signature (if (and (require 'epg-config) (epg-find-configuration 'OpenPGP)) @@ -1209,9 +1226,9 @@ errors signaled by ERROR-FORM or by BODY). "Check signature CONTENT against STRING. SIG-FILE is the name of the signature file, used when signaling errors." - (let* ((context (epg-make-context 'OpenPGP)) - (homedir (expand-file-name "gnupg" package-user-dir))) - (setf (epg-context-home-directory context) homedir) + (let ((context (epg-make-context 'OpenPGP))) + (when package-gnupghome-dir + (setf (epg-context-home-directory context) package-gnupghome-dir)) (condition-case error (epg-verify-string context content string) (error (package--display-verify-error context sig-file) @@ -1238,7 +1255,7 @@ errors." "Check signature of the current buffer. Download the signature file from LOCATION by appending \".sig\" to FILE. -GnuPG keyring is located under \"gnupg\" in `package-user-dir'. +GnuPG keyring location depends on `package-gnupghome-dir'. STRING is the string to verify, it defaults to `buffer-string'. If ASYNC is non-nil, the download of the signature file is done asynchronously. @@ -1478,11 +1495,11 @@ taken care of by `package-initialize'." "Import keys from FILE." (interactive "fFile: ") (setq file (expand-file-name file)) - (let ((context (epg-make-context 'OpenPGP)) - (homedir (expand-file-name "gnupg" package-user-dir))) - (with-file-modes 448 - (make-directory homedir t)) - (setf (epg-context-home-directory context) homedir) + (let ((context (epg-make-context 'OpenPGP))) + (when package-gnupghome-dir + (with-file-modes 448 + (make-directory package-gnupghome-dir t)) + (setf (epg-context-home-directory context) package-gnupghome-dir)) (message "Importing %s..." (file-name-nondirectory file)) (epg-import-keys-from-file context file) (message "Importing %s...done" (file-name-nondirectory file)))) -- cgit v1.2.3 From ad128fee434a954da2ead75647b6396ddbf91f6a Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 13 Apr 2017 20:12:02 -0400 Subject: Create generated lisp files before main loaddefs.el This should improve reproducibility of lisp/loaddefs.el. * lisp/Makefile.in (gen-lisp): New phony target. ($(lisp)/loaddefs.el, compile-main): Depend on gen-lisp. * src/Makefile.in ($(leimdir)/leim-list.el): Depend on all of ../leim. * lisp/cedet/semantic.el (semantic-mode): * lisp/cedet/semantic/fw.el (top-level): * lisp/emacs-lisp/eieio-core.el (top-level): Robustify to generated input files maybe not yet existing. --- lisp/Makefile.in | 13 ++++++++++--- lisp/cedet/semantic.el | 7 ++++--- lisp/cedet/semantic/fw.el | 2 +- lisp/emacs-lisp/eieio-core.el | 2 +- src/Makefile.in | 2 +- 5 files changed, 17 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ec9ea16021e..b82f2c6918a 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -179,6 +179,10 @@ $(lisp)/finder-inf.el: # Note that we set no-update-autoloads in _generated_ leim files. # If you want to allow autoloads in such files, remove that, # and make this depend on leim. +# Actually this should depend on leim anyway, since no-update-autoloads +# files are still recorded in loaddefs. So we should ensure +# that all input files are generated before we create loaddefs. +# Otherwise making loaddefs again will change the output. # # Write to a temporary file in case we're doing a parallel build and a # CANNOT_DUMP-mode Emacs needs to read loaddefs at startup. @@ -192,7 +196,7 @@ $(lisp)/finder-inf.el: # slow; starting from an almost-correct content will enable the "only # update where necessary" feature of batch-update-autoloads. autoloads .PHONY: $(lisp)/loaddefs.el -$(lisp)/loaddefs.el: $(LOADDEFS) +$(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) @echo Directories for loaddefs: ${SUBDIRS_ALMOST} @if test -f $@ ; then cp $@ $(lisp)/loaddefs.tmp ; fi $(AM_V_GEN)$(emacs) -l autoload \ @@ -319,7 +323,7 @@ compile-targets: $(TARGETS) # Compile all the Elisp files that need it. Beware: it approximates # 'no-byte-compile', so watch out for false-positives! -compile-main: leim semantic compile-clean +compile-main: gen-lisp compile-clean @(cd $(lisp) && \ els=`echo "${SUBDIRS_REL} " | sed -e 's|/\./|/|g' -e 's|/\. | |g' -e 's| |/*.el |g'`; \ for el in $$els; do \ @@ -343,7 +347,10 @@ compile-clean: fi \ done -.PHONY: leim semantic +.PHONY: gen-lisp leim semantic + +gen-lisp: leim semantic + leim: $(MAKE) -C ../leim all EMACS="$(EMACS)" diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 6a264cabd65..c38afed3964 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -1116,8 +1116,9 @@ Semantic mode. ;; Enable all the global auxiliary minor modes in ;; `semantic-submode-list'. (dolist (mode semantic-submode-list) - (if (memq mode semantic-default-submodes) - (funcall mode 1))) + (and (memq mode semantic-default-submodes) + (fboundp mode) + (funcall mode 1))) (unless semantic-load-system-cache-loaded (setq semantic-load-system-cache-loaded t) (when (and (boundp 'semanticdb-default-system-save-directory) @@ -1139,7 +1140,7 @@ Semantic mode. (add-hook 'completion-at-point-functions 'semantic-analyze-completion-at-point-function) - (if global-ede-mode + (if (bound-and-true-p global-ede-mode) (define-key cedet-menu-map [cedet-menu-separator] '("--"))) (dolist (b (buffer-list)) (with-current-buffer b diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 3884cd09ccc..3527f3e6af8 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -30,7 +30,7 @@ ;; (require 'mode-local) (require 'eieio) -(load "semantic/loaddefs" nil 'nomessage) +(load "semantic/loaddefs" 'noerror 'nomessage) ;;; Compatibility ;; diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index c59f85d6fb2..7c149421d43 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -33,7 +33,7 @@ (require 'cl-lib) (require 'pcase) -(require 'eieio-loaddefs) +(require 'eieio-loaddefs nil t) ;;; ;; A few functions that are better in the official EIEIO src, but diff --git a/src/Makefile.in b/src/Makefile.in index 7890ea9878e..0b0d1768b5c 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -495,7 +495,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) $(leimdir)/leim-list.el: bootstrap-emacs$(EXEEXT) - $(MAKE) -C ../leim leim-list.el EMACS="$(bootstrap_exe)" + $(MAKE) -C ../leim all EMACS="$(bootstrap_exe)" ## FORCE it so that admin/unidata can decide whether these files ## are up-to-date. Although since charprop depends on bootstrap-emacs, -- cgit v1.2.3 From e8adf68824178ea25a5fda0c53233a42883de861 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 13 Apr 2017 20:15:34 -0400 Subject: Remove duplicate lisp-eval-defun definition * lisp/emacs-lisp/lisp-mode.el (lisp-eval-defun): Autoload rather than defining a stub. --- lisp/emacs-lisp/lisp-mode.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index b7a5eb774da..2e6e13f1dd1 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -725,11 +725,7 @@ or to switch back to an existing one." ;; Used in old LispM code. (defalias 'common-lisp-mode 'lisp-mode) -;; This will do unless inf-lisp.el is loaded. -(defun lisp-eval-defun (&optional _and-go) - "Send the current defun to the Lisp process made by \\[run-lisp]." - (interactive) - (error "Process lisp does not exist")) +(autoload 'lisp-eval-defun "inf-lisp" nil t) ;; May still be used by some external Lisp-mode variant. (define-obsolete-function-alias 'lisp-comment-indent -- cgit v1.2.3 From 86e512ed10d83e2d233cfb95bff68b6c05729686 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 13 Apr 2017 21:17:09 -0400 Subject: Use user-error for some ert.el errors * lisp/emacs-lisp/ert.el (ert-read-test-name, ert-delete-all-tests) (ert-results-find-test-at-point-other-window, ert-describe-test): Use user-error. --- lisp/emacs-lisp/ert.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index e7387e463cb..7eaf33a27dc 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1602,7 +1602,7 @@ Signals an error if no test name was read." (let ((sym (intern-soft input))) (if (ert-test-boundp sym) sym - (error "Input does not name a test"))))) + (user-error "Input does not name a test"))))) (defun ert-read-test-name-at-point (prompt) "Read the name of a test and return it as a symbol. @@ -1628,7 +1628,7 @@ Nothing more than an interactive interface to `ert-make-test-unbound'." (interactive) (when (called-interactively-p 'any) (unless (y-or-n-p "Delete all tests? ") - (error "Aborted"))) + (user-error "Aborted"))) ;; We can't use `ert-select-tests' here since that gives us only ;; test objects, and going from them back to the test name symbols ;; can fail if the `ert-test' defstruct has been redefined. @@ -2141,7 +2141,7 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (or (ert--results-test-node-or-null-at-point) - (error "No test at point"))) + (user-error "No test at point"))) (defun ert-results-next-test () "Move point to the next test. @@ -2191,7 +2191,7 @@ To be used in the ERT results buffer." (interactive) (let ((name (ert-test-at-point))) (unless name - (error "No test at point")) + (user-error "No test at point")) (ert-find-test-other-window name))) (defun ert--test-name-button-action (button) @@ -2352,7 +2352,7 @@ To be used in the ERT results buffer." (cl-destructuring-bind (test redefinition-state) (ert--results-test-at-point-allow-redefinition) (when (null test) - (error "No test at point")) + (user-error "No test at point")) (let* ((stats ert--results-stats) (progress-message (format "Running %stest %S" (cl-ecase redefinition-state @@ -2525,7 +2525,7 @@ To be used in the ERT results buffer." "Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test)." (interactive (list (ert-read-test-name-at-point "Describe test"))) (when (< emacs-major-version 24) - (error "Requires Emacs 24")) + (user-error "Requires Emacs 24 or later")) (let (test-name test-definition) (cl-etypecase test-or-test-name -- cgit v1.2.3 From 861824dbecc96339c68b1e15008a21c31e04721b Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 25 Mar 2017 22:41:34 -0400 Subject: Fix find-library-name for load-history entries with nil FILE-NAME (Bug#26355) * lisp/emacs-lisp/find-func.el (find-library--from-load-history): Rename from find-library--from-load-path. Check for `load-history' entries with nil FILE-NAMEs. Simplify by not double checking for suffixes and making use of `locate-file'. --- lisp/emacs-lisp/find-func.el | 48 ++++++++++++-------------------------------- 1 file changed, 13 insertions(+), 35 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 6699e3fd2b1..d0acc147752 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -43,7 +43,7 @@ ;;; Code: -(require 'seq) +(eval-when-compile (require 'cl-lib)) ;;; User variables: @@ -203,43 +203,21 @@ LIBRARY should be a string (the name of the library)." (locate-file rel (or find-function-source-path load-path) load-file-rep-suffixes))))) - (find-library--from-load-path library) + (find-library--from-load-history library) (error "Can't find library %s" library))) -(defun find-library--from-load-path (library) +(defun find-library--from-load-history (library) ;; In `load-history', the file may be ".elc", ".el", ".el.gz", and - ;; LIBRARY may be "foo.el" or "foo", so make sure that we get all - ;; potential matches, and then see whether any of them lead us to an - ;; ".el" or an ".el.gz" file. - (let* ((elc-regexp "\\.el\\(c\\(\\..*\\)?\\)\\'") - (suffix-regexp - (concat "\\(" - (mapconcat 'regexp-quote (find-library-suffixes) "\\'\\|") - "\\|" elc-regexp "\\)\\'")) - (potentials - (mapcar - (lambda (entry) - (if (string-match suffix-regexp (car entry)) - (replace-match "" t t (car entry)) - (car entry))) - (seq-filter - (lambda (entry) - (string-match - (concat "\\`" - (regexp-quote - (replace-regexp-in-string suffix-regexp "" library)) - suffix-regexp) - (file-name-nondirectory (car entry)))) - load-history))) - result) - (dolist (file potentials) - (dolist (suffix (find-library-suffixes)) - (when (not result) - (cond ((file-exists-p file) - (setq result file)) - ((file-exists-p (concat file suffix)) - (setq result (concat file suffix))))))) - result)) + ;; LIBRARY may be "foo.el" or "foo". + (let ((load-re + (concat "\\(" (regexp-quote (file-name-sans-extension library)) "\\)" + (regexp-opt (get-load-suffixes)) "\\'"))) + (cl-loop + for (file . _) in load-history thereis + (and (stringp file) (string-match load-re file) + (let ((dir (substring file 0 (match-beginning 1))) + (basename (match-string 1 file))) + (locate-file basename (list dir) (find-library-suffixes))))))) (defvar find-function-C-source-directory (let ((dir (expand-file-name "src" source-directory))) -- cgit v1.2.3 From 491531b20d05a0f2cc747aa01e697a764c34a99d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 18 Apr 2017 12:52:33 -0400 Subject: Avoid ert test failures * lisp/emacs-lisp/ert.el (ert--expand-should-1): Avoid errors related to undefined byte-compile-macro-environment. Somehow masked until very recently because loading seq (eg) loads bytecomp. http://hydra.nixos.org/build/51730765 --- lisp/emacs-lisp/ert.el | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7eaf33a27dc..f4c61e625d8 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -275,6 +275,7 @@ DATA is displayed to the user and should state the reason for skipping." (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." + (require 'bytecomp) ; FIXME? (let ((form (macroexpand form (append byte-compile-macro-environment (cond -- cgit v1.2.3 From 0f8343394675480f18c121520eed2203bbe1d6ec Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 18 Apr 2017 19:07:28 -0400 Subject: Avoid unnecessary loading of subr-x at run-time * lisp/doc-view.el, lisp/filenotify.el, lisp/info-look.el: * lisp/svg.el, lisp/emacs-lisp/byte-opt.el, lisp/net/shr.el: * lisp/textmodes/sgml-mode.el, test/lisp/dom-tests.el: No need to load subr-x at run-time. * lisp/gnus/nnheader.el: No need to load subr-x. ; * lisp/emacs-lisp/subr-x.el, lisp/gnus/message.el, lisp/net/nsm.el: ; Comments. --- lisp/doc-view.el | 2 +- lisp/emacs-lisp/byte-opt.el | 2 +- lisp/emacs-lisp/subr-x.el | 3 +++ lisp/filenotify.el | 2 +- lisp/gnus/message.el | 2 +- lisp/gnus/nnheader.el | 1 - lisp/info-look.el | 2 +- lisp/net/nsm.el | 2 +- lisp/net/shr.el | 2 +- lisp/svg.el | 2 +- lisp/textmodes/sgml-mode.el | 2 +- test/lisp/dom-tests.el | 2 +- 12 files changed, 13 insertions(+), 11 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 172ea163c18..2eb555821d9 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -140,7 +140,7 @@ (require 'dired) (require 'image-mode) (require 'jka-compr) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) ;;;; Customization Options diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 004f2e28653..2a240f502c4 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -185,7 +185,7 @@ (require 'bytecomp) (eval-when-compile (require 'cl-lib)) (require 'macroexp) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defun byte-compile-log-lap-1 (format &rest args) ;; Newer byte codes for stack-ref make the slot 0 non-nil again. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 5ad482d1eac..c0e5ae5984a 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -30,6 +30,9 @@ ;; Do not document these functions in the lispref. ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01006.html +;; NB If you want to use this library, it's almost always correct to use: +;; (eval-when-compile (require 'subr-x)) + ;;; Code: (require 'pcase) diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 8bbe348f332..0a45db82192 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -28,7 +28,7 @@ ;;; Code: (require 'cl-lib) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defconst file-notify--library (cond diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index a8f2b143f21..0f8fdfc9c7f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -49,7 +49,7 @@ (require 'mm-util) (require 'rfc2047) (require 'puny) -(require 'subr-x) +(require 'subr-x) ; read-multiple-choice (autoload 'mailclient-send-it "mailclient") diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index cc3dccea25f..4440f17c2bb 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -40,7 +40,6 @@ (require 'mail-utils) (require 'mm-util) (require 'gnus-util) -(require 'subr-x) (autoload 'gnus-range-add "gnus-range") (autoload 'gnus-remove-from-range "gnus-range") ;; FIXME none of these are used explicitly in this file. diff --git a/lisp/info-look.el b/lisp/info-look.el index 694bcb462ce..6963c782704 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -43,7 +43,7 @@ ;;; Code: (require 'info) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defgroup info-lookup nil "Major mode sensitive help agent." diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index ccb596f4ddc..8d3463ef0a5 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -25,7 +25,7 @@ ;;; Code: (require 'cl-lib) -(require 'subr-x) +(require 'subr-x) ; read-multiple-choice (defvar nsm-permanent-host-settings nil) (defvar nsm-temporary-host-settings nil) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 7472c4133ad..6b62a05227c 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -33,7 +33,7 @@ (eval-when-compile (require 'cl)) (eval-when-compile (require 'url)) ;For url-filename's setf handler. (require 'browse-url) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (require 'dom) (require 'seq) (require 'svg) diff --git a/lisp/svg.el b/lisp/svg.el index 65e031b3875..2295e5f8d49 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -27,7 +27,7 @@ (require 'cl-lib) (require 'xml) (require 'dom) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defun svg-create (width height &rest args) "Create a new, empty SVG image with dimensions WIDTHxHEIGHT. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index a6965fa32d1..1f99786ae7c 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -34,7 +34,7 @@ (require 'dom) (require 'seq) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (eval-when-compile (require 'skeleton) (require 'cl-lib)) diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 09114bd794a..32d231a47e5 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -26,7 +26,7 @@ (require 'dom) (require 'ert) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defun dom-tests--tree () "Return a DOM tree for testing." -- cgit v1.2.3 From b6a57fb80c49bcd9163966d612671a5256f3a1a8 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 18 Apr 2017 20:52:22 -0400 Subject: Tweak bytecomp's loading of cl-extra * lisp/emacs-lisp/bytecomp.el: Don't force load of cl-extra in a post-bootstrap emacs where cl-loaddefs does exist. --- lisp/emacs-lisp/bytecomp.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2c2996ebab4..f0f938da43f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,11 +124,13 @@ (require 'backquote) (require 'macroexp) (require 'cconv) +(require 'cl-lib) ;; During bootstrap, cl-loaddefs.el is not created yet, so loading cl-lib ;; doesn't setup autoloads for things like cl-every, which is why we have to -;; require cl-extra instead (bug#18804). -(require 'cl-extra) +;; require cl-extra as well (bug#18804). +(or (fboundp 'cl-every) + (require 'cl-extra)) (or (fboundp 'defsubst) ;; This really ought to be loaded already! -- cgit v1.2.3 From 41a5b76f79e2ef12a089e94406159e2d0e1fad1f Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 19 Apr 2017 16:28:48 -0400 Subject: Stop cl-lib loading pcase at runtime The cause was an unexpanded pcase-defmacro in cl-loaddefs. * lisp/emacs-lisp/autoload.el (make-autoload): Treat pcase-defmacro like defmacro. --- lisp/emacs-lisp/autoload.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d1f3c359f37..90e6aec4e75 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -164,7 +164,8 @@ expression, in which case we want to handle forms differently." ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode define-globalized-minor-mode defun defmacro easy-mmode-define-minor-mode define-minor-mode - define-inline cl-defun cl-defmacro cl-defgeneric)) + define-inline cl-defun cl-defmacro cl-defgeneric + pcase-defmacro)) (macrop car) (setq expand (let ((load-file-name file)) (macroexpand form))) (memq (car expand) '(progn prog1 defalias))) -- cgit v1.2.3 From 992e2019d3c535a61df064de25f664c01b8c309f Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 19 Apr 2017 16:32:04 -0400 Subject: Remove some explicit runtime loads of pcase Pcase is macros, so these should have used eval-when-compile. Anyway, pcase entry points are autoloaded, so the compiler handles it. * lisp/profiler.el, lisp/emacs-lisp/eieio-core.el: * lisp/emacs-lisp/generator.el, lisp/emacs-lisp/subr-x.el: * lisp/progmodes/xref.el: No need to require pcase. --- lisp/emacs-lisp/eieio-core.el | 1 - lisp/emacs-lisp/generator.el | 1 - lisp/emacs-lisp/subr-x.el | 1 - lisp/profiler.el | 1 - lisp/progmodes/xref.el | 1 - 5 files changed, 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 7c149421d43..dfe1c06bfaf 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -32,7 +32,6 @@ ;;; Code: (require 'cl-lib) -(require 'pcase) (require 'eieio-loaddefs nil t) ;;; diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index 2ab01404bad..c96b400809b 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -77,7 +77,6 @@ ;;; Code: (require 'cl-lib) -(require 'pcase) (defvar cps--bindings nil) (defvar cps--states nil) diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index c0e5ae5984a..440213eb38a 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -35,7 +35,6 @@ ;;; Code: -(require 'pcase) (eval-when-compile (require 'cl-lib)) diff --git a/lisp/profiler.el b/lisp/profiler.el index 8af2c50a4d4..15ff9b68ab9 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -27,7 +27,6 @@ ;;; Code: (require 'cl-lib) -(require 'pcase) (defgroup profiler nil "Emacs profiler." diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 1ca3e1d1539..d0636ba6355 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -69,7 +69,6 @@ (require 'cl-lib) (require 'eieio) (require 'ring) -(require 'pcase) (require 'project) (eval-when-compile -- cgit v1.2.3 From 4364a769b489c044c4e9eeac6cfbabcc844ab332 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 19 Apr 2017 23:01:43 -0400 Subject: Don't register "def" as an autoload prefix (Bug#26412) * lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload): Don't accept "def" as a prefix. --- lisp/emacs-lisp/autoload.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 90e6aec4e75..ca46f317677 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -547,7 +547,9 @@ Don't try to split prefixes that are already longer than that.") ;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes. (dolist (pair (prog1 prefixes (setq prefixes nil))) (let ((s (car pair))) - (if (or (> (length s) 2) ;Long enough! + (if (or (and (> (length s) 2) ; Long enough! + ;; But don't use "def" from deffoo-pkg-thing. + (not (string= "def" s))) (string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix? (radix-tree-lookup (cdr pair) "")) ;Nothing to expand! (push pair prefixes) ;Keep it as is. -- cgit v1.2.3 From b389379c87481b6bc647ceb4d323f861281cad72 Mon Sep 17 00:00:00 2001 From: Vibhav Pant Date: Thu, 20 Apr 2017 20:59:15 +0530 Subject: bytecomp: Don't inline functions that use byte-switch (Bug#26518) * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Don't inline FORM if the bytecode uses the byte-switch instruction. It is impossible to guess the correct stack depth while inlining such bytecode, resulting in faulty code. --- lisp/emacs-lisp/bytecomp.el | 86 ++++++++++++++++++++++++--------------------- 1 file changed, 46 insertions(+), 40 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f0f938da43f..aba07102055 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3204,47 +3204,53 @@ for symbols generated by the byte compiler itself." (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. ;; (fmin (if (numberp fargs) (logand fargs 127))) (alen (length (cdr form))) - (dynbinds ())) + (dynbinds ()) + lap) (fetch-bytecode fun) - (mapc 'byte-compile-form (cdr form)) - (unless fmax2 - ;; Old-style byte-code. - (cl-assert (listp fargs)) - (while fargs - (pcase (car fargs) - (`&optional (setq fargs (cdr fargs))) - (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) - (push (cadr fargs) dynbinds) - (setq fargs nil)) - (_ (push (pop fargs) dynbinds)))) - (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) - (cond - ((<= (+ alen alen) fmax2) - ;; Add missing &optional (or &rest) arguments. - (dotimes (_ (- (/ (1+ fmax2) 2) alen)) - (byte-compile-push-constant nil))) - ((zerop (logand fmax2 1)) - (byte-compile-report-error - (format "Too many arguments for inlined function %S" form)) - (byte-compile-discard (- alen (/ fmax2 2)))) - (t - ;; Turn &rest args into a list. - (let ((n (- alen (/ (1- fmax2) 2)))) - (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) - (if (< n 5) - (byte-compile-out - (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) - 0) - (byte-compile-out 'byte-listN n))))) - (mapc #'byte-compile-dynamic-variable-bind dynbinds) - (byte-compile-inline-lapcode - (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t) - (1+ start-depth)) - ;; Unbind dynamic variables. - (when dynbinds - (byte-compile-out 'byte-unbind (length dynbinds))) - (cl-assert (eq byte-compile-depth (1+ start-depth)) - nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) + (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) + ;; optimized switch bytecode makes it impossible to guess the correct + ;; `byte-compile-depth', which can result in incorrect inlined code. + ;; therefore, we do not inline code that uses the `byte-switch' + ;; instruction. + (if (assq 'byte-switch lap) + (byte-compile-normal-call form) + (mapc 'byte-compile-form (cdr form)) + (unless fmax2 + ;; Old-style byte-code. + (cl-assert (listp fargs)) + (while fargs + (pcase (car fargs) + (`&optional (setq fargs (cdr fargs))) + (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (push (cadr fargs) dynbinds) + (setq fargs nil)) + (_ (push (pop fargs) dynbinds)))) + (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) + (cond + ((<= (+ alen alen) fmax2) + ;; Add missing &optional (or &rest) arguments. + (dotimes (_ (- (/ (1+ fmax2) 2) alen)) + (byte-compile-push-constant nil))) + ((zerop (logand fmax2 1)) + (byte-compile-report-error + (format "Too many arguments for inlined function %S" form)) + (byte-compile-discard (- alen (/ fmax2 2)))) + (t + ;; Turn &rest args into a list. + (let ((n (- alen (/ (1- fmax2) 2)))) + (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) + (if (< n 5) + (byte-compile-out + (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) + 0) + (byte-compile-out 'byte-listN n))))) + (mapc #'byte-compile-dynamic-variable-bind dynbinds) + (byte-compile-inline-lapcode lap (1+ start-depth)) + ;; Unbind dynamic variables. + (when dynbinds + (byte-compile-out 'byte-unbind (length dynbinds))) + (cl-assert (eq byte-compile-depth (1+ start-depth)) + nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))) (defun byte-compile-check-variable (var access-type) "Do various error checks before a use of the variable VAR." -- cgit v1.2.3 From 89898e43c7ceef28bb3c2116b4d8a3ec96d9c8da Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 21 Apr 2017 12:12:42 -0400 Subject: * lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet Revert 0d112c00ba0ec14bd3014efcd3430b9ddcfe1fc1 (to fix bug#26325) and use a different fix for bug#26068. (cl--symbol-macro-key): New function. (cl--sm-macroexpand, cl-symbol-macrolet): Use it instead of `symbol-name`. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-symbol-macrolet): Failure is not expected any more. --- lisp/emacs-lisp/cl-macs.el | 17 +++++++++++++---- test/lisp/emacs-lisp/cl-lib-tests.el | 1 - 2 files changed, 13 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ecb89fd51d7..db1518ce611 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2047,6 +2047,12 @@ This is like `cl-flet', but for macros instead of functions. cl--old-macroexpand (symbol-function 'macroexpand))) +(defun cl--symbol-macro-key (sym) + "Return the key used in `macroexpand-all-environment' for symbol macro SYM." + ;; In the past we've used `symbol-name' instead, but that doesn't + ;; preserve the `eq'uality between different symbols of the same name. + `(:cl-symbol-macro . ,sym)) + (defun cl--sm-macroexpand (exp &optional env) "Special macro expander used inside `cl-symbol-macrolet'. This function replaces `macroexpand' during macro expansion @@ -2059,8 +2065,10 @@ except that it additionally expands symbol macros." (pcase exp ((pred symbolp) ;; Perform symbol-macro expansion. - (when (cdr (assq exp env)) - (setq exp (cadr (assq exp env))))) + ;; FIXME: Calling `cl--symbol-macro-key' for every var reference + ;; is a bit more costly than I'd like. + (when (cdr (assoc (cl--symbol-macro-key exp) env)) + (setq exp (cadr (assoc (cl--symbol-macro-key exp) env))))) (`(setq . ,_) ;; Convert setq to setf if required by symbol-macro expansion. (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) @@ -2078,7 +2086,7 @@ except that it additionally expands symbol macros." (let ((letf nil) (found nil) (nbs ())) (dolist (binding bindings) (let* ((var (if (symbolp binding) binding (car binding))) - (sm (assq var env))) + (sm (assoc (cl--symbol-macro-key var) env))) (push (if (not (cdr sm)) binding (let ((nexp (cadr sm))) @@ -2149,7 +2157,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). (let ((expansion ;; FIXME: For N bindings, this will traverse `body' N times! (macroexpand-all (macroexp-progn body) - (cons (list (caar bindings) + (cons (list (cl--symbol-macro-key + (caar bindings)) (cl-cadar bindings)) macroexpand-all-environment)))) (if (or (null (cdar bindings)) (cl-cddar bindings)) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 564ddab67db..65bd97f3b2d 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -495,7 +495,6 @@ (ert-deftest cl-lib-symbol-macrolet () ;; bug#26325 - :expected-result :failed (should (equal (cl-flet ((f (x) (+ x 5))) (let ((x 5)) (f (+ x 6)))) -- cgit v1.2.3 From a3b8618d79657af0d7fea9cb6fd914ccf0f67849 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 21 Apr 2017 12:14:59 -0400 Subject: Improve prefix handling for dash.el * lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload): Don't drop dash's "-" prefixes. --- lisp/emacs-lisp/autoload.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index ca46f317677..4d0554e6101 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -598,7 +598,8 @@ Don't try to split prefixes that are already longer than that.") (lambda (x) (let ((prefix (car x))) (if (or (> (length prefix) 2) ;Long enough! - (string-match ".[[:punct:]]\\'" prefix)) + (and (eq (length prefix) 2) + (string-match "[[:punct:]]" prefix))) prefix ;; Some packages really don't follow the rules. ;; Drop the most egregious cases such as the -- cgit v1.2.3 From 1c91bc9221d12618c9fb5507561dd35b7e392cb6 Mon Sep 17 00:00:00 2001 From: Vibhav Pant Date: Sat, 22 Apr 2017 20:38:53 +0530 Subject: b-c--cond-jump-table-info: Use correct body for singleton clauses * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table-info): When a clause's body consists of a single constant expression, use that expression as the body to be compiled. This fixes switch bytecode evaluating to nil to such clauses. --- lisp/emacs-lisp/bytecomp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index aba07102055..15dc24060aa 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4066,8 +4066,8 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" ;; discard duplicate clauses (not (assq obj2 cases))) (push (list (if (consp obj2) (eval obj2) obj2) body) cases) - (if (eq condition t) - (progn (push (list 'default body) cases) + (if (and (macroexp-const-p condition) condition) + (progn (push (list 'default (or body `(,condition))) cases) (throw 'break t)) (setq ok nil) (throw 'break nil)))))) -- cgit v1.2.3 From 43c84577a3055d5ddf1f5d1b999e6ecca6139f60 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 12 Mar 2017 23:59:19 -0400 Subject: Don't reparse the sexp in indent-sexp (Bug#25122) * lisp/emacs-lisp/lisp-mode.el (calculate-lisp-indent): Let PARSE-START be a parse state that can be reused. (indent-sexp): Pass the running parse state to calculate-lisp-indent instead of the sexp beginning position. Saving the CONTAINING-SEXP-START returned by `calculate-lisp-indent' is no longer needed. Don't bother stopping if we don't descend below init-depth, since we now alway scan the whole buffer (via syntax-ppss) anyway. * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp): Add blank line to test case. --- lisp/emacs-lisp/lisp-mode.el | 76 +++++++++++++++++---------------- test/lisp/emacs-lisp/lisp-mode-tests.el | 5 ++- 2 files changed, 43 insertions(+), 38 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 2e6e13f1dd1..607a4c3d11d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -785,6 +785,10 @@ In usual case returns an integer: the column to indent to. If the value is nil, that means don't change the indentation because the line starts inside a string. +PARSE-START may be a buffer position to start parsing from, or a +parse state as returned by calling `parse-partial-sexp' up to the +beginning of the current line. + The value can also be a list of the form (COLUMN CONTAINING-SEXP-START). This means that following lines at the same level of indentation should not necessarily be indented the same as this line. @@ -798,12 +802,14 @@ is the buffer position of the start of the containing expression." (desired-indent nil) (retry t) calculate-lisp-indent-last-sexp containing-sexp) - (if parse-start - (goto-char parse-start) - (beginning-of-defun)) - ;; Find outermost containing sexp - (while (< (point) indent-point) - (setq state (parse-partial-sexp (point) indent-point 0))) + (cond ((or (markerp parse-start) (integerp parse-start)) + (goto-char parse-start)) + ((null parse-start) (beginning-of-defun)) + (t (setq state parse-start))) + (unless state + ;; Find outermost containing sexp + (while (< (point) indent-point) + (setq state (parse-partial-sexp (point) indent-point 0)))) ;; Find innermost containing sexp (while (and retry state @@ -1074,11 +1080,6 @@ If optional arg ENDPOS is given, indent each line, stopping when ENDPOS is encountered." (interactive) (let* ((indent-stack (list nil)) - ;; If ENDPOS is non-nil, use beginning of defun as STARTING-POINT. - ;; If ENDPOS is nil, it is safe not to scan before point - ;; since every line we indent is more deeply nested than point is. - (starting-point (save-excursion (if endpos (beginning-of-defun)) - (point))) ;; Use `syntax-ppss' to get initial state so we don't get ;; confused by starting inside a string. We don't use ;; `syntax-ppss' in the loop, because this is measurably @@ -1087,8 +1088,7 @@ ENDPOS is encountered." (init-depth (car state)) (next-depth init-depth) (last-depth init-depth) - (last-syntax-point (point)) - (real-endpos endpos)) + (last-syntax-point (point))) (unless endpos ;; Get error now if we don't have a complete sexp after point. (save-excursion (forward-sexp 1) @@ -1098,16 +1098,21 @@ ENDPOS is encountered." (save-excursion (while (< (point) endpos) ;; Parse this line so we can learn the state to indent the - ;; next line. - (while (progn - (setq state (parse-partial-sexp - last-syntax-point (progn (end-of-line) (point)) - nil nil state)) - ;; Skip over newlines within strings. - (nth 3 state)) - (setq state (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table)) - (setq last-syntax-point (point))) + ;; next line. Preserve element 2 of the state (last sexp) for + ;; `calculate-lisp-indent'. + (let ((last-sexp (nth 2 state))) + (while (progn + (setq state (parse-partial-sexp + last-syntax-point (progn (end-of-line) (point)) + nil nil state)) + (setq last-sexp (or (nth 2 state) last-sexp)) + ;; Skip over newlines within strings. + (nth 3 state)) + (setq state (parse-partial-sexp (point) (point-max) + nil nil state 'syntax-table)) + (setq last-sexp (or (nth 2 state) last-sexp)) + (setq last-syntax-point (point))) + (setf (nth 2 state) last-sexp)) (setq next-depth (car state)) ;; If the line contains a comment indent it now with ;; `indent-for-comment'. @@ -1120,9 +1125,9 @@ ENDPOS is encountered." (make-list (- init-depth next-depth) nil)) last-depth (- last-depth next-depth) next-depth init-depth)) + ;; Now indent the next line according to what we learned from + ;; parsing the previous one. (forward-line 1) - (when (and (not real-endpos) (<= next-depth init-depth)) - (goto-char endpos)) (when (< (point) endpos) (let ((depth-delta (- next-depth last-depth))) (cond ((< depth-delta 0) @@ -1131,28 +1136,25 @@ ENDPOS is encountered." (setq indent-stack (nconc (make-list depth-delta nil) indent-stack)))) (setq last-depth next-depth)) - ;; Now indent the next line according - ;; to what we learned from parsing the previous one. - (skip-chars-forward " \t") ;; But not if the line is blank, or just a comment (we ;; already called `indent-for-comment' above). + (skip-chars-forward " \t") (unless (or (eolp) (eq (char-syntax (char-after)) ?<)) - (let ((this-indent (car indent-stack))) - (when (listp this-indent) - (let ((val (calculate-lisp-indent - (or (car this-indent) starting-point)))) - (setq - this-indent + (indent-line-to + (or (car indent-stack) + ;; The state here is actually to the end of the + ;; previous line, but that's fine for our purposes. + ;; And parsing over the newline would only destroy + ;; element 2 (last sexp position). + (let ((val (calculate-lisp-indent state))) (cond ((integerp val) (setf (car indent-stack) val)) ((consp val) ; (COLUMN CONTAINING-SEXP-START) - (setf (car indent-stack) (cdr val)) (car val)) ;; `calculate-lisp-indent' only returns nil ;; when we're in a string, but this won't ;; happen because we skip strings above. - (t (error "This shouldn't happen!")))))) - (indent-line-to this-indent)))))))) + (t (error "This shouldn't happen!")))))))))))) (defun indent-pp-sexp (&optional arg) "Indent each line of the list starting just after point, or prettyprint it. diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 8e3f2e185cf..27f0bb5ec13 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -31,6 +31,9 @@ 1 2) 2) + (fun arg1 + + arg2) (1 \"string noindent\" (\"string2 @@ -58,7 +61,7 @@ noindent\" 3 (save-excursion (let ((n 0)) (while (not (eobp)) - (unless (looking-at "noindent") + (unless (looking-at "noindent\\|^[[:blank:]]*$") (insert (make-string n ?\s))) (cl-incf n) (forward-line)))) -- cgit v1.2.3 From 8bb5d7adaf45264900385530c7f76175ba490a77 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 15 Mar 2017 22:35:47 -0400 Subject: * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Clean up marker. --- lisp/emacs-lisp/lisp-mode.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 607a4c3d11d..810fc95614d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1089,12 +1089,13 @@ ENDPOS is encountered." (next-depth init-depth) (last-depth init-depth) (last-syntax-point (point))) - (unless endpos - ;; Get error now if we don't have a complete sexp after point. - (save-excursion (forward-sexp 1) - ;; We need a marker because we modify the buffer - ;; text preceding endpos. - (setq endpos (point-marker)))) + ;; We need a marker because we modify the buffer + ;; text preceding endpos. + (setq endpos (copy-marker + (if endpos endpos + ;; Get error now if we don't have a complete sexp + ;; after point. + (save-excursion (forward-sexp 1) (point))))) (save-excursion (while (< (point) endpos) ;; Parse this line so we can learn the state to indent the @@ -1154,7 +1155,8 @@ ENDPOS is encountered." ;; `calculate-lisp-indent' only returns nil ;; when we're in a string, but this won't ;; happen because we skip strings above. - (t (error "This shouldn't happen!")))))))))))) + (t (error "This shouldn't happen!")))))))))) + (move-marker endpos nil))) (defun indent-pp-sexp (&optional arg) "Indent each line of the list starting just after point, or prettyprint it. -- cgit v1.2.3 From 2f6769f9cdb799e880fdcc09057353a0a2349bfc Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 15 Mar 2017 21:59:13 -0400 Subject: Remove ignored argument from lisp-indent-line * lisp/emacs-lisp/lisp-mode.el (lisp-indent-line): Remove WHOLE-EXP argument, the behavior has long since been handled in `indent-for-tab-command'. Also remove redundant `beg' and `shift-amt' variables and use `indent-line-to'. --- lisp/emacs-lisp/lisp-mode.el | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 810fc95614d..89d5659f300 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -748,14 +748,12 @@ function is `common-lisp-indent-function'." :type 'function :group 'lisp) -(defun lisp-indent-line (&optional _whole-exp) - "Indent current line as Lisp code. -With argument, indent any additional lines of the same expression -rigidly along with this one." - (interactive "P") - (let ((indent (calculate-lisp-indent)) shift-amt - (pos (- (point-max) (point))) - (beg (progn (beginning-of-line) (point)))) +(defun lisp-indent-line () + "Indent current line as Lisp code." + (interactive) + (let ((indent (calculate-lisp-indent)) + (pos (- (point-max) (point)))) + (beginning-of-line) (skip-chars-forward " \t") (if (or (null indent) (looking-at "\\s<\\s<\\s<")) ;; Don't alter indentation of a ;;; comment line @@ -767,11 +765,7 @@ rigidly along with this one." ;; as comment lines, not as code. (progn (indent-for-comment) (forward-char -1)) (if (listp indent) (setq indent (car indent))) - (setq shift-amt (- indent (current-column))) - (if (zerop shift-amt) - nil - (delete-region beg (point)) - (indent-to indent))) + (indent-line-to indent)) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. (if (> (- (point-max) pos) (point)) -- cgit v1.2.3 From 4713dd425beac5cb459704e67dcb8f6faf714375 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 15 Mar 2017 22:27:27 -0400 Subject: Add new `lisp-indent-region' that doesn't reparse the code. Both `lisp-indent-region' and `lisp-indent-line' now use `syntax-ppss' to get initial state, so they will no longer indent string literal contents. * lisp/emacs-lisp/lisp-mode.el (lisp-ppss): New function, like `syntax-ppss', but with a more dependable item 2. (lisp-indent-region): New function, like `indent-region-line-by-line' but additionally keep a running parse state to avoid reparsing the code repeatedly. Use `lisp-ppss' to get initial state. (lisp-indent-line): Take optional PARSE-STATE argument, pass it to `calculate-lisp-indent', use `lisp-ppss' if not given. (lisp-mode-variables): Set `indent-region-function' to `lisp-indent-region'. --- lisp/emacs-lisp/lisp-mode.el | 48 ++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 44 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 89d5659f300..54d916887cd 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -594,6 +594,7 @@ font-lock keywords will not be case sensitive." ;; I believe that newcomment's auto-fill code properly deals with it -stef ;;(set (make-local-variable 'adaptive-fill-mode) nil) (setq-local indent-line-function 'lisp-indent-line) + (setq-local indent-region-function 'lisp-indent-region) (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") (setq-local outline-level 'lisp-outline-level) (setq-local add-log-current-defun-function #'lisp-current-defun-name) @@ -748,12 +749,51 @@ function is `common-lisp-indent-function'." :type 'function :group 'lisp) -(defun lisp-indent-line () +(defun lisp-ppss (&optional pos) + "Return Parse-Partial-Sexp State at POS, defaulting to point. +Like to `syntax-ppss' but includes the character address of the +last complete sexp in the innermost containing list at position +2 (counting from 0). This is important for lisp indentation." + (unless pos (setq pos (point))) + (let ((pss (syntax-ppss pos))) + (if (nth 9 pss) + (parse-partial-sexp (car (last (nth 9 pss))) pos) + pss))) + +(defun lisp-indent-region (start end) + "Indent region as Lisp code, efficiently." + (save-excursion + (setq end (copy-marker end)) + (goto-char start) + ;; The default `indent-region-line-by-line' doesn't hold a running + ;; parse state, which forces each indent call to reparse from the + ;; beginning. That has O(n^2) complexity. + (let* ((parse-state (lisp-ppss start)) + (last-syntax-point start) + (pr (unless (minibufferp) + (make-progress-reporter "Indenting region..." (point) end)))) + (while (< (point) end) + (unless (and (bolp) (eolp)) + (lisp-indent-line parse-state)) + (forward-line 1) + (let ((last-sexp (nth 2 parse-state))) + (setq parse-state (parse-partial-sexp last-syntax-point (point) + nil nil parse-state)) + ;; It's important to preserve last sexp location for + ;; `calculate-lisp-indent'. + (unless (nth 2 parse-state) + (setf (nth 2 parse-state) last-sexp)) + (setq last-syntax-point (point))) + (and pr (progress-reporter-update pr (point)))) + (and pr (progress-reporter-done pr)) + (move-marker end nil)))) + +(defun lisp-indent-line (&optional parse-state) "Indent current line as Lisp code." (interactive) - (let ((indent (calculate-lisp-indent)) - (pos (- (point-max) (point)))) - (beginning-of-line) + (let ((pos (- (point-max) (point))) + (indent (progn (beginning-of-line) + (calculate-lisp-indent (or parse-state (lisp-ppss)))))) (skip-chars-forward " \t") (if (or (null indent) (looking-at "\\s<\\s<\\s<")) ;; Don't alter indentation of a ;;; comment line -- cgit v1.2.3 From b20d05c6d76ddaf7e70da1430c9aac56ef1d6b31 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 4 Apr 2017 23:48:42 -0400 Subject: Don't require bytecomp for running ert tests "Fix ert-tests when running compiled" 2016-12-06 accidentally introduced a dependency on `bytecomp' into `ert'. As mentioned in "Avoid ert test failures" 2017-04-18, the accidental dependency of ert on bytecomp was masked by loading other libraries until recently. * lisp/emacs-lisp/ert.el (ert--expand-should-1): Only use `byte-compile-macro-environment' if it's bound. * test/src/eval-tests.el: Add defvar for dynamic variable `byte-compile-debug'. --- lisp/emacs-lisp/ert.el | 4 ++-- test/src/eval-tests.el | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index f4c61e625d8..280b76acfe4 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -275,9 +275,9 @@ DATA is displayed to the user and should state the reason for skipping." (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." - (require 'bytecomp) ; FIXME? (let ((form - (macroexpand form (append byte-compile-macro-environment + (macroexpand form (append (bound-and-true-p + byte-compile-macro-environment) (cond ((boundp 'macroexpand-all-environment) macroexpand-all-environment) diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 95655eac826..03f408716b1 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -32,6 +32,8 @@ ;; This should not crash. (should-error (funcall '(closure)) :type 'invalid-function)) +(defvar byte-compile-debug) + (ert-deftest eval-tests--bugs-24912-and-24913 () "Checks that Emacs doesn’t accept weird argument lists. Bug#24912 and Bug#24913." -- cgit v1.2.3 From c2bbdc3316487e34eba1470dd059c0c290431e00 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 30 Jun 2015 22:38:35 +0200 Subject: Warn about missing backslashes during load * src/lread.c (load_warn_unescaped_character_literals, Fload, read1) (syms_of_lread): Warn if unescaped character literals are found (Bug#20152). * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Check for unescaped character literals during byte compilation. * test/src/lread-tests.el (lread-tests--unescaped-char-literals): New unit test. (lread-tests--with-temp-file, lread-tests--last-message): Helper functions for unit test. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals): New unit test. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file): Helper macro for unit test. --- lisp/emacs-lisp/bytecomp.el | 7 ++++++ src/lread.c | 40 ++++++++++++++++++++++++++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 23 +++++++++++++++++++ test/src/lread-tests.el | 26 ++++++++++++++++++++++ 4 files changed, 96 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 15dc24060aa..25102548a9d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2027,12 +2027,19 @@ With argument ARG, insert value in current buffer after the form." (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) (let* ((old-style-backquotes nil) + (lread--unescaped-character-literals nil) (form (read inbuffer))) ;; Warn about the use of old-style backquotes. (when old-style-backquotes (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) + (when lread--unescaped-character-literals + (byte-compile-warn + "unescaped character literals %s detected!" + (mapconcat #'string + (sort lread--unescaped-character-literals #'<) + ", "))) (byte-compile-toplevel-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) diff --git a/src/lread.c b/src/lread.c index 3b2e123dd39..6467043b1da 100644 --- a/src/lread.c +++ b/src/lread.c @@ -955,6 +955,21 @@ load_warn_old_style_backquotes (Lisp_Object file) } } +static void +load_warn_unescaped_character_literals (Lisp_Object file) +{ + if (NILP (Vlread_unescaped_character_literals)) return; + CHECK_CONS (Vlread_unescaped_character_literals); + AUTO_STRING (format, + "Loading `%s': unescaped character literals %s detected!"); + AUTO_STRING (separator, ", "); + CALLN (Fmessage, + format, file, + Fmapconcat (Qstring, + Fsort (Vlread_unescaped_character_literals, Qlss), + separator)); +} + DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, doc: /* Return the suffixes that `load' should try if a suffix is \ required. @@ -1202,6 +1217,11 @@ Return t if the file exists and loads successfully. */) specbind (Qold_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); + /* Check for the presence of unescaped character literals and warn + about them. */ + specbind (Qlread_unescaped_character_literals, Qnil); + record_unwind_protect (load_warn_unescaped_character_literals, file); + int is_elc; if ((is_elc = suffix_p (found, ".elc")) != 0 /* version = 1 means the file is empty, in which case we can @@ -3092,6 +3112,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == ' ' || c == '\t') return make_number (c); + if (c == '(' || c == ')' || c == '[' || c == ']' + || c == '"' || c == ';') + { + CHECK_LIST (Vlread_unescaped_character_literals); + Lisp_Object char_obj = make_natnum (c); + if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals))) + Vlread_unescaped_character_literals = + Fcons (char_obj, Vlread_unescaped_character_literals); + } + if (c == '\\') c = read_escape (readcharfun, 0); modifiers = c & CHAR_MODIFIER_MASK; @@ -4815,6 +4845,16 @@ variables, this must be set in the first line of a file. */); Vold_style_backquotes = Qnil; DEFSYM (Qold_style_backquotes, "old-style-backquotes"); + DEFVAR_LISP ("lread--unescaped-character-literals", + Vlread_unescaped_character_literals, + doc: /* List of deprecated unescaped character literals encountered by `read'. +For internal use only. */); + Vlread_unescaped_character_literals = Qnil; + DEFSYM (Qlread_unescaped_character_literals, + "lread--unescaped-character-literals"); + + DEFSYM (Qlss, "<"); + DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, doc: /* Non-nil means `load' prefers the newest version of a file. This applies when a filename suffix is not explicitly specified and diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e8feec31d26..3624904753c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -506,6 +506,29 @@ bytecompiled code, and their results compared.") (dolist (pat bytecomp-lexbind-tests) (should (bytecomp-lexbind-check-1 pat)))) +(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) + (declare (indent 1)) + (cl-check-type file-name-var symbol) + `(let ((,file-name-var (make-temp-file "emacs"))) + (unwind-protect + (progn ,@body) + (delete-file ,file-name-var)))) + +(ert-deftest bytecomp-tests--unescaped-char-literals () + "Check that byte compiling warns about unescaped character +literals (Bug#20852)." + (should (boundp 'lread--unescaped-character-literals)) + (bytecomp-tests--with-temp-file source + (write-region "(list ?) ?( ?; ?\" ?[ ?])" nil source) + (bytecomp-tests--with-temp-file destination + (let* ((byte-compile-dest-file-function (lambda (_) destination)) + (byte-compile-error-on-warn t) + (byte-compile-debug t) + (err (should-error (byte-compile-file source)))) + (should (equal (cdr err) + (list (concat "unescaped character literals " + "\", (, ), ;, [, ] detected!")))))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 27f967f045b..84342348d45 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -116,4 +116,30 @@ (should (equal '(#s(foo) #s(foo)) (read "(#1=#s(foo) #1#)")))) +(defmacro lread-tests--with-temp-file (file-name-var &rest body) + (declare (indent 1)) + (cl-check-type file-name-var symbol) + `(let ((,file-name-var (make-temp-file "emacs"))) + (unwind-protect + (progn ,@body) + (delete-file ,file-name-var)))) + +(defun lread-tests--last-message () + (with-current-buffer "*Messages*" + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "\n") + (buffer-substring (line-beginning-position) (point))))) + +(ert-deftest lread-tests--unescaped-char-literals () + "Check that loading warns about unescaped character +literals (Bug#20852)." + (lread-tests--with-temp-file file-name + (write-region "?) ?( ?; ?\" ?[ ?]" nil file-name) + (should (equal (load file-name nil :nomessage :nosuffix) t)) + (should (equal (lread-tests--last-message) + (concat (format-message "Loading `%s': " file-name) + "unescaped character literals " + "\", (, ), ;, [, ] detected!"))))) + ;;; lread-tests.el ends here -- cgit v1.2.3 From d895f6c12f474476321322ed08e7c768be006287 Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Tue, 2 May 2017 10:19:12 +0300 Subject: Fix Edebug specs for 'cl-defmethod' and 'defmethod' * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Change Edebug spec to make Edebug generate a new symbol for each method (Bug#24753) and to support a string following :extra (Bug#23995). * lisp/emacs-lisp/eieio-compat.el (defmethod): Change Edebug spec to make Edebug generate a new symbol for each method (Bug#24753). --- lisp/emacs-lisp/cl-generic.el | 7 ++++--- lisp/emacs-lisp/eieio-compat.el | 4 ++-- 2 files changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index e15c94242fb..107d520b1e9 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -413,10 +413,11 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (declare (doc-string 3) (indent 2) (debug (&define ; this means we are defining something - [&or name ("setf" :name setf name)] + [&or symbolp ("setf" symbolp)] ;; ^^ This is the methods symbol - [ &optional keywordp ] ; this is key :before etc - list ; arguments + [ &optional keywordp ; this is key :before etc + &optional stringp ] ; :extra can be followed by a string + listp ; arguments [ &optional stringp ] ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index d6eb0b416f8..fe65ae02623 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -105,10 +105,10 @@ Summary: (declare (doc-string 3) (obsolete cl-defmethod "25.1") (debug (&define ; this means we are defining something - [&or name ("setf" :name setf name)] + [&or symbolp ("setf" symbolp)] ;; ^^ This is the methods symbol [ &optional symbolp ] ; this is key :before etc - list ; arguments + listp ; arguments [ &optional stringp ] ; documentation string def-body ; part to be debugged ))) -- cgit v1.2.3 From 88f96e69cfcd265f2ef0db3e134ac9e29e64ec3e Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Mon, 17 Apr 2017 11:01:39 +0200 Subject: Add seq-set-equal-p to test for set equality * lisp/emacs-lisp/seq.el (seq-set-equal-p): Add function to compare two lists as if they were sets. * test/lisp/emacs-lisp/seq-tests.el (test-seq-set-equal-p): Add test for seq-set-equal-p. --- doc/lispref/sequences.texi | 27 +++++++++++++++++++++++++++ etc/NEWS | 3 +++ lisp/emacs-lisp/seq.el | 6 ++++++ test/lisp/emacs-lisp/seq-tests.el | 25 +++++++++++++++++++++++++ 4 files changed, 61 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index 93e8fa8a5fa..c7cf9f5e1af 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -792,6 +792,33 @@ it is a function of two arguments to use instead of the default @code{equal}. @end defun +@defun seq-set-equal-p sequence1 sequence2 &optional testfn +This function checks whether @var{sequence1} and @var{sequence2} +contain the same elements, regardless of the order. If the optional +argument @var{testfn} is non-@code{nil}, it is a function of two +arguments to use instead of the default @code{equal}. + +@example +@group +(seq-set-equal-p '(a b c) '(c b a)) +@result{} t +@end group +@group +(seq-set-equal-p '(a b c) '(c b)) +@result{} nil +@end group +@group +(seq-set-equal-p '("a" "b" "c") '("c" "b" "a")) +@result{} t +@end group +@group +(seq-set-equal-p '("a" "b" "c") '("c" "b" "a") #'eq) +@result{} nil +@end group +@end example + +@end defun + @defun seq-position sequence elt &optional function This function returns the index of the first element in @var{sequence} that is equal to @var{elt}. If the optional argument diff --git a/etc/NEWS b/etc/NEWS index d79eecf7676..73c088c962e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -899,6 +899,9 @@ instead of its first. * Lisp Changes in Emacs 26.1 +** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 +contain the same elements, regardless of the order. + +++ ** Emacs now supports records for user-defined types, via the new functions 'make-record', 'record', and 'recordp'. Records are now diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 10de2484798..963a1ddf964 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -355,6 +355,12 @@ Equality is defined by TESTFN if non-nil or by `equal' if nil." e)) sequence)) +(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) + "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of order. +Equality is defined by TESTFN if non-nil or by `equal' if nil." + (and (seq-every-p (lambda (item1) (seq-contains sequence2 item1 testfn)) sequence1) + (seq-every-p (lambda (item2) (seq-contains sequence1 item2 testfn)) sequence2))) + (cl-defgeneric seq-position (sequence elt &optional testfn) "Return the index of the first element in SEQUENCE that is equal to ELT. Equality is defined by TESTFN if non-nil or by `equal' if nil." diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 788524bedb5..495cf1e543c 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -197,6 +197,31 @@ Evaluate BODY for each created sequence. (should (seq-every-p #'identity seq)) (should (seq-every-p #'test-sequences-evenp seq)))) +(ert-deftest test-seq-set-equal-p () + (with-test-sequences (seq1 '(1 2 3)) + (should (seq-set-equal-p seq1 seq1)) + (should (seq-set-equal-p seq1 seq1 #'eq)) + + (with-test-sequences (seq2 '(3 2 1)) + (should (seq-set-equal-p seq1 seq2)) + (should (seq-set-equal-p seq2 seq1)) + (should (seq-set-equal-p seq1 seq2 #'eq)) + (should (seq-set-equal-p seq2 seq1 #'eq))) + + (with-test-sequences (seq2 '(3 1)) + (should-not (seq-set-equal-p seq1 seq2)) + (should-not (seq-set-equal-p seq2 seq1)))) + + (should (seq-set-equal-p '("a" "b" "c") + '("c" "b" "a"))) + (should-not (seq-set-equal-p '("a" "b" "c") + '("c" "b" "a") #'eq)) + (should-not (seq-set-equal-p '(("a" 1) ("b" 1) ("c" 1)) + '(("c" 2) ("b" 2) ("a" 2)))) + (should (seq-set-equal-p '(("a" 1) ("b" 1) ("c" 1)) + '(("c" 2) ("b" 2) ("a" 2)) + (lambda (i1 i2) (equal (car i1) (car i2)))))) + (ert-deftest test-seq-empty-p () (with-test-sequences (seq '(0)) (should-not (seq-empty-p seq))) -- cgit v1.2.3 From 5c4dbbb745f31fda95843bbc6d2fd070b9473c65 Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Thu, 4 May 2017 11:34:41 +0200 Subject: * lisp/emacs-lisp/seq.el: Bump seq version. --- lisp/emacs-lisp/seq.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 963a1ddf964..23e444fe241 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: sequences -;; Version: 2.19 +;; Version: 2.20 ;; Package: seq ;; Maintainer: emacs-devel@gnu.org -- cgit v1.2.3 From fed13bd8c81fa20f1a67386a13d1ba3a9daaed8c Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Thu, 4 May 2017 19:47:45 +0900 Subject: Inherit incompatible/obsolete package faces from error Don't use the same face for installed packages as for incompatible or obsolete ones. * lisp/emacs-lisp/package.el (package-status-incompat): Inherit from error. --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bef1e8dd59b..7ae7ffff1a7 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2904,7 +2904,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." :version "25.1") (defface package-status-incompat - '((t :inherit font-lock-comment-face)) + '((t :inherit error)) "Face used on the status and version of incompat packages." :version "25.1") -- cgit v1.2.3 From ee0dd3031cd521f54c08287f4a3e7bc3ee515f55 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Fri, 5 May 2017 03:43:07 +0300 Subject: cl-defmethod: Make the edebug spec more technically correct * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Denote the edebug spec part for qualifiers as [&rest atom], per http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00053.html. --- lisp/emacs-lisp/cl-generic.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 107d520b1e9..068f4fb0c84 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -415,8 +415,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (&define ; this means we are defining something [&or symbolp ("setf" symbolp)] ;; ^^ This is the methods symbol - [ &optional keywordp ; this is key :before etc - &optional stringp ] ; :extra can be followed by a string + [ &rest atom ] ; Multiple qualifiers are allowed. + ; Like in CLOS spec, we support + ; any non-list values. listp ; arguments [ &optional stringp ] ; documentation string def-body))) ; part to be debugged -- cgit v1.2.3 From b8732c652ad69f815c2f4d4c4c966437463327fa Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 4 May 2017 22:26:17 -0700 Subject: * lisp/emacs-lisp/cl-lib.el (cl-mapcar): Remove recent autoload cookie. --- lisp/emacs-lisp/cl-lib.el | 1 - 1 file changed, 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 1f8615fad3e..936c852526c 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -349,7 +349,6 @@ Call `cl-float-limits' to set this.") (declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs &optional acc)) -;;;###autoload (defun cl-mapcar (cl-func cl-x &rest cl-rest) "Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, -- cgit v1.2.3 From 4af24317b4c043ffa4ce303e57276954920bf204 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 4 May 2017 23:15:53 -0700 Subject: Fontify the doc-string in some CL forms as such * lisp/emacs-lisp/lisp-mode.el (defconstant, defparameter): Add the doc-string-elt property. (Bug#26778) --- lisp/emacs-lisp/lisp-mode.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 54d916887cd..7448864ff99 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -164,6 +164,9 @@ (put 'defalias 'doc-string-elt 3) (put 'defvaralias 'doc-string-elt 3) (put 'define-category 'doc-string-elt 2) +;; CL +(put 'defconstant 'doc-string-elt 3) +(put 'defparameter 'doc-string-elt 3) (defvar lisp-doc-string-elt-property 'doc-string-elt "The symbol property that holds the docstring position info.") -- cgit v1.2.3 From 03d941982fbdf96260fc47d1cafbdda78c1d128e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 May 2017 17:07:10 -0700 Subject: Write autoloads file once only * lisp/emacs-lisp/autoload.el (autoload-find-generated-file): Simplify. Don't bother about ensuring the output file exists. (autoload-generated-file): Add doc. (autoload-ensure-writable): Update doc. (autoload-ensure-file-writeable): Handle non-existing file. (autoload-ensure-default-file): Remove function. --- lisp/emacs-lisp/autoload.el | 39 +++++++++++++-------------------------- 1 file changed, 13 insertions(+), 26 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 4d0554e6101..9865b3198b2 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -255,30 +255,22 @@ expression, in which case we want to handle forms differently." ;; Those properties are now set in lisp-mode.el. (defun autoload-find-generated-file () - "Visit the autoload file for the current buffer, and return its buffer. -If a buffer is visiting the desired autoload file, return it." + "Visit the autoload file for the current buffer, and return its buffer." (let ((enable-local-variables :safe) - (enable-local-eval nil)) + (enable-local-eval nil) + (delay-mode-hooks t) + (file (autoload-generated-file))) ;; We used to use `raw-text' to read this file, but this causes ;; problems when the file contains non-ASCII characters. - (let* ((delay-mode-hooks t) - (file (autoload-generated-file)) - (file-missing (not (file-exists-p file)))) - (when file-missing - (autoload-ensure-default-file file)) - (with-current-buffer - (find-file-noselect - (autoload-ensure-file-writeable - file)) - ;; block backups when the file has just been created, since - ;; the backups will just be the auto-generated headers. - ;; bug#23203 - (when file-missing - (setq buffer-backed-up t) - (save-buffer)) - (current-buffer))))) + (with-current-buffer (find-file-noselect + (autoload-ensure-file-writeable file)) + (if (zerop (buffer-size)) (insert (autoload-rubric file))) + (current-buffer)))) (defun autoload-generated-file () + "Return `generated-autoload-file' as an absolute name. +If local to the current buffer, expand using the default directory; +otherwise, using `source-directory'/lisp." (expand-file-name generated-autoload-file ;; File-local settings of generated-autoload-file should ;; be interpreted relative to the file's location, @@ -391,7 +383,7 @@ not be relied upon." " ends here\n"))) (defvar autoload-ensure-writable nil - "Non-nil means `autoload-ensure-default-file' makes existing file writable.") + "Non-nil means `autoload-find-generated-file' makes existing file writable.") ;; Just in case someone tries to get you to overwrite a file that you ;; don't want to. ;;;###autoload @@ -401,6 +393,7 @@ not be relied upon." ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile, ;; which was designed to handle CVSREAD=1 and equivalent. (and autoload-ensure-writable + (file-exists-p file) (let ((modes (file-modes file))) (if (zerop (logand modes #o0200)) ;; Ignore any errors here, and let subsequent attempts @@ -408,12 +401,6 @@ not be relied upon." (ignore-errors (set-file-modes file (logior modes #o0200)))))) file) -(defun autoload-ensure-default-file (file) - "Make sure that the autoload file FILE exists, creating it if needed. -If the file already exists and `autoload-ensure-writable' is non-nil, -make it writable." - (write-region (autoload-rubric file) nil file)) - (defun autoload-insert-section-header (outbuf autoloads load-name file time) "Insert the section-header line, which lists the file name and which functions are in it, etc." -- cgit v1.2.3 From 7f3d63908cd05fb34347d942e435c2964cd8b249 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 May 2017 17:58:20 -0700 Subject: Write autoloads file atomically * lisp/emacs-lisp/autoload.el (autoload--save-buffer): New function, to save buffer atomically. (autoload-save-buffers, update-directory-autoloads): Use autoload--save-buffer. * lisp/Makefile.in ($(lisp)/loaddefs.el): No longer write to a temp file by hand. --- lisp/Makefile.in | 13 +------------ lisp/emacs-lisp/autoload.el | 22 ++++++++++++++++++---- 2 files changed, 19 insertions(+), 16 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/Makefile.in b/lisp/Makefile.in index cbbea78a00f..1da8814370a 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -203,28 +203,17 @@ $(lisp)/finder-inf.el: # batch-update-autoloads, which only updates the autoloads whose # sources have changed. -# Write to a temporary file in case we're doing a parallel build and a -# CANNOT_DUMP-mode Emacs needs to read loaddefs at startup. -# (FIXME: This seems like something that batch-update-autoloads should -# do internally, then it would Just Work for all loaddefs files.) -# We start by copying an existing loaddefs.el to loaddefs.tmp to avoid -# regenerating the entire file anew, which is slow; starting from an -# almost-correct content will enable the "only update where necessary" -# feature of batch-update-autoloads. - # Use expand-file-name rather than $abs_scrdir so that Emacs does not # get confused when it compares file-names for equality. autoloads .PHONY: $(lisp)/loaddefs.el $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) @echo Directories for loaddefs: ${SUBDIRS_ALMOST} - @if test -f $@ ; then cp $@ $(lisp)/loaddefs.tmp ; fi $(AM_V_GEN)$(emacs) -l autoload \ --eval '(setq autoload-ensure-writable t)' \ --eval '(setq autoload-builtin-package-versions t)' \ - --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$(lisp)/loaddefs.tmp")))' \ + --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$@")))' \ -f batch-update-autoloads ${SUBDIRS_ALMOST} - $(top_srcdir)/build-aux/move-if-change $(lisp)/loaddefs.tmp $@ # autoloads only runs when loaddefs.el is nonexistent, although it # generates a number of different files. Provide a force option to enable diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 9865b3198b2..8ad5e6b823d 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -866,11 +866,26 @@ FILE's modification time." (error "%s:0:0: error: %s: %s" file (car err) (cdr err))) )) +;; For parallel builds, to stop another process reading a half-written file. +(defun autoload--save-buffer () + "Save current buffer to its file, atomically." + ;; Copied from byte-compile-file. + (let* ((version-control 'never) + (tempfile (make-temp-name buffer-file-name)) + (kill-emacs-hook + (cons (lambda () (ignore-errors (delete-file tempfile))) + kill-emacs-hook))) + (write-region (point-min) (point-max) tempfile nil 1) + (backup-buffer) + (rename-file tempfile buffer-file-name t) + (set-buffer-modified-p nil) + (set-visited-file-modtime) + (or noninteractive (message "Wrote %s" buffer-file-name)))) + (defun autoload-save-buffers () (while autoload-modified-buffers (with-current-buffer (pop autoload-modified-buffers) - (let ((version-control 'never)) - (save-buffer))))) + (autoload--save-buffer)))) ;; FIXME This command should be deprecated. ;; See http://debbugs.gnu.org/22213#41 @@ -1110,8 +1125,7 @@ write its autoloads into the specified file instead." ;; dependencies don't trigger unnecessarily. (if (not changed) (set-buffer-modified-p nil) - (let ((version-control 'never)) - (save-buffer))) + (autoload--save-buffer)) ;; In case autoload entries were added to other files because of ;; file-local autoload-generated-file settings. -- cgit v1.2.3 From 233cfb0ea93ecdd2b63298be4243059e2e7a91fd Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 May 2017 18:01:34 -0700 Subject: Remove obsolete method of changing byte-compile-dest-file * lisp/emacs-lisp/bytecomp.el (byte-compile-dest-file): Define unconditionally. --- lisp/emacs-lisp/bytecomp.el | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 25102548a9d..201733ff033 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -166,24 +166,19 @@ file name, and return the name of the compiled file." (funcall handler 'byte-compiler-base-file-name filename) filename))) -(or (fboundp 'byte-compile-dest-file) - ;; The user may want to redefine this along with emacs-lisp-file-regexp, - ;; so only define it if it is undefined. - ;; Note - redefining this function is obsolete as of 23.2. - ;; Customize byte-compile-dest-file-function instead. - (defun byte-compile-dest-file (filename) - "Convert an Emacs Lisp source file name to a compiled file name. +(defun byte-compile-dest-file (filename) + "Convert an Emacs Lisp source file name to a compiled file name. If `byte-compile-dest-file-function' is non-nil, uses that function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension `.el'), adds `c' to it; otherwise adds `.elc'." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc")))))) + (if byte-compile-dest-file-function + (funcall byte-compile-dest-file-function filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc"))))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") -- cgit v1.2.3 From d6d5020c2593a1e8ac2fe7ef4f217cfbcacfd32d Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 9 May 2017 13:03:04 -0400 Subject: Don't duplicate autoload code in package.el * lisp/emacs-lisp/autoload.el (autoload-rubric): Add a package option. * lisp/emacs-lisp/package.el (autoload-rubric): Declare. (package-autoload-ensure-default-file): Use autoload-rubric. --- lisp/emacs-lisp/autoload.el | 30 +++++++++++++++++++----------- lisp/emacs-lisp/package.el | 20 ++++---------------- 2 files changed, 23 insertions(+), 27 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 8ad5e6b823d..f6b09dcf31d 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -355,24 +355,32 @@ put the output in." (defun autoload-rubric (file &optional type feature) "Return a string giving the appropriate autoload rubric for FILE. TYPE (default \"autoloads\") is a string stating the type of -information contained in FILE. If FEATURE is non-nil, FILE -will provide a feature. FEATURE may be a string naming the -feature, otherwise it will be based on FILE's name. +information contained in FILE. TYPE \"package\" acts like the default, +but adds an extra line to the output to modify `load-path'. + +If FEATURE is non-nil, FILE will provide a feature. FEATURE may +be a string naming the feature, otherwise it will be based on +FILE's name. At present, a feature is in fact always provided, but this should not be relied upon." - (let ((basename (file-name-nondirectory file))) + (let ((basename (file-name-nondirectory file)) + (lp (if (equal type "package") (setq type "autoloads")))) (concat ";;; " basename " --- automatically extracted " (or type "autoloads") "\n" ";;\n" ";;; Code:\n\n" - " \n" - ;; This is used outside of autoload.el, eg cus-dep, finder. - "(provide '" - (if (stringp feature) - feature - (file-name-sans-extension basename)) - ")\n" + (if lp + ;; `load-path' should contain only directory names. + "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n \n" + (concat + ;; This is used outside of autoload.el, eg cus-dep, finder. + " \n" + "(provide '" + (if (stringp feature) + feature + (file-name-sans-extension basename)) + ")\n")) ";; Local Variables:\n" ";; version-control: never\n" ";; no-byte-compile: t\n" diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7ae7ffff1a7..c0ecb0447f3 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -905,25 +905,13 @@ untar into a directory named DIR; otherwise, signal an error." nil pkg-file nil 'silent)))) ;;;; Autoload -;; From Emacs 22, but changed so it adds to load-path. +(declare-function autoload-rubric "autoload" (file &optional type feature)) + (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." (unless (file-exists-p file) - (write-region - (concat ";;; " (file-name-nondirectory file) - " --- automatically extracted autoloads\n" - ";;\n" - ";;; Code:\n" - ;; `load-path' should contain only directory names - "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n" - " \n;; Local Variables:\n" - ";; version-control: never\n" - ";; no-byte-compile: t\n" - ";; no-update-autoloads: t\n" - ";; End:\n" - ";;; " (file-name-nondirectory file) - " ends here\n") - nil file nil 'silent)) + (require 'autoload) + (write-region (autoload-rubric file "package" nil) nil file nil 'silent)) file) (defvar generated-autoload-file) -- cgit v1.2.3 From e7b6751c0a74f24c14cd207d57a4e1a95f409256 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 23 Apr 2017 10:43:05 -0400 Subject: Fix lisp-indent-region and indent-sexp (Bug#26619) The new lisp-indent-region introduced in 2017-04-22 "Add new `lisp-indent-region' that doesn't reparse the code." is broken because it doesn't save the calculated indent amounts for already seen sexp depths. Fix this by unifying the indent-sexp and lisp-indent-region code. Furthermore, only preserve position 2 of the running parse when the depth doesn't change. * lisp/emacs-lisp/lisp-mode.el (lisp-ppss): Use an OLDSTATE that corresponds with the start point when calling parse-partial-sexp. (lisp-indent-state): New struct. (lisp-indent-calc-next): New function, extracted from indent-sexp. (indent-sexp, lisp-indent-region): Use it. (lisp-indent-line): Take indentation, instead of parse state. * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-mode-tests--correctly-indented-sexp): New constant. (lisp-indent-region, lisp-indent-region-defun-with-docstring): (lisp-indent-region-open-paren, lisp-indent-region-in-sexp): New tests. --- lisp/emacs-lisp/lisp-mode.el | 176 +++++++++++++++++--------------- test/lisp/emacs-lisp/lisp-mode-tests.el | 85 ++++++++++++++- 2 files changed, 171 insertions(+), 90 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 7448864ff99..6287f27b139 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -754,49 +754,108 @@ function is `common-lisp-indent-function'." (defun lisp-ppss (&optional pos) "Return Parse-Partial-Sexp State at POS, defaulting to point. -Like to `syntax-ppss' but includes the character address of the -last complete sexp in the innermost containing list at position +Like `syntax-ppss' but includes the character address of the last +complete sexp in the innermost containing list at position 2 (counting from 0). This is important for lisp indentation." (unless pos (setq pos (point))) (let ((pss (syntax-ppss pos))) (if (nth 9 pss) - (parse-partial-sexp (car (last (nth 9 pss))) pos) + (let ((sexp-start (car (last (nth 9 pss))))) + (parse-partial-sexp sexp-start pos nil nil (syntax-ppss sexp-start))) pss))) +(cl-defstruct (lisp-indent-state + (:constructor nil) + (:constructor lisp-indent-initial-state + (&aux (ppss (lisp-ppss)) + (ppss-point (point)) + (depth (car ppss)) + (stack (make-list (1+ depth) nil))))) + stack ;; Cached indentation, per depth. + ppss + depth + ppss-point) + +(defun lisp-indent-calc-next (state) + "Move to next line and return calculated indent for it. +STATE is updated by side effect, the first state should be +created by `lisp-indent-initial-state'. This function may move +by more than one line to cross a string literal." + (pcase-let (((cl-struct lisp-indent-state + (stack indent-stack) ppss depth ppss-point) + state)) + ;; Parse this line so we can learn the state to indent the + ;; next line. + (while (let ((last-sexp (nth 2 ppss))) + (setq ppss (parse-partial-sexp + ppss-point (progn (end-of-line) (point)) + nil nil ppss)) + ;; Preserve last sexp of state (position 2) for + ;; `calculate-lisp-indent', if we're at the same depth. + (if (and (not (nth 2 ppss)) (= depth (car ppss))) + (setf (nth 2 ppss) last-sexp) + (setq last-sexp (nth 2 ppss))) + ;; Skip over newlines within strings. + (nth 3 ppss)) + (let ((string-start (nth 8 ppss))) + (setq ppss (parse-partial-sexp (point) (point-max) + nil nil ppss 'syntax-table)) + (setf (nth 2 ppss) string-start)) ; Finished a complete string. + (setq ppss-point (point))) + (setq ppss-point (point)) + (let* ((next-depth (car ppss)) + (depth-delta (- next-depth depth))) + (cond ((< depth-delta 0) + (setq indent-stack (nthcdr (- depth-delta) indent-stack))) + ((> depth-delta 0) + (setq indent-stack (nconc (make-list depth-delta nil) + indent-stack)))) + (setq depth next-depth)) + (prog1 + (let (indent) + (cond ((= (forward-line 1) 1) nil) + ((car indent-stack)) + ((integerp (setq indent (calculate-lisp-indent ppss))) + (setf (car indent-stack) indent)) + ((consp indent) ; (COLUMN CONTAINING-SEXP-START) + (car indent)) + ;; This only happens if we're in a string. + (t (error "This shouldn't happen")))) + (setf (lisp-indent-state-stack state) indent-stack) + (setf (lisp-indent-state-depth state) depth) + (setf (lisp-indent-state-ppss-point state) ppss-point) + (setf (lisp-indent-state-ppss state) ppss)))) + (defun lisp-indent-region (start end) "Indent region as Lisp code, efficiently." (save-excursion (setq end (copy-marker end)) (goto-char start) + (beginning-of-line) ;; The default `indent-region-line-by-line' doesn't hold a running ;; parse state, which forces each indent call to reparse from the ;; beginning. That has O(n^2) complexity. - (let* ((parse-state (lisp-ppss start)) - (last-syntax-point start) + (let* ((parse-state (lisp-indent-initial-state)) (pr (unless (minibufferp) (make-progress-reporter "Indenting region..." (point) end)))) - (while (< (point) end) - (unless (and (bolp) (eolp)) - (lisp-indent-line parse-state)) - (forward-line 1) - (let ((last-sexp (nth 2 parse-state))) - (setq parse-state (parse-partial-sexp last-syntax-point (point) - nil nil parse-state)) - ;; It's important to preserve last sexp location for - ;; `calculate-lisp-indent'. - (unless (nth 2 parse-state) - (setf (nth 2 parse-state) last-sexp)) - (setq last-syntax-point (point))) - (and pr (progress-reporter-update pr (point)))) + (let ((ppss (lisp-indent-state-ppss parse-state))) + (unless (or (and (bolp) (eolp)) (nth 3 ppss)) + (lisp-indent-line (calculate-lisp-indent ppss)))) + (let ((indent nil)) + (while (progn (setq indent (lisp-indent-calc-next parse-state)) + (< (point) end)) + (unless (or (and (bolp) (eolp)) (not indent)) + (lisp-indent-line indent)) + (and pr (progress-reporter-update pr (point))))) (and pr (progress-reporter-done pr)) (move-marker end nil)))) -(defun lisp-indent-line (&optional parse-state) +(defun lisp-indent-line (&optional indent) "Indent current line as Lisp code." (interactive) (let ((pos (- (point-max) (point))) (indent (progn (beginning-of-line) - (calculate-lisp-indent (or parse-state (lisp-ppss)))))) + (or indent (calculate-lisp-indent (lisp-ppss)))))) (skip-chars-forward " \t") (if (or (null indent) (looking-at "\\s<\\s<\\s<")) ;; Don't alter indentation of a ;;; comment line @@ -1116,16 +1175,7 @@ Lisp function does not specify a special indentation." If optional arg ENDPOS is given, indent each line, stopping when ENDPOS is encountered." (interactive) - (let* ((indent-stack (list nil)) - ;; Use `syntax-ppss' to get initial state so we don't get - ;; confused by starting inside a string. We don't use - ;; `syntax-ppss' in the loop, because this is measurably - ;; slower when we're called on a long list. - (state (syntax-ppss)) - (init-depth (car state)) - (next-depth init-depth) - (last-depth init-depth) - (last-syntax-point (point))) + (let* ((parse-state (lisp-indent-initial-state))) ;; We need a marker because we modify the buffer ;; text preceding endpos. (setq endpos (copy-marker @@ -1135,64 +1185,20 @@ ENDPOS is encountered." (save-excursion (forward-sexp 1) (point))))) (save-excursion (while (< (point) endpos) - ;; Parse this line so we can learn the state to indent the - ;; next line. Preserve element 2 of the state (last sexp) for - ;; `calculate-lisp-indent'. - (let ((last-sexp (nth 2 state))) - (while (progn - (setq state (parse-partial-sexp - last-syntax-point (progn (end-of-line) (point)) - nil nil state)) - (setq last-sexp (or (nth 2 state) last-sexp)) - ;; Skip over newlines within strings. - (nth 3 state)) - (setq state (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table)) - (setq last-sexp (or (nth 2 state) last-sexp)) - (setq last-syntax-point (point))) - (setf (nth 2 state) last-sexp)) - (setq next-depth (car state)) - ;; If the line contains a comment indent it now with - ;; `indent-for-comment'. - (when (nth 4 state) - (indent-for-comment) - (end-of-line)) - (setq last-syntax-point (point)) - (when (< next-depth init-depth) - (setq indent-stack (nconc indent-stack - (make-list (- init-depth next-depth) nil)) - last-depth (- last-depth next-depth) - next-depth init-depth)) - ;; Now indent the next line according to what we learned from - ;; parsing the previous one. - (forward-line 1) - (when (< (point) endpos) - (let ((depth-delta (- next-depth last-depth))) - (cond ((< depth-delta 0) - (setq indent-stack (nthcdr (- depth-delta) indent-stack))) - ((> depth-delta 0) - (setq indent-stack (nconc (make-list depth-delta nil) - indent-stack)))) - (setq last-depth next-depth)) + (let ((indent (lisp-indent-calc-next parse-state))) + ;; If the line contains a comment indent it now with + ;; `indent-for-comment'. + (when (nth 4 (lisp-indent-state-ppss parse-state)) + (save-excursion + (goto-char (lisp-indent-state-ppss-point parse-state)) + (indent-for-comment) + (setf (lisp-indent-state-ppss-point parse-state) + (line-end-position)))) ;; But not if the line is blank, or just a comment (we ;; already called `indent-for-comment' above). (skip-chars-forward " \t") - (unless (or (eolp) (eq (char-syntax (char-after)) ?<)) - (indent-line-to - (or (car indent-stack) - ;; The state here is actually to the end of the - ;; previous line, but that's fine for our purposes. - ;; And parsing over the newline would only destroy - ;; element 2 (last sexp position). - (let ((val (calculate-lisp-indent state))) - (cond ((integerp val) - (setf (car indent-stack) val)) - ((consp val) ; (COLUMN CONTAINING-SEXP-START) - (car val)) - ;; `calculate-lisp-indent' only returns nil - ;; when we're in a string, but this won't - ;; happen because we skip strings above. - (t (error "This shouldn't happen!")))))))))) + (unless (or (eolp) (eq (char-syntax (char-after)) ?<) (not indent)) + (indent-line-to indent))))) (move-marker endpos nil))) (defun indent-pp-sexp (&optional arg) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 27f0bb5ec13..1f78eb30105 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -21,10 +21,7 @@ (require 'cl-lib) (require 'lisp-mode) -(ert-deftest indent-sexp () - "Test basics of \\[indent-sexp]." - (with-temp-buffer - (insert "\ +(defconst lisp-mode-tests--correctly-indented-sexp "\ \(a (prog1 (prog1 @@ -42,9 +39,14 @@ noindent\" 3 2) ; comment ;; comment b)") + +(ert-deftest indent-sexp () + "Test basics of \\[indent-sexp]." + (with-temp-buffer + (insert lisp-mode-tests--correctly-indented-sexp) (goto-char (point-min)) (let ((indent-tabs-mode nil) - (correct (buffer-string))) + (correct lisp-mode-tests--correctly-indented-sexp)) (dolist (mode '(fundamental-mode emacs-lisp-mode)) (funcall mode) (indent-sexp) @@ -97,5 +99,78 @@ noindent\" 3 (indent-sexp) (should (equal (buffer-string) correct))))) +(ert-deftest lisp-indent-region () + "Test basics of `lisp-indent-region'." + (with-temp-buffer + (insert lisp-mode-tests--correctly-indented-sexp) + (goto-char (point-min)) + (let ((indent-tabs-mode nil) + (correct lisp-mode-tests--correctly-indented-sexp)) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + ;; Don't mess up correctly indented code. + (should (string= (buffer-string) correct)) + ;; Correctly add indentation. + (save-excursion + (while (not (eobp)) + (delete-horizontal-space) + (forward-line))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct)) + ;; Correctly remove indentation. + (save-excursion + (let ((n 0)) + (while (not (eobp)) + (unless (looking-at "noindent\\|^[[:blank:]]*$") + (insert (make-string n ?\s))) + (cl-incf n) + (forward-line)))) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + + +(ert-deftest lisp-indent-region-defun-with-docstring () + "Test Bug#26619." + (with-temp-buffer + (insert "\ +\(defun test () + \"This is a test. +Test indentation in emacs-lisp-mode\" + (message \"Hi!\"))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + +(ert-deftest lisp-indent-region-open-paren () + (with-temp-buffer + (insert "\ +\(with-eval-after-load 'foo + (setq bar `( + baz)))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + +(ert-deftest lisp-indent-region-in-sexp () + (with-temp-buffer + (insert "\ +\(when t + (when t + (list 1 2 3) + 'etc) + (quote etc) + (quote etc))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (search-backward "1") + (indent-region (point) (point-max)) + (should (equal (buffer-string) correct))))) + + (provide 'lisp-mode-tests) ;;; lisp-mode-tests.el ends here -- cgit v1.2.3 From 22fc91704be4737865b3715e5278dc78029791bd Mon Sep 17 00:00:00 2001 From: Marcin Borkowski Date: Fri, 31 Mar 2017 13:06:06 +0200 Subject: Fix Bug#21072 and rework `mark-defun' * test/lisp/progmodes/elisp-mode-tests.el (mark-defun-test-buffer): New variable (mark-defun-no-arg-region-inactive) (mark-defun-no-arg-region-active) (mark-defun-arg-region-active) (mark-defun-pos-arg-region-inactive) (mark-defun-neg-arg-region-inactive, mark-defun-bob): Add tests for the new `mark-defun'. * lisp/emacs-lisp/lisp.el (beginning-of-defun--in-emptyish-line-p): New function. (beginning-of-defun-comments): New function. (mark-defun): Fix bug#21072, also rewrite large parts of `mark-defun' to accept a numerical prefix argument. --- doc/emacs/programs.texi | 14 ++- etc/NEWS | 9 ++ lisp/emacs-lisp/lisp.el | 132 ++++++++++++++------ test/lisp/emacs-lisp/lisp-tests.el | 247 +++++++++++++++++++++++++++++++++++++ 4 files changed, 359 insertions(+), 43 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 1533c7ee8bb..222d1c2a4de 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -248,11 +248,15 @@ the same as @kbd{C-M-a} with a positive argument. (@code{mark-defun}), which sets the mark at the end of the current defun and puts point at its beginning. @xref{Marking Objects}. This is the easiest way to get ready to kill the defun in order to move it -to a different place in the file. If you use the command while point -is between defuns, it uses the following defun. If you use the -command while the mark is already active, it sets the mark but does -not move point; furthermore, each successive use of @kbd{C-M-h} -extends the end of the region to include one more defun. +to a different place in the file. If the defun is directly preceded +by comments (with no intervening blank lines), they are marked, too. +If you use the command while point is between defuns, it uses the +following defun. If you use the command while the mark is already +active, it extends the end of the region to include one more defun. +With a prefix argument, it marks that many defuns or extends the +region by the appropriate number of defuns. With negative prefix +argument it marks defuns in the opposite direction and also changes +the direction of selecting for subsequent uses of @code{mark-defun}. In C mode, @kbd{C-M-h} runs the function @code{c-mark-function}, which is almost the same as @code{mark-defun}; the difference is that diff --git a/etc/NEWS b/etc/NEWS index 72818278781..8e628aad20d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -383,6 +383,15 @@ Strings such as ΌΣΟΣ are now correctly converted to Όσος when capitalized instead of incorrect Όσοσ (compare lowercase sigma at the end of the word). ++++ +** New behavior of 'mark-defun' implemented +Prefix argument selects that many (or that many more) defuns. +Negative prefix arg flips the direction of selection. Also, +'mark-defun' between defuns correctly selects N following defuns (or +-N previous for negative arguments). Finally, comments preceding the +defun are selected unless they are separated from the defun by a blank +line. + * Changes in Specialized Modes and Packages in Emacs 26.1 diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 0172e3af261..e74e2474ee9 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -398,6 +398,34 @@ is called as a function to find the defun's beginning." (goto-char (if arg-+ve floor ceiling)) nil)))))))) +(defun beginning-of-defun--in-emptyish-line-p () + "Return non-nil if the point is in an \"emptyish\" line. +This means a line that consists entirely of comments and/or +whitespace." +;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html + (save-excursion + (forward-line 0) + (< (line-end-position) + (let ((ppss (syntax-ppss))) + (when (nth 4 ppss) + (goto-char (nth 8 ppss))) + (forward-comment (point-max)) + (point))))) + +(defun beginning-of-defun-comments (&optional arg) + "Move to the beginning of ARGth defun, including comments." + (interactive "^p") + (unless arg (setq arg 1)) + (beginning-of-defun arg) + (let (nbobp) + (while (progn + (setq nbobp (zerop (forward-line -1))) + (and (not (looking-at "^\\s-*$")) + (beginning-of-defun--in-emptyish-line-p) + nbobp))) + (when nbobp + (forward-line 1)))) + (defvar end-of-defun-function (lambda () (forward-sexp 1)) "Function for `end-of-defun' to call. @@ -478,48 +506,76 @@ is called as a function to find the defun's end." (funcall end-of-defun-function) (funcall skip))))) -(defun mark-defun (&optional allow-extend) +(defun mark-defun (&optional arg) "Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point. +With positive ARG, mark this and that many next defuns; with negative +ARG, change the direction of marking. -Interactively, if this command is repeated -or (in Transient Mark mode) if the mark is active, -it marks the next defun after the ones already marked." +If the mark is active, it marks the next or previous defun(s) after +the one(s) already marked." (interactive "p") - (cond ((and allow-extend - (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active))) - (set-mark - (save-excursion - (goto-char (mark)) - (end-of-defun) - (point)))) - (t - (let ((opoint (point)) - beg end) - (push-mark opoint) - ;; Try first in this order for the sake of languages with nested - ;; functions where several can end at the same place as with - ;; the offside rule, e.g. Python. - (beginning-of-defun) - (setq beg (point)) - (end-of-defun) - (setq end (point)) - (while (looking-at "^\n") - (forward-line 1)) - (if (> (point) opoint) - (progn - ;; We got the right defun. - (push-mark beg nil t) - (goto-char end) - (exchange-point-and-mark)) - ;; beginning-of-defun moved back one defun - ;; so we got the wrong one. - (goto-char opoint) - (end-of-defun) - (push-mark (point) nil t) - (beginning-of-defun)) - (re-search-backward "^\n" (- (point) 1) t))))) + (setq arg (or arg 1)) + ;; There is no `mark-defun-back' function - see + ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-11/msg00079.html + ;; for explanation + (when (eq last-command 'mark-defun-back) + (setq arg (- arg))) + (when (< arg 0) + (setq this-command 'mark-defun-back)) + (cond ((use-region-p) + (if (>= arg 0) + (set-mark + (save-excursion + (goto-char (mark)) + ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed + (dotimes (_ignore arg) + (end-of-defun)) + (point))) + (beginning-of-defun-comments (- arg)))) + (t + (let ((opoint (point)) + beg end) + (push-mark opoint) + ;; Try first in this order for the sake of languages with nested + ;; functions where several can end at the same place as with the + ;; offside rule, e.g. Python. + (beginning-of-defun-comments) + (setq beg (point)) + (end-of-defun) + (setq end (point)) + (when (or (and (<= (point) opoint) + (> arg 0)) + (= beg (point-min))) ; we were before the first defun! + ;; beginning-of-defun moved back one defun so we got the wrong + ;; one. If ARG < 0, however, we actually want to go back. + (goto-char opoint) + (end-of-defun) + (setq end (point)) + (beginning-of-defun-comments) + (setq beg (point))) + (goto-char beg) + (cond ((> arg 0) + ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed + (dotimes (_ignore arg) + (end-of-defun)) + (setq end (point)) + (push-mark end nil t) + (goto-char beg)) + (t + (goto-char beg) + (unless (= arg -1) ; beginning-of-defun behaves + ; strange with zero arg - see + ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html + (beginning-of-defun (1- (- arg)))) + (push-mark end nil t)))))) + (let (nbobp) + (while (progn + (setq nbobp (zerop (forward-line -1))) + (and (looking-at "^\\s-*$") + nbobp))) + (when nbobp + (forward-line 1)))) (defvar narrow-to-defun-include-comments nil "If non-nil, `narrow-to-defun' will also show comments preceding the defun.") diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index f6039f78eb1..2119758bb77 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -342,5 +342,252 @@ a marker." `(let ,marker-list ,@body)))) +;;; mark-defun + +(defvar mark-defun-test-buffer + ";; Comment header +=!before-1= +\(defun func-1 (arg) + =!inside-1=\"docstring\" + body) +=!after-1==!before-2= +;; Comment before a defun +\(d=!inside-2=efun func-2 (arg) + \"docstring\" + body) +=!after-2==!before-3= +\(defun func-3 (arg) + \"docstring\"=!inside-3= + body) +=!after-3==!before-4=(defun func-4 (arg) + \"docstring\"=!inside-4= + body) +=!after-4= +;; end +" + "Test buffer for `mark-defun'.") + +(ert-deftest mark-defun-no-arg-region-inactive () + "Test `mark-defun' with no prefix argument and inactive +region." + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun inside a defun, with comments and an empty line + ;; before + (goto-char inside-1) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun inside a defun with comments before + (deactivate-mark) + (goto-char inside-2) + (mark-defun) + (should (= (point) before-2)) + (should (= (mark) after-2)) + ;; mark-defun inside a defun with empty line before + (deactivate-mark) + (goto-char inside-3) + (mark-defun) + (should (= (point) before-3)) + (should (= (mark) after-3)) + ;; mark-defun inside a defun with another one right before + (deactivate-mark) + (goto-char inside-4) + (mark-defun) + (should (= (point) before-4)) + (should (= (mark) after-4)) + ;; mark-defun between a comment and a defun + (deactivate-mark) + (goto-char before-1) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun between defuns + (deactivate-mark) + (goto-char before-3) + (mark-defun) + (should (= (point) before-3)) + (should (= (mark) after-3)) + ;; mark-defun in comment right before the defun + (deactivate-mark) + (goto-char before-2) + (mark-defun) + (should (= (point) before-2)) + (should (= (mark) after-2)))) + +(ert-deftest mark-defun-no-arg-region-active () + "Test `mark-defun' with no prefix argument and active +region." + (transient-mark-mode 1) + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun when a defun is marked + (goto-char before-1) + (set-mark after-1) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-2)) + ;; mark-defun when two defuns are marked + (deactivate-mark) + (goto-char before-1) + (set-mark after-2) + (mark-defun) + (should (= (point) before-1)) + (should (= (mark) after-3)))) + +(ert-deftest mark-defun-arg-region-active () + "Test `mark-defun' with a prefix arg and active region." + (transient-mark-mode 1) + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun with positive arg when a defun is marked + (goto-char before-1) + (set-mark after-1) + (mark-defun 2) + (should (= (point) before-1)) + (should (= (mark) after-3)) + ;; mark-defun with arg=-1 when a defun is marked + (goto-char before-2) + (set-mark after-2) + (mark-defun -1) + (should (= (point) before-1)) + (should (= (mark) after-2)) + ;; mark-defun with arg=-2 when a defun is marked + (goto-char before-3) + (set-mark after-3) + (mark-defun -2) + (should (= (point) before-1)) + (should (= (mark) after-3)))) + +(ert-deftest mark-defun-pos-arg-region-inactive () + "Test `mark-defun' with positive argument and inactive + region." + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun with positive arg inside a defun + (goto-char inside-1) + (mark-defun 2) + (should (= (point) before-1)) + (should (= (mark) after-2)) + ;; mark-defun with positive arg between defuns + (deactivate-mark) + (goto-char before-3) + (mark-defun 2) + (should (= (point) before-3)) + (should (= (mark) after-4)) + ;; mark-defun with positive arg in a comment + (deactivate-mark) + (goto-char before-2) + (mark-defun 2) + (should (= (point) before-2)) + (should (= (mark) after-3)))) + +(ert-deftest mark-defun-neg-arg-region-inactive () + "Test `mark-defun' with negative argument and inactive + region." + (setq last-command nil) + (elisp-tests-with-temp-buffer + mark-defun-test-buffer + ;; mark-defun with arg=-1 inside a defun + (goto-char inside-1) + (mark-defun -1) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun with arg=-1 between defuns + (deactivate-mark) + (goto-char after-2) + (mark-defun -1) + (should (= (point) before-2)) + (should (= (mark) after-2)) + ;; mark-defun with arg=-1 in a comment + ;; (this is probably not an optimal behavior...) + (deactivate-mark) + (goto-char before-2) + (mark-defun -1) + (should (= (point) before-1)) + (should (= (mark) after-1)) + ;; mark-defun with arg=-2 inside a defun + (deactivate-mark) + (goto-char inside-4) + (mark-defun -2) + (should (= (point) before-3)) + (should (= (mark) after-4)) + ;; mark-defun with arg=-2 between defuns + (deactivate-mark) + (goto-char before-3) + (mark-defun -2) + (should (= (point) before-1)) + (should (= (mark) after-2))) + (elisp-tests-with-temp-buffer ; test case submitted by Drew Adams + "(defun a () + nil) +=!before-b=(defun b () +=!in-b= nil) +=!after-b=;;;; +\(defun c () + nil) +" + (setq last-command nil) + (goto-char in-b) + (mark-defun -1) + (should (= (point) before-b)) + (should (= (mark) after-b)))) + +(ert-deftest mark-defun-bob () + "Test `mark-defun' at the beginning of buffer." + ;; Bob, comment, newline, defun + (setq last-command nil) + (elisp-tests-with-temp-buffer + ";; Comment at the bob +=!before= +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after))) + ;; Bob, newline, comment, defun + (elisp-tests-with-temp-buffer + "=!before= +;; Comment before the defun +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after))) + ;; Bob, comment, defun + (elisp-tests-with-temp-buffer + "=!before=;; Comment at the bob before the defun +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after))) + ;; Bob, newline, comment, newline, defun + (elisp-tests-with-temp-buffer + " +;; Comment before the defun +=!before= +\(defun func (arg)=!inside= + \"docstring\" + body) +=!after=" + (goto-char inside) + (mark-defun) + (should (= (point) before)) + (should (= (mark) after)))) + (provide 'lisp-tests) ;;; lisp-tests.el ends here -- cgit v1.2.3 From 0397f85c6f9b0a5325f774e2a56e7cd85176e228 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 20 Apr 2017 14:07:19 +0200 Subject: * lisp/emacs-lisp/lisp.el (mark-defun): Simplify moving the point. --- lisp/emacs-lisp/lisp.el | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index e74e2474ee9..71c27d08a2f 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -569,13 +569,9 @@ the one(s) already marked." ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html (beginning-of-defun (1- (- arg)))) (push-mark end nil t)))))) - (let (nbobp) - (while (progn - (setq nbobp (zerop (forward-line -1))) - (and (looking-at "^\\s-*$") - nbobp))) - (when nbobp - (forward-line 1)))) + (skip-chars-backward "[:space:]\n") + (unless (bobp) + (forward-line 1))) (defvar narrow-to-defun-include-comments nil "If non-nil, `narrow-to-defun' will also show comments preceding the defun.") -- cgit v1.2.3 From aa779b0f15faa114fa5e3f59b17e628b1a837af8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 9 May 2017 09:38:49 +0200 Subject: Modify `beginning-of-defun-comments' * lisp/emacs-lisp/lisp.el (beginning-of-defun-comments): Try not to stop in the middle of a multiline comment. --- lisp/emacs-lisp/lisp.el | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 71c27d08a2f..0c1fe42fedb 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -417,14 +417,22 @@ whitespace." (interactive "^p") (unless arg (setq arg 1)) (beginning-of-defun arg) - (let (nbobp) - (while (progn - (setq nbobp (zerop (forward-line -1))) - (and (not (looking-at "^\\s-*$")) - (beginning-of-defun--in-emptyish-line-p) - nbobp))) - (when nbobp - (forward-line 1)))) + (let (first-line-p) + (while (let ((ppss (progn (setq first-line-p (= (forward-line -1) -1)) + (syntax-ppss (line-end-position))))) + (while (and (nth 4 ppss) ; If eol is in a line-spanning comment, + (< (nth 8 ppss) (line-beginning-position))) + (goto-char (nth 8 ppss)) ; skip to comment start. + (setq ppss (syntax-ppss (line-end-position)))) + (and (not first-line-p) + (progn (skip-syntax-backward + "-" (line-beginning-position)) + (not (bolp))) ; Check for blank line. + (progn (parse-partial-sexp + (line-beginning-position) (line-end-position) + nil t (syntax-ppss (line-beginning-position))) + (eolp))))) ; Check for non-comment text. + (forward-line (if first-line-p 0 1)))) (defvar end-of-defun-function (lambda () (forward-sexp 1)) -- cgit v1.2.3 From 16004397f40d15d9db6b90632c236c804f38fc40 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 13 May 2017 12:28:48 +0200 Subject: Improve unescaped character literal warnings * src/lread.c (load_warn_unescaped_character_literals) (syms_of_lread): lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Improve formatting of unescaped character literal warnings. * test/src/lread-tests.el (lread-tests--unescaped-char-literals): test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals): Adapt unit tests. --- lisp/emacs-lisp/bytecomp.el | 2 +- src/lread.c | 6 +++++- test/lisp/emacs-lisp/bytecomp-tests.el | 3 ++- test/src/lread-tests.el | 2 +- 4 files changed, 9 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 201733ff033..daad93de182 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2032,7 +2032,7 @@ and will be removed soon. See (elisp)Backquote in the manual.")) (when lread--unescaped-character-literals (byte-compile-warn "unescaped character literals %s detected!" - (mapconcat #'string + (mapconcat (lambda (char) (format "`?%c'" char)) (sort lread--unescaped-character-literals #'<) ", "))) (byte-compile-toplevel-file-form form))) diff --git a/src/lread.c b/src/lread.c index f0ad0c28e56..0e5b476a9a2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -963,9 +963,11 @@ load_warn_unescaped_character_literals (Lisp_Object file) AUTO_STRING (format, "Loading `%s': unescaped character literals %s detected!"); AUTO_STRING (separator, ", "); + AUTO_STRING (inner_format, "`?%c'"); CALLN (Fmessage, format, file, - Fmapconcat (Qstring, + Fmapconcat (list3 (Qlambda, list1 (Qchar), + list3 (Qformat, inner_format, Qchar)), Fsort (Vlread_unescaped_character_literals, Qlss), separator)); } @@ -4855,6 +4857,8 @@ For internal use only. */); "lread--unescaped-character-literals"); DEFSYM (Qlss, "<"); + DEFSYM (Qchar, "char"); + DEFSYM (Qformat, "format"); DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, doc: /* Non-nil means `load' prefers the newest version of a file. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 3624904753c..84004a9264a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -527,7 +527,8 @@ literals (Bug#20852)." (err (should-error (byte-compile-file source)))) (should (equal (cdr err) (list (concat "unescaped character literals " - "\", (, ), ;, [, ] detected!")))))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' " + "detected!")))))))) ;; Local Variables: ;; no-byte-compile: t diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 0427fe64e4a..685ea682e29 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -140,7 +140,7 @@ literals (Bug#20852)." (should (equal (lread-tests--last-message) (concat (format-message "Loading `%s': " file-name) "unescaped character literals " - "\", (, ), ;, [, ] detected!"))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) (ert-deftest lread-test-bug26837 () "Test for http://debbugs.gnu.org/26837 ." -- cgit v1.2.3 From a1d461592172ca4c8aac0e4e923ef5e909cfb361 Mon Sep 17 00:00:00 2001 From: Philipp Date: Sat, 6 May 2017 22:23:03 +0200 Subject: Make `old-style-backquotes' variable internal * src/lread.c (load_warn_old_style_backquotes, Fload, read1) (syms_of_lread): Rename `old-style-backquotes' to `lread--old-style-backquotes', and clarify that it's for internal use only. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Rename variable. * test/src/lread-tests.el (lread-tests--old-style-backquotes): Add unit test. * emacs-lisp/bytecomp-tests.el (bytecomp-tests--old-style-backquotes): Add unit test. --- etc/NEWS | 5 +++++ lisp/emacs-lisp/bytecomp.el | 4 ++-- src/lread.c | 17 +++++++++-------- test/lisp/emacs-lisp/bytecomp-tests.el | 15 +++++++++++++++ test/src/lread-tests.el | 9 +++++++++ 5 files changed, 40 insertions(+), 10 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 9be6ee0f3f7..380ce710130 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -907,6 +907,11 @@ which was sometimes numerically incorrect. For example, on a 64-bit host (max 1e16 10000000000000001) now returns its second argument instead of its first. ++++ +** The variable 'old-style-backquotes' has been made internal and +renamed to 'lread--old-style-backquotes'. No user code should use +this variable. + * Lisp Changes in Emacs 26.1 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index daad93de182..e716eef10ad 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2021,11 +2021,11 @@ With argument ARG, insert value in current buffer after the form." (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let* ((old-style-backquotes nil) + (let* ((lread--old-style-backquotes nil) (lread--unescaped-character-literals nil) (form (read inbuffer))) ;; Warn about the use of old-style backquotes. - (when old-style-backquotes + (when lread--old-style-backquotes (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) diff --git a/src/lread.c b/src/lread.c index 0e5b476a9a2..c03aad4f722 100644 --- a/src/lread.c +++ b/src/lread.c @@ -948,7 +948,7 @@ load_error_handler (Lisp_Object data) static void load_warn_old_style_backquotes (Lisp_Object file) { - if (!NILP (Vold_style_backquotes)) + if (!NILP (Vlread_old_style_backquotes)) { AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); CALLN (Fmessage, format, file); @@ -1216,7 +1216,7 @@ Return t if the file exists and loads successfully. */) version = -1; /* Check for the presence of old-style quotes and warn about them. */ - specbind (Qold_style_backquotes, Qnil); + specbind (Qlread_old_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); /* Check for the presence of unescaped character literals and warn @@ -3040,7 +3040,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) "(\`" anyway). */ if (!new_backquote_flag && first_in_list && next_char == ' ') { - Vold_style_backquotes = Qt; + Vlread_old_style_backquotes = Qt; goto default_label; } else @@ -3094,7 +3094,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - Vold_style_backquotes = Qt; + Vlread_old_style_backquotes = Qt; goto default_label; } } @@ -4843,10 +4843,11 @@ variables, this must be set in the first line of a file. */); doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); Veval_buffer_list = Qnil; - DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes, - doc: /* Set to non-nil when `read' encounters an old-style backquote. */); - Vold_style_backquotes = Qnil; - DEFSYM (Qold_style_backquotes, "old-style-backquotes"); + DEFVAR_LISP ("lread--old-style-backquotes", Vlread_old_style_backquotes, + doc: /* Set to non-nil when `read' encounters an old-style backquote. +For internal use only. */); + Vlread_old_style_backquotes = Qnil; + DEFSYM (Qlread_old_style_backquotes, "lread--old-style-backquotes"); DEFVAR_LISP ("lread--unescaped-character-literals", Vlread_unescaped_character_literals, diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 84004a9264a..d15bd8b6e65 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -530,6 +530,21 @@ literals (Bug#20852)." "`?\"', `?(', `?)', `?;', `?[', `?]' " "detected!")))))))) +(ert-deftest bytecomp-tests--old-style-backquotes () + "Check that byte compiling warns about old-style backquotes." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (write-region "(` (a b))" nil source) + (bytecomp-tests--with-temp-file destination + (let* ((byte-compile-dest-file-function (lambda (_) destination)) + (byte-compile-error-on-warn t) + (byte-compile-debug t) + (err (should-error (byte-compile-file source)))) + (should (equal (cdr err) + (list "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual."))))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 685ea682e29..98cbb6a301d 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -155,4 +155,13 @@ literals (Bug#20852)." (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))))) +(ert-deftest lread-tests--old-style-backquotes () + "Check that loading warns about old-style backquotes." + (lread-tests--with-temp-file file-name + (write-region "(` (a b))" nil file-name) + (should (equal (load file-name nil :nomessage :nosuffix) t)) + (should (equal (lread-tests--last-message) + (concat (format-message "Loading `%s': " file-name) + "old-style backquotes detected!"))))) + ;;; lread-tests.el ends here -- cgit v1.2.3 From 4e0887556776086a0f508c394ab56cac5e1a4c8d Mon Sep 17 00:00:00 2001 From: Mark Oteiza Date: Sat, 13 May 2017 21:40:23 -0400 Subject: ; Revert "Adjust the edebug spec of if-let*" This reverts commit fd4b83ca7c20a68060772ec13aadbe29db612b3f. --- lisp/emacs-lisp/subr-x.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 440213eb38a..8a955277fed 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -128,8 +128,7 @@ In the special case you only want to bind a single value, VARLIST can just be a plain tuple. \n(fn VARLIST THEN ELSE...)" (declare (indent 2) - (debug ([&or (&rest &or symbolp (gate symbolp &optional form)) - (symbolp form)] + (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)] form body))) (when (and (<= (length bindings) 2) (not (listp (car bindings)))) -- cgit v1.2.3 From e6f64df9c2b443d3385c2c25c29ccd5283d37e3f Mon Sep 17 00:00:00 2001 From: Gemini Lasswell Date: Sat, 13 May 2017 11:35:49 -0700 Subject: Make edebug-step-in work on generic methods (Bug#22294) * lisp/emacs-lisp/edebug.el (edebug-match-cl-generic-method-args): New function to implement the edebug-form-spec property of the symbol cl-generic-method-args. (edebug-instrument-function): If the function is a generic function, find and instrument all of its methods. Return a list instead of a single symbol. (edebug-instrument-callee): Now returns a list. Update docstring. (edebug-step-in): Handle the list returned by edebug-instrument-callee. * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Use name and cl-generic-method-args in its Edebug spec. * lisp/emacs-lisp/eieio-compat.el (defmethod): Use name and cl-generic-method-args in its Edebug spec. * lisp/subr.el (method-files): New function. * test/lisp/subr-tests.el (subr-tests--method-files--finds-methods) (subr-tests--method-files--nonexistent-methods): New tests. --- lisp/emacs-lisp/cl-generic.el | 4 ++-- lisp/emacs-lisp/edebug.el | 53 ++++++++++++++++++++++++++++++++--------- lisp/emacs-lisp/eieio-compat.el | 4 ++-- lisp/subr.el | 19 +++++++++++++++ test/lisp/subr-tests.el | 24 +++++++++++++++++++ 5 files changed, 89 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 068f4fb0c84..c64376b940f 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -413,12 +413,12 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (declare (doc-string 3) (indent 2) (debug (&define ; this means we are defining something - [&or symbolp ("setf" symbolp)] + [&or name ("setf" name :name setf)] ;; ^^ This is the methods symbol [ &rest atom ] ; Multiple qualifiers are allowed. ; Like in CLOS spec, we support ; any non-list values. - listp ; arguments + cl-generic-method-args ; arguments [ &optional stringp ] ; documentation string def-body))) ; part to be debugged (let ((qualifiers nil)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 4116e31d0a9..65e30f86778 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1607,6 +1607,7 @@ expressions; a `progn' form will be returned enclosing these forms." ;; Less frequently used: ;; (function . edebug-match-function) (lambda-expr . edebug-match-lambda-expr) + (cl-generic-method-args . edebug-match-cl-generic-method-args) (¬ . edebug-match-¬) (&key . edebug-match-&key) (place . edebug-match-place) @@ -1900,6 +1901,16 @@ expressions; a `progn' form will be returned enclosing these forms." spec)) nil) +(defun edebug-match-cl-generic-method-args (cursor) + (let ((args (edebug-top-element-required cursor "Expected arguments"))) + (if (not (consp args)) + (edebug-no-match cursor "List expected")) + ;; Append the arguments to edebug-def-name. + (setq edebug-def-name + (intern (format "%s %s" edebug-def-name args))) + (edebug-move-cursor cursor) + (list args))) + (defun edebug-match-arg (cursor) ;; set the def-args bound in edebug-defining-form (let ((edebug-arg (edebug-top-element-required cursor "Expected arg"))) @@ -3186,8 +3197,11 @@ go to the end of the last sexp, or if that is the same point, then step." ))))) (defun edebug-instrument-function (func) - ;; Func should be a function symbol. - ;; Return the function symbol, or nil if not instrumented. + "Instrument the function or generic method FUNC. +Return the list of function symbols which were instrumented. +This may be simply (FUNC) for a normal function, or a list of +generated symbols for methods. If a function or method to +instrument cannot be found, signal an error." (let ((func-marker (get func 'edebug))) (cond ((and (markerp func-marker) (marker-buffer func-marker)) @@ -3195,10 +3209,24 @@ go to the end of the last sexp, or if that is the same point, then step." (with-current-buffer (marker-buffer func-marker) (goto-char func-marker) (edebug-eval-top-level-form) - func)) + (list func))) ((consp func-marker) (message "%s is already instrumented." func) - func) + (list func)) + ((get func 'cl--generic) + (let ((method-defs (method-files func)) + symbols) + (unless method-defs + (error "Could not find any method definitions for %s" func)) + (pcase-dolist (`(,file . ,spec) method-defs) + (let* ((loc (find-function-search-for-symbol spec 'cl-defmethod file))) + (unless (cdr loc) + (error "Could not find the definition for %s in its file" spec)) + (with-current-buffer (car loc) + (goto-char (cdr loc)) + (edebug-eval-top-level-form) + (push (edebug-form-data-symbol) symbols)))) + symbols)) (t (let ((loc (find-function-noselect func t))) (unless (cdr loc) @@ -3206,13 +3234,16 @@ go to the end of the last sexp, or if that is the same point, then step." (with-current-buffer (car loc) (goto-char (cdr loc)) (edebug-eval-top-level-form) - func)))))) + (list func))))))) (defun edebug-instrument-callee () "Instrument the definition of the function or macro about to be called. Do this when stopped before the form or it will be too late. One side effect of using this command is that the next time the -function or macro is called, Edebug will be called there as well." +function or macro is called, Edebug will be called there as well. +If the callee is a generic function, Edebug will instrument all +the methods, not just the one which is about to be called. Return +the list of symbols which were instrumented." (interactive) (if (not (looking-at "(")) (error "You must be before a list form") @@ -3227,15 +3258,15 @@ function or macro is called, Edebug will be called there as well." (defun edebug-step-in () - "Step into the definition of the function or macro about to be called. + "Step into the definition of the function, macro or method about to be called. This first does `edebug-instrument-callee' to ensure that it is instrumented. Then it does `edebug-on-entry' and switches to `go' mode." (interactive) - (let ((func (edebug-instrument-callee))) - (if func + (let ((funcs (edebug-instrument-callee))) + (if funcs (progn - (edebug-on-entry func 'temp) - (edebug-go-mode nil))))) + (mapc (lambda (func) (edebug-on-entry func 'temp)) funcs) + (edebug-go-mode nil))))) (defun edebug-on-entry (function &optional flag) "Cause Edebug to stop when FUNCTION is called. diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index fe65ae02623..e6e6d118709 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -105,10 +105,10 @@ Summary: (declare (doc-string 3) (obsolete cl-defmethod "25.1") (debug (&define ; this means we are defining something - [&or symbolp ("setf" symbolp)] + [&or name ("setf" name :name setf)] ;; ^^ This is the methods symbol [ &optional symbolp ] ; this is key :before etc - listp ; arguments + cl-generic-method-args ; arguments [ &optional stringp ] ; documentation string def-body ; part to be debugged ))) diff --git a/lisp/subr.el b/lisp/subr.el index 02e79932233..8d5d2a779c6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2026,6 +2026,25 @@ definition, variable definition, or face definition only." (setq files (cdr files))) file))) +(defun method-files (method) + "Return a list of files where METHOD is defined by `cl-defmethod'. +The list will have entries of the form (FILE . (METHOD ...)) +where (METHOD ...) contains the qualifiers and specializers of +the method and is a suitable argument for +`find-function-search-for-symbol'. Filenames are absolute." + (let ((files load-history) + result) + (while files + (let ((defs (cdr (car files)))) + (while defs + (let ((def (car defs))) + (if (and (eq (car-safe def) 'cl-defmethod) + (eq (cadr def) method)) + (push (cons (car (car files)) (cdr def)) result))) + (setq defs (cdr defs)))) + (setq files (cdr files))) + result)) + (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. LIBRARY should be a relative file name of the library, a string. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 0d243cc5d8c..8fa258d12ed 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -291,5 +291,29 @@ cf. Bug#25477." (should-error (eval '(dolist "foo") t) :type 'wrong-type-argument)) +(require 'cl-generic) +(cl-defgeneric subr-tests--generic (x)) +(cl-defmethod subr-tests--generic ((x string)) + (message "%s is a string" x)) +(cl-defmethod subr-tests--generic ((x integer)) + (message "%s is a number" x)) +(cl-defgeneric subr-tests--generic-without-methods (x y)) +(defvar subr-tests--this-file (or load-file-name buffer-file-name)) + +(ert-deftest subr-tests--method-files--finds-methods () + "`method-files' returns a list of files and methods for a generic function." + (let ((retval (method-files 'subr-tests--generic))) + (should (equal (length retval) 2)) + (mapc (lambda (x) + (should (equal (car x) subr-tests--this-file)) + (should (equal (cadr x) 'subr-tests--generic))) + retval) + (should-not (equal (nth 0 retval) (nth 1 retval))))) + +(ert-deftest subr-tests--method-files--nonexistent-methods () + "`method-files' returns nil if asked to find a method which doesn't exist." + (should-not (method-files 'subr-tests--undefined-generic)) + (should-not (method-files 'subr-tests--generic-without-methods))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- cgit v1.2.3 From 750f0e2e79e1bdc3246b07aa3219cab34ebde6e7 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Thu, 11 May 2017 18:12:40 -0400 Subject: Make sure indent-sexp stops at end of sexp (Bug#26878) * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Check endpos before indenting. * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp-stop): New test. --- lisp/emacs-lisp/lisp-mode.el | 33 ++++++++++++++++++--------------- test/lisp/emacs-lisp/lisp-mode-tests.el | 14 ++++++++++++++ 2 files changed, 32 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 6287f27b139..3334471d251 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1184,21 +1184,24 @@ ENDPOS is encountered." ;; after point. (save-excursion (forward-sexp 1) (point))))) (save-excursion - (while (< (point) endpos) - (let ((indent (lisp-indent-calc-next parse-state))) - ;; If the line contains a comment indent it now with - ;; `indent-for-comment'. - (when (nth 4 (lisp-indent-state-ppss parse-state)) - (save-excursion - (goto-char (lisp-indent-state-ppss-point parse-state)) - (indent-for-comment) - (setf (lisp-indent-state-ppss-point parse-state) - (line-end-position)))) - ;; But not if the line is blank, or just a comment (we - ;; already called `indent-for-comment' above). - (skip-chars-forward " \t") - (unless (or (eolp) (eq (char-syntax (char-after)) ?<) (not indent)) - (indent-line-to indent))))) + (while (let ((indent (lisp-indent-calc-next parse-state)) + (ppss (lisp-indent-state-ppss parse-state))) + ;; If the line contains a comment indent it now with + ;; `indent-for-comment'. + (when (and (nth 4 ppss) (<= (nth 8 ppss) endpos)) + (save-excursion + (goto-char (lisp-indent-state-ppss-point parse-state)) + (indent-for-comment) + (setf (lisp-indent-state-ppss-point parse-state) + (line-end-position)))) + (when (< (point) endpos) + ;; Indent the next line, unless it's blank, or just a + ;; comment (we will `indent-for-comment' the latter). + (skip-chars-forward " \t") + (unless (or (eolp) (not indent) + (eq (char-syntax (char-after)) ?<)) + (indent-line-to indent)) + t)))) (move-marker endpos nil))) (defun indent-pp-sexp (&optional arg) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index 1f78eb30105..f2fe7a6cf41 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -99,6 +99,20 @@ noindent\" 3 (indent-sexp) (should (equal (buffer-string) correct))))) +(ert-deftest indent-sexp-stop () + "Make sure `indent-sexp' stops at the end of the sexp." + ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=26878. + (with-temp-buffer + (emacs-lisp-mode) + (insert "(a ()\n)") + (let ((original (buffer-string))) + (search-backward "a ") + (goto-char (match-end 0)) + (indent-sexp) + ;; The final paren should not be indented, because the sexp + ;; we're indenting ends on the previous line. + (should (equal (buffer-string) original))))) + (ert-deftest lisp-indent-region () "Test basics of `lisp-indent-region'." (with-temp-buffer -- cgit v1.2.3 From df4e105910a983f42e77828809ab50611b454905 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Wed, 17 May 2017 12:43:23 -0400 Subject: autoload-rubric no longer provides a feature by default * lisp/emacs-lisp/autoload.el (autoload-rubric): Stop providing a feature unless explicitly requested. (autoload-find-generated-file): Update autoload-rubric call. --- lisp/emacs-lisp/autoload.el | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index f6b09dcf31d..8fe94013700 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -264,7 +264,7 @@ expression, in which case we want to handle forms differently." ;; problems when the file contains non-ASCII characters. (with-current-buffer (find-file-noselect (autoload-ensure-file-writeable file)) - (if (zerop (buffer-size)) (insert (autoload-rubric file))) + (if (zerop (buffer-size)) (insert (autoload-rubric file nil t))) (current-buffer)))) (defun autoload-generated-file () @@ -360,10 +360,7 @@ but adds an extra line to the output to modify `load-path'. If FEATURE is non-nil, FILE will provide a feature. FEATURE may be a string naming the feature, otherwise it will be based on -FILE's name. - -At present, a feature is in fact always provided, but this should -not be relied upon." +FILE's name." (let ((basename (file-name-nondirectory file)) (lp (if (equal type "package") (setq type "autoloads")))) (concat ";;; " basename @@ -372,15 +369,14 @@ not be relied upon." ";;; Code:\n\n" (if lp ;; `load-path' should contain only directory names. - "(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))\n \n" - (concat - ;; This is used outside of autoload.el, eg cus-dep, finder. - " \n" - "(provide '" - (if (stringp feature) - feature - (file-name-sans-extension basename)) - ")\n")) + "(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path))))\n\n") + " \n" + ;; This is used outside of autoload.el, eg cus-dep, finder. + (if feature + (format "(provide '%s)\n" + (if (stringp feature) feature + (file-name-sans-extension basename)))) ";; Local Variables:\n" ";; version-control: never\n" ";; no-byte-compile: t\n" -- cgit v1.2.3 From c189986b241cbe79b0e027fa08bba710ac645bb3 Mon Sep 17 00:00:00 2001 From: Jean-Christophe Helary Date: Fri, 19 May 2017 14:27:10 +0300 Subject: Add an optional arguments to string-trim * lisp/emacs-lisp/subr-x.el (string-trim-left, string-trim-right) (string-trim): Add optional args that serve as defaults per the original behavior. (Bug#26908) --- lisp/emacs-lisp/subr-x.el | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 8a955277fed..849ac19d6a5 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -178,21 +178,27 @@ VARLIST can just be a plain tuple. (define-obsolete-function-alias 'string-reverse 'reverse "25.1") -(defsubst string-trim-left (string) - "Remove leading whitespace from STRING." - (if (string-match "\\`[ \t\n\r]+" string) +(defsubst string-trim-left (string &optional regexp) + "Trim STRING of leading string matching REGEXP. + +REGEXP defaults to \"[ \\t\\n\\r]+\"." + (if (string-match (concat "\\`\\(?:" (or regexp "[ \t\n\r]+")"\\)") string) (replace-match "" t t string) string)) -(defsubst string-trim-right (string) - "Remove trailing whitespace from STRING." - (if (string-match "[ \t\n\r]+\\'" string) +(defsubst string-trim-right (string &optional regexp) + "Trim STRING of trailing string matching REGEXP. + +REGEXP defaults to \"[ \\t\\n\\r]+\"." + (if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string) (replace-match "" t t string) string)) -(defsubst string-trim (string) - "Remove leading and trailing whitespace from STRING." - (string-trim-left (string-trim-right string))) +(defsubst string-trim (string &optional trim-left trim-right) + "Trim STRING of leading and trailing strings matching TRIM-LEFT and TRIM-RIGHT. + +TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." + (string-trim-left (string-trim-right string trim-right) trim-left)) (defsubst string-blank-p (string) "Check whether STRING is either empty or only whitespace." -- cgit v1.2.3 From b372e565e4b2b9aaedfdc7d4a43ebc7ad3f66120 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 May 2017 09:42:57 -0400 Subject: * lisp/emacs-lisp/package.el: Quote `package-desc' in docstrings --- lisp/emacs-lisp/package.el | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c0ecb0447f3..551f440a8f9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -638,7 +638,7 @@ Return the max version (as a string) if the package is held at a lower version." (t (error "Invalid element in `package-load-list'"))))) (defun package-built-in-p (package &optional min-version) - "Return true if PACKAGE is built-in to Emacs. + "Return non-nil if PACKAGE is built-in to Emacs. Optional arg MIN-VERSION, if non-nil, should be a version list specifying the minimum acceptable version." (if (package-desc-p package) ;; was built-in and then was converted @@ -1776,7 +1776,7 @@ destructively set to nil in ONLY." That is, any element of the returned list is guaranteed to not directly depend on any elements that come before it. -PACKAGE-LIST is a list of package-desc objects. +PACKAGE-LIST is a list of `package-desc' objects. Indirect dependencies are guaranteed to be returned in order only if all the in-between dependencies are also in PACKAGE-LIST." (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list)) @@ -1845,11 +1845,11 @@ if all the in-between dependencies are also in PACKAGE-LIST." (setf (package-desc-signed (car pkg-descs)) t)))))))))) (defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of MIN-VERSION or newer, is installed. + "Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed. If PACKAGE is a symbol, it is the package name and MIN-VERSION should be a version list. -If PACKAGE is a package-desc object, MIN-VERSION is ignored." +If PACKAGE is a `package-desc' object, MIN-VERSION is ignored." (unless package--initialized (error "package.el is not yet initialized!")) (if (package-desc-p package) (let ((dir (package-desc-dir package))) @@ -1865,7 +1865,7 @@ If PACKAGE is a package-desc object, MIN-VERSION is ignored." (defun package-download-transaction (packages) "Download and install all the packages in PACKAGES. -PACKAGES should be a list of package-desc. +PACKAGES should be a list of `package-desc'. This function assumes that all package requirements in PACKAGES are satisfied, i.e. that PACKAGES is computed using `package-compute-transaction'." @@ -1932,13 +1932,13 @@ add a call to it along with some explanatory comments." ;;;###autoload (defun package-install (pkg &optional dont-select) "Install the package PKG. -PKG can be a package-desc or a symbol naming one of the available packages +PKG can be a `package-desc' or a symbol naming one of the available packages in an archive in `package-archives'. Interactively, prompt for its name. If called interactively or if DONT-SELECT nil, add PKG to `package-selected-packages'. -If PKG is a package-desc and it is already installed, don't try +If PKG is a `package-desc' and it is already installed, don't try to install it but still mark it as selected." (interactive (progn @@ -2067,7 +2067,7 @@ If some packages are not installed propose to install them." ;;; Package Deletion (defun package--newest-p (pkg) - "Return t if PKG is the newest package with its name." + "Return non-nil if PKG is the newest package with its name." (equal (cadr (assq (package-desc-name pkg) package-alist)) pkg)) @@ -2142,7 +2142,7 @@ If NOSAVE is non-nil, the package is not removed from ;;;###autoload (defun package-reinstall (pkg) "Reinstall package PKG. -PKG should be either a symbol, the package name, or a package-desc +PKG should be either a symbol, the package name, or a `package-desc' object." (interactive (list (intern (completing-read "Reinstall package: " @@ -2567,7 +2567,7 @@ package PKG-DESC, add one. The alist is keyed with PKG-DESC." (defun package--incompatible-p (pkg &optional shallow) "Return non-nil if PKG has no chance of being installable. -PKG is a package-desc object. +PKG is a `package-desc' object. If SHALLOW is non-nil, this only checks if PKG depends on a higher `emacs-version' than the one being used. Otherwise, also @@ -2651,7 +2651,7 @@ Installed obsolete packages are always displayed.") (defun package--remove-hidden (pkg-list) "Filter PKG-LIST according to `package-archive-priorities'. -PKG-LIST must be a list of package-desc objects, all with the +PKG-LIST must be a list of `package-desc' objects, all with the same name, sorted by decreasing `package-desc-priority-version'. Return a list of packages tied for the highest priority according to their archives." @@ -2905,7 +2905,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." ;;; Package menu printing (defun package-menu--print-info-simple (pkg) "Return a package entry suitable for `tabulated-list-entries'. -PKG is a package-desc object. +PKG is a `package-desc' object. Return (PKG-DESC [NAME VERSION STATUS DOC])." (let* ((status (package-desc-status pkg)) (face (pcase status -- cgit v1.2.3 From 021430f4b48ceb43a443fe805cfe0b21e7829760 Mon Sep 17 00:00:00 2001 From: "Charles A. Roelli" Date: Sat, 20 May 2017 14:41:53 +0300 Subject: New commands: find-library-other-window, find-library-other-frame * lisp/emacs-lisp/find-func.el (find-library-other-window) (find-library-other-frame): New commands to complement the existing 'find-library' command. (Bug#26712) (read-library-name): New function to read a library name. * etc/NEWS: Mention 'find-library-other-window' and 'find-library-other-frame'. --- etc/NEWS | 3 ++ lisp/emacs-lisp/find-func.el | 92 +++++++++++++++++++++++++++----------------- 2 files changed, 60 insertions(+), 35 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index aa579b11c7a..2a4b7014d4e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -356,6 +356,9 @@ use the local Emacs to edit remote files via Tramp. See the node ** The new variable 'eval-expression-print-maximum-character' prevents large integers from being displayed as characters. +** Two new commands for finding the source code of Emacs Lisp +libraries: 'find-library-other-window' and 'find-library-other-frame'. + * Editing Changes in Emacs 26.1 diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index d0acc147752..9b98f05ae81 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -271,43 +271,65 @@ TYPE should be nil to find a function, or `defvar' to find a variable." (cons (current-buffer) (match-beginning 0)))) ;;;###autoload -(defun find-library (library &optional other-window) +(defun find-library (library) "Find the Emacs Lisp source of LIBRARY. -LIBRARY should be a string (the name of the library). If the -optional OTHER-WINDOW argument (i.e., the command argument) is -specified, pop to a different window before displaying the -buffer." - (interactive - (let* ((dirs (or find-function-source-path load-path)) - (suffixes (find-library-suffixes)) - (table (apply-partially 'locate-file-completion-table - dirs suffixes)) - (def (if (eq (function-called-at-point) 'require) - ;; `function-called-at-point' may return 'require - ;; with `point' anywhere on this line. So wrap the - ;; `save-excursion' below in a `condition-case' to - ;; avoid reporting a scan-error here. - (condition-case nil - (save-excursion - (backward-up-list) - (forward-char) - (forward-sexp 2) - (thing-at-point 'symbol)) - (error nil)) - (thing-at-point 'symbol)))) - (when (and def (not (test-completion def table))) - (setq def nil)) - (list - (completing-read (if def - (format "Library name (default %s): " def) - "Library name: ") - table nil nil nil nil def) - current-prefix-arg))) + +Interactively, prompt for LIBRARY using the one at or near point." + (interactive (list (read-library-name))) + (prog1 + (switch-to-buffer (find-file-noselect (find-library-name library))) + (run-hooks 'find-function-after-hook))) + +(defun read-library-name () + "Read and return a library name, defaulting to the one near point. + +A library name is the filename of an Emacs Lisp library located +in a directory under `load-path' (or `find-function-source-path', +if non-nil)." + (let* ((dirs (or find-function-source-path load-path)) + (suffixes (find-library-suffixes)) + (table (apply-partially 'locate-file-completion-table + dirs suffixes)) + (def (if (eq (function-called-at-point) 'require) + ;; `function-called-at-point' may return 'require + ;; with `point' anywhere on this line. So wrap the + ;; `save-excursion' below in a `condition-case' to + ;; avoid reporting a scan-error here. + (condition-case nil + (save-excursion + (backward-up-list) + (forward-char) + (forward-sexp 2) + (thing-at-point 'symbol)) + (error nil)) + (thing-at-point 'symbol)))) + (when (and def (not (test-completion def table))) + (setq def nil)) + (completing-read (if def + (format "Library name (default %s): " def) + "Library name: ") + table nil nil nil nil def))) + +;;;###autoload +(defun find-library-other-window (library) + "Find the Emacs Lisp source of LIBRARY in another window. + +See `find-library' for more details." + (interactive (list (read-library-name))) + (prog1 + (switch-to-buffer-other-window (find-file-noselect + (find-library-name library))) + (run-hooks 'find-function-after-hook))) + +;;;###autoload +(defun find-library-other-frame (library) + "Find the Emacs Lisp source of LIBRARY in another frame. + +See `find-library' for more details." + (interactive (list (read-library-name))) (prog1 - (funcall (if other-window - 'pop-to-buffer - 'pop-to-buffer-same-window) - (find-file-noselect (find-library-name library))) + (switch-to-buffer-other-frame (find-file-noselect + (find-library-name library))) (run-hooks 'find-function-after-hook))) ;;;###autoload -- cgit v1.2.3 From f151eb01418b80d102c767566e93ac332a8bf7c3 Mon Sep 17 00:00:00 2001 From: Andreas Politz Date: Sat, 4 Mar 2017 05:58:34 +0100 Subject: Don't save unrelated buffers before recompiling directory (Bug#25964) * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Only save buffers visiting lisp files under the directory being compiled. --- lisp/emacs-lisp/bytecomp.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e716eef10ad..6c12e5d8e25 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1659,7 +1659,12 @@ that already has a `.elc' file." (if arg (setq arg (prefix-numeric-value arg))) (if noninteractive nil - (save-some-buffers) + (save-some-buffers + nil (lambda () + (let ((file (buffer-file-name))) + (and file + (string-match-p emacs-lisp-file-regexp file) + (file-in-directory-p file directory))))) (force-mode-line-update)) (with-current-buffer (get-buffer-create byte-compile-log-buffer) (setq default-directory (expand-file-name directory)) -- cgit v1.2.3 From 08212929ba7052883bd506be320dfaaae5b68970 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 21 May 2017 22:20:19 +0900 Subject: * lisp/emacs-lisp/package.el (package-delete): Delete readme file as well. --- lisp/emacs-lisp/package.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 551f440a8f9..cb8e2d60d6d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2128,10 +2128,15 @@ If NOSAVE is non-nil, the package is not removed from (t (add-hook 'post-command-hook #'package-menu--post-refresh) (delete-directory dir t t) - ;; Remove NAME-VERSION.signed file. - (let ((signed-file (concat dir ".signed"))) - (if (file-exists-p signed-file) - (delete-file signed-file))) + ;; Remove NAME-VERSION.signed and NAME-readme.txt files. + (dolist (suffix '(".signed" "readme.txt")) + (let* ((version (package-version-join (package-desc-version pkg-desc))) + (file (concat (if (string= suffix ".signed") + dir + (substring dir 0 (- (length version)))) + suffix))) + (when (file-exists-p file) + (delete-file file)))) ;; Update package-alist. (let ((pkgs (assq name package-alist))) (delete pkg-desc pkgs) -- cgit v1.2.3 From 9b0662d3698692f99384cfc8d1bd0b41b0625e09 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 23 May 2017 09:23:54 -0400 Subject: * lisp/emacs-lisp/cl-indent.el: Don't require CL. Use lexical-binding. (common-lisp-indent-function-1): Remove unused var `last-point`. (lisp-indent-error-function): Move defvar before first use. --- lisp/emacs-lisp/cl-indent.el | 34 ++++++++++++++++------------------ 1 file changed, 16 insertions(+), 18 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 33ecf3f4542..9941d173596 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -1,4 +1,4 @@ -;;; cl-indent.el --- enhanced lisp-indent mode +;;; cl-indent.el --- Enhanced lisp-indent mode -*- lexical-binding:t -*- ;; Copyright (C) 1987, 2000-2017 Free Software Foundation, Inc. @@ -35,7 +35,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defgroup lisp-indent nil "Indentation in Lisp." @@ -187,13 +187,13 @@ the standard lisp indent package." (when (and (eq lisp-indent-backquote-substitution-mode 'corrected)) (save-excursion (goto-char (elt state 1)) - (incf loop-indentation - (cond ((eq (char-before) ?,) -1) - ((and (eq (char-before) ?@) - (progn (backward-char) - (eq (char-before) ?,))) - -2) - (t 0))))) + (cl-incf loop-indentation + (cond ((eq (char-before) ?,) -1) + ((and (eq (char-before) ?@) + (progn (backward-char) + (eq (char-before) ?,))) + -2) + (t 0))))) (goto-char indent-point) (beginning-of-line) @@ -315,7 +315,6 @@ instead." ;; If non-nil, this is an indentation to use ;; if nothing else specifies it more firmly. tentative-calculated - (last-point indent-point) ;; the position of the open-paren of the innermost containing list (containing-form-start (elt state 1)) ;; the column of the above @@ -410,9 +409,9 @@ instead." ;; ",(...)" or ",@(...)" (when (eq lisp-indent-backquote-substitution-mode 'corrected) - (incf sexp-column -1) + (cl-incf sexp-column -1) (when (eq (char-after (1- containing-sexp)) ?\@) - (incf sexp-column -1))) + (cl-incf sexp-column -1))) (cond (lisp-indent-backquote-substitution-mode (setf tentative-calculated normal-indent) (setq depth lisp-indent-maximum-backtracking) @@ -465,7 +464,6 @@ instead." function method path state indent-point sexp-column normal-indent))))) (goto-char containing-sexp) - (setq last-point containing-sexp) (unless calculated (condition-case () (progn (backward-up-list 1) @@ -474,6 +472,9 @@ instead." (or calculated tentative-calculated)))) +;; Dynamically bound in common-lisp-indent-call-method. +(defvar lisp-indent-error-function) + (defun common-lisp-indent-call-method (function method path state indent-point sexp-column normal-indent) (let ((lisp-indent-error-function function)) @@ -484,9 +485,6 @@ instead." (lisp-indent-259 method path state indent-point sexp-column normal-indent)))) -;; Dynamically bound in common-lisp-indent-call-method. -(defvar lisp-indent-error-function) - (defun lisp-indent-report-bad-format (m) (error "%s has a badly-formed %s property: %s" ;; Love those free variable references!! @@ -717,7 +715,7 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\ (forward-sexp 2) (skip-chars-forward " \t\n") (while (looking-at "\\sw\\|\\s_") - (incf nqual) + (cl-incf nqual) (forward-sexp) (skip-chars-forward " \t\n")) (> nqual 0))) @@ -726,7 +724,7 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\ path state indent-point sexp-column normal-indent)) -(defun lisp-indent-function-lambda-hack (path state indent-point +(defun lisp-indent-function-lambda-hack (path _state _indent-point sexp-column normal-indent) ;; indent (function (lambda () )) kludgily. (if (or (cdr path) ; wtf? -- cgit v1.2.3 From d158629cb6d0dd7cf0227d993d59ea6faa4438c9 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Fri, 21 Apr 2017 00:00:26 -0400 Subject: Give a name to lisp-mode's adaptive-fill-function (Bug#22730) * lisp/emacs-lisp/lisp-mode.el (lisp-adaptive-fill): New function. (lisp-mode-variables): Use it. --- lisp/emacs-lisp/lisp-mode.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 3334471d251..1e38d44e1b1 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -576,6 +576,13 @@ Lisp font lock syntactic face function." font-lock-string-face)))) font-lock-comment-face)) +(defun lisp-adaptive-fill () + "Return fill prefix found at point. +Value for `adaptive-fill-function'." + ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of + ;; a single docstring. Let's fix it here. + (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")) + (defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive elisp) "Common initialization routine for lisp modes. @@ -587,10 +594,7 @@ font-lock keywords will not be case sensitive." (set-syntax-table lisp-mode-syntax-table)) (setq-local paragraph-ignore-fill-prefix t) (setq-local fill-paragraph-function 'lisp-fill-paragraph) - ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of - ;; a single docstring. Let's fix it here. - (setq-local adaptive-fill-function - (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))) + (setq-local adaptive-fill-function #'lisp-adaptive-fill) ;; Adaptive fill mode gets in the way of auto-fill, ;; and should make no difference for explicit fill ;; because lisp-fill-paragraph should do the job. -- cgit v1.2.3 From ef9f5c672a8e248dd7bd682101c03feb2e527340 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 25 Apr 2017 08:39:17 -0400 Subject: Protect *Backtrace* from being killed (Bug#26650) * lisp/emacs-lisp/debug.el (debugger-mode): Call `top-level' in `kill-buffer-hook'. --- lisp/emacs-lisp/debug.el | 3 +++ 1 file changed, 3 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index cb77148c285..83456fc31a2 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -727,6 +727,9 @@ Complete list of commands: \\{debugger-mode-map}" (setq truncate-lines t) (set-syntax-table emacs-lisp-mode-syntax-table) + (add-hook 'kill-buffer-hook + (lambda () (if (> (recursion-depth) 0) (top-level))) + nil t) (use-local-map debugger-mode-map)) (defcustom debugger-record-buffer "*Debugger-record*" -- cgit v1.2.3 From dc79aa10f117dea1204634626a5f96a21722807f Mon Sep 17 00:00:00 2001 From: Wilfred Hughes Date: Fri, 26 May 2017 22:45:58 +0100 Subject: Mark keywordp as a safe, error-free function * lisp/emacs-lisp/byte-opt.el: Add keywordp to side-effect-and-error-free-fns. --- lisp/emacs-lisp/byte-opt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 2a240f502c4..962a7ae5cde 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1247,7 +1247,7 @@ hash-table-p identity ignore integerp integer-or-marker-p interactive-p invocation-directory invocation-name - keymapp + keymapp keywordp line-beginning-position line-end-position list listp make-marker mark mark-marker markerp max-char memory-limit minibuffer-window -- cgit v1.2.3 From 6f63c7cb6a02d913d195410e4df85fad5832db06 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Fri, 26 May 2017 23:26:27 -0400 Subject: * lisp/emacs-lisp/eieio.el (defclass): Fix quote in warning message. --- lisp/emacs-lisp/eieio.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index e21d46e5289..1a7de55fcef 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -235,7 +235,7 @@ This method is obsolete." (let ((f (intern (format "%s-child-p" name)))) `((defalias ',f ',testsym2) (make-obsolete - ',f ,(format "use (cl-typep ... '%s) instead" name) + ',f ,(format "use (cl-typep ... \\='%s) instead" name) "25.1")))) ;; When using typep, (typep OBJ 'myclass) returns t for objects which -- cgit v1.2.3 From ebe0bdae9ded4eab974faefb54a6ba5260523489 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 27 May 2017 14:39:01 +0200 Subject: Don't attempt to recover from undefined behavior in some cases These functions can only be run in batch mode and exit Emacs on return, so nothing can be recovered. Disable unsafe recover mechanisms so that we get real failures and good stack traces on fatal signals. * lisp/emacs-lisp/bytecomp.el (batch-byte-compile) (batch-byte-recompile-directory): * lisp/emacs-lisp/ert.el (ert-run-tests-batch-and-exit) (ert-summarize-tests-batch-and-exit): Don't attempt to recover from undefined behavior. --- lisp/emacs-lisp/bytecomp.el | 8 ++++++++ lisp/emacs-lisp/ert.el | 10 ++++++++++ 2 files changed, 18 insertions(+) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6c12e5d8e25..12a7d4afc2a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4960,6 +4960,10 @@ already up-to-date." (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "`batch-byte-compile' is to be used only with -batch")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (let ((error nil)) (while command-line-args-left (if (file-directory-p (expand-file-name (car command-line-args-left))) @@ -5052,6 +5056,10 @@ and corresponding effects." (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "batch-byte-recompile-directory is to be used only with -batch")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (or command-line-args-left (setq command-line-args-left '("."))) (while command-line-args-left diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 280b76acfe4..2c49a634e35 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1458,6 +1458,12 @@ The exit status will be 0 if all test results were as expected, 1 on unexpected results, or 2 if the tool detected an error outside of the tests (e.g. invalid SELECTOR or bug in the code that runs the tests)." + (or noninteractive + (user-error "This function is only for use in batch mode")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (unwind-protect (let ((stats (ert-run-tests-batch selector))) (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1))) @@ -1475,6 +1481,10 @@ The logfiles should have the `ert-run-tests-batch' format. When finished, this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." (or noninteractive (user-error "This function is only for use in batch mode")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (let ((nlogs (length command-line-args-left)) (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) nnotrun logfile notests badtests unexpected skipped) -- cgit v1.2.3 From 527a7cc9425370f7217a4d2b6914b96dff6f5ec1 Mon Sep 17 00:00:00 2001 From: "Svante Carl v. Erichsen" Date: Sun, 6 Oct 2013 20:33:24 +0200 Subject: Fix cl-indent for `loop' with :keywords (Bug#15543) * lisp/emacs-lisp/cl-indent.el (lisp-extended-loop-p): Allow for ":keywords". Copyright-paperwork-exempt: yes --- lisp/emacs-lisp/cl-indent.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 9941d173596..df0e0a88583 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -166,7 +166,7 @@ is set to `defun'.") (forward-char 1) (forward-sexp 2) (backward-sexp 1) - (looking-at "\\sw")) + (looking-at "\\(:\\|\\sw\\)")) (error t))) (defun lisp-indent-find-method (symbol &optional no-compat) -- cgit v1.2.3 From 2349f1df1b11381c421287670ffd0f84725d7818 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 30 May 2017 02:55:28 +0300 Subject: Turn global-eldoc-mode into a globalized minor mode * lisp/emacs-lisp/eldoc.el (global-eldoc-mode): Turn into globalized mode (bug#19853). (turn-on-eldoc-mode): Make it into a wrapper instead of alias. (eldoc-mode): Only show the message when called interactively. --- lisp/emacs-lisp/eldoc.el | 29 +++++++++-------------------- 1 file changed, 9 insertions(+), 20 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 6cb8e6ce480..b0f6ea4412d 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -187,7 +187,8 @@ expression point is on." (setq eldoc-last-message nil) (cond ((memq eldoc-documentation-function '(nil ignore)) - (message "There is no ElDoc support in this buffer") + (when (called-interactively-p 'any) + (message "There is no ElDoc support in this buffer")) (setq eldoc-mode nil)) (eldoc-mode (when eldoc-print-after-edit @@ -203,29 +204,17 @@ expression point is on." (setq eldoc-timer nil))))) ;;;###autoload -(define-minor-mode global-eldoc-mode - "Toggle Global Eldoc mode on or off. -With a prefix argument ARG, enable Global Eldoc mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil, and toggle it if ARG is ‘toggle’. - -If Global Eldoc mode is on, `eldoc-mode' will be enabled in all -buffers where it's applicable. These are buffers that have modes -that have enabled eldoc support. See `eldoc-documentation-function'." +(define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode :group 'eldoc - :global t :initialize 'custom-initialize-delay - :init-value t - (setq eldoc-last-message nil) - (if global-eldoc-mode - (progn - (add-hook 'post-command-hook #'eldoc-schedule-timer) - (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area)) - (remove-hook 'post-command-hook #'eldoc-schedule-timer) - (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area))) + :init-value t) ;;;###autoload -(define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4") +(defun turn-on-eldoc-mode () + "Turn on `eldoc-mode' if the buffer has eldoc support enabled. +See `eldoc-documentation-function' for more detail." + (unless (memq eldoc-documentation-function '(nil ignore)) + (eldoc-mode 1))) (defun eldoc-schedule-timer () -- cgit v1.2.3 From e3b51b080fab02f579b7c6a91b609a2c0aca8339 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 31 May 2017 01:29:34 +0300 Subject: Extract eldoc--supported-p * lisp/emacs-lisp/eldoc.el (eldoc--supported-p): New function. (turn-on-eldoc-mode, eldoc-mode): Use it. (http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00865.html) --- lisp/emacs-lisp/eldoc.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index b0f6ea4412d..40f5e2ef96a 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -186,7 +186,7 @@ expression point is on." :group 'eldoc :lighter eldoc-minor-mode-string (setq eldoc-last-message nil) (cond - ((memq eldoc-documentation-function '(nil ignore)) + ((not (eldoc--supported-p)) (when (called-interactively-p 'any) (message "There is no ElDoc support in this buffer")) (setq eldoc-mode nil)) @@ -213,9 +213,12 @@ expression point is on." (defun turn-on-eldoc-mode () "Turn on `eldoc-mode' if the buffer has eldoc support enabled. See `eldoc-documentation-function' for more detail." - (unless (memq eldoc-documentation-function '(nil ignore)) + (when (eldoc--supported-p) (eldoc-mode 1))) +(defun eldoc--supported-p () + (not (memq eldoc-documentation-function '(nil ignore)))) + (defun eldoc-schedule-timer () (or (and eldoc-timer -- cgit v1.2.3 From a415c8bccb917c247792c4ce8e77b2512b3414d6 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 28 May 2017 17:01:05 -0400 Subject: cl-print: handle circular objects when `print-circle' is nil (Bug#27117) * lisp/emacs-lisp/cl-print.el (cl-print--currently-printing): New variable. (cl-print-object): When `print-circle' is nil, bind it to a list of objects that are currently printing to avoid printing the same object endlessly. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-circle): New test. --- lisp/emacs-lisp/cl-print.el | 35 +++++++++++++++++++++++----------- test/lisp/emacs-lisp/cl-print-tests.el | 8 ++++++++ 2 files changed, 32 insertions(+), 11 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 65c86d2b65e..70ccaac17b3 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -37,6 +37,7 @@ "If non-nil, try and make sure the result can be `read'.") (defvar cl-print--number-table nil) +(defvar cl-print--currently-printing nil) ;;;###autoload (cl-defgeneric cl-print-object (object stream) @@ -59,8 +60,9 @@ call other entry points instead, such as `cl-prin1'." (princ "(" stream) (cl-print-object car stream) (while (and (consp object) - (not (and cl-print--number-table - (numberp (gethash object cl-print--number-table))))) + (not (if cl-print--number-table + (numberp (gethash object cl-print--number-table)) + (memq object cl-print--currently-printing)))) (princ " " stream) (cl-print-object (pop object) stream)) (when object @@ -156,15 +158,26 @@ call other entry points instead, such as `cl-prin1'." (cl-defmethod cl-print-object :around (object stream) ;; FIXME: Only put such an :around method on types where it's relevant. - (let ((n (if cl-print--number-table (gethash object cl-print--number-table)))) - (if (not (numberp n)) - (cl-call-next-method) - (if (> n 0) - ;; Already printed. Just print a reference. - (progn (princ "#" stream) (princ n stream) (princ "#" stream)) - (puthash object (- n) cl-print--number-table) - (princ "#" stream) (princ (- n) stream) (princ "=" stream) - (cl-call-next-method))))) + (cond + (print-circle + (let ((n (gethash object cl-print--number-table))) + (if (not (numberp n)) + (cl-call-next-method) + (if (> n 0) + ;; Already printed. Just print a reference. + (progn (princ "#" stream) (princ n stream) (princ "#" stream)) + (puthash object (- n) cl-print--number-table) + (princ "#" stream) (princ (- n) stream) (princ "=" stream) + (cl-call-next-method))))) + ((let ((already-printing (memq object cl-print--currently-printing))) + (when already-printing + ;; Currently printing, just print reference to avoid endless + ;; recursion. + (princ "#" stream) + (princ (length (cdr already-printing)) stream)))) + (t (let ((cl-print--currently-printing + (cons object cl-print--currently-printing))) + (cl-call-next-method))))) (defvar cl-print--number-index nil) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 772601fe87d..dfbe18d7844 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -47,4 +47,12 @@ "\\`(#1=#s(foo 1 2 3) #1#)\\'" (cl-prin1-to-string (list x x))))))) +(ert-deftest cl-print-circle () + (let ((x '(#1=(a . #1#) #1#))) + (let ((print-circle nil)) + (should (string-match "\\`((a . #[0-9]) (a . #[0-9]))\\'" + (cl-prin1-to-string x)))) + (let ((print-circle t)) + (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x)))))) + ;;; cl-print-tests.el ends here. -- cgit v1.2.3 From 0dd1bbb0bb228acab21b8e16f2f2a0b5a17b19ab Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 1 Jun 2017 00:09:43 +0200 Subject: Implement field numbers in format strings A field number explicitly specifies the argument to be formatted. This is especially important for potential localization work, since grammars of various languages dictate different word orders. * src/editfns.c (Fformat): Update documentation. (styled_format): Implement field numbers. * doc/lispref/strings.texi (Formatting Strings): Document field numbers. * lisp/emacs-lisp/bytecomp.el (byte-compile-format-warn): Adapt. * test/src/editfns-tests.el (format-with-field): New unit test. --- doc/lispref/strings.texi | 31 ++++++++++++++++++++++--- etc/NEWS | 3 +++ lisp/emacs-lisp/bytecomp.el | 11 ++++++--- src/editfns.c | 55 ++++++++++++++++++++++++++++++++++++++------- test/src/editfns-tests.el | 18 +++++++++++++++ 5 files changed, 104 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 9436a96ead4..526b1fb4ebc 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -864,7 +864,8 @@ below, as the first argument, and the string as the second, like this: (format "%s" @var{arbitrary-string}) @end example - If @var{string} contains more than one format specification, the + If @var{string} contains more than one format specification and none +of the format specifications contain an explicit field number, the format specifications correspond to successive values from @var{objects}. Thus, the first format specification in @var{string} uses the first such value, the second format specification uses the @@ -961,6 +962,25 @@ operation} error. @end group @end example +@cindex field numbers in format spec + A specification can have a @dfn{field number}, which is a decimal +number after the initial @samp{%}, followed by a literal dollar sign +@samp{$}. If you provide a field number, then the argument to be +printed corresponds to the given field number instead of the next +argument. Field numbers start at 1. + +You can mix specifications with and without field numbers. A +specification without a field number that follows a specification with +a field number will convert the argument after the one specified by +the field number: + +@example +(format "First argument %2$s, then %s, then %1$s" 1 2 3) + @result{} "First argument 2, then 3, then 1" +@end example + +You can't use field numbers in a @samp{%%} specification. + @cindex field width @cindex padding A specification can have a @dfn{width}, which is a decimal number @@ -996,9 +1016,14 @@ is not truncated. @end group @end example +If you want to use both a field number and a width, place the field +number before the width. For example, in @samp{%2$7s}, @samp{2} is +the field number and @samp{7} is the width. + @cindex flags in format specifications - Immediately after the @samp{%} and before the optional width -specifier, you can also put certain @dfn{flag characters}. + After the @samp{%} and before the optional width specifier, you can +also put certain @dfn{flag characters}. The flag characters need to +come directly after a potential field number. The flag @samp{+} inserts a plus sign before a positive number, so that it always has a sign. A space character as flag inserts a space diff --git a/etc/NEWS b/etc/NEWS index 055de8ca9e8..1b098f98425 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -368,6 +368,9 @@ libraries: 'find-library-other-window' and 'find-library-other-frame'. ** The new variable 'display-raw-bytes-as-hex' allows to change the display of raw bytes from octal to hex. +** You can now provide explicit field numbers in format specifiers. +For example, '(format "%2$s %1$s" 1 2)' produces "2 1". + * Editing Changes in Emacs 26.1 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 12a7d4afc2a..e5b9b47b1d0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1375,10 +1375,15 @@ extra args." (let ((nfields (with-temp-buffer (insert (nth 1 form)) (goto-char (point-min)) - (let ((n 0)) + (let ((i 0) (n 0)) (while (re-search-forward "%." nil t) - (unless (eq ?% (char-after (1+ (match-beginning 0)))) - (setq n (1+ n)))) + (backward-char) + (unless (eq ?% (char-after)) + (setq i (if (looking-at "\\([0-9]+\\)\\$") + (string-to-number (match-string 1) 10) + (1+ i)) + n (max n i))) + (forward-char)) n))) (nargs (- (length form) 2))) (unless (= nargs nfields) diff --git a/src/editfns.c b/src/editfns.c index 89a67241044..44341cef2d3 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -48,6 +48,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include #include @@ -3856,7 +3857,7 @@ The first argument is a format control string. The other arguments are substituted into it to make the result, a string. The format control string may contain %-sequences meaning to substitute -the next available argument: +the next available argument, or the argument explicitly specified: %s means print a string argument. Actually, prints any object, with `princ'. %d means print as signed number in decimal. @@ -3873,13 +3874,17 @@ the next available argument: The argument used for %d, %o, %x, %e, %f, %g or %c must be a number. Use %% to put a single % into the output. -A %-sequence may contain optional flag, width, and precision -specifiers, as follows: +A %-sequence may contain optional field number, flag, width, and +precision specifiers, as follows: - %character + %character -where flags is [+ #-0]+, width is [0-9]+, and precision is a literal -period "." followed by [0-9]+ +where field is [0-9]+ followed by a literal dollar "$", flags is +[+ #-0]+, width is [0-9]+, and precision is a literal period "." +followed by [0-9]+. + +If field is given, it must be a one-based argument number; the given +argument is substituted instead of the next one. The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only @@ -4032,14 +4037,19 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { /* General format specifications look like - '%' [flags] [field-width] [precision] format + '%' [field-number] [flags] [field-width] [precision] format where + field-number ::= [0-9]+ '$' flags ::= [-+0# ]+ field-width ::= [0-9]+ precision ::= '.' [0-9]* + If a field-number is specified, it specifies the argument + number to substitute. Otherwise, the next argument is + taken. + If a field-width is specified, it specifies to which width the output should be padded with blanks, if the output string is shorter than field-width. @@ -4048,6 +4058,29 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) digits to print after the '.' for floats, or the max. number of chars to print from a string. */ + char *field_end; + uintmax_t raw_field = strtoumax (format, &field_end, 10); + bool has_field = false; + if (c_isdigit (*format) && *field_end == '$') + { + if (raw_field < 1 || raw_field >= PTRDIFF_MAX) + { + /* doprnt doesn't support %.*s, so we need to copy + the field number string. */ + ptrdiff_t length = field_end - format; + eassert (length > 0); + eassert (length < PTRDIFF_MAX); + char *field = SAFE_ALLOCA (length + 1); + memcpy (field, format, length); + field[length] = '\0'; + error ("Invalid field number `%s'", field); + } + has_field = true; + /* n is incremented below. */ + n = raw_field - 1; + format = field_end + 1; + } + bool minus_flag = false; bool plus_flag = false; bool space_flag = false; @@ -4090,7 +4123,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) memset (&discarded[format0 - format_start], 1, format - format0 - (conversion == '%')); if (conversion == '%') - goto copy_char; + { + if (has_field) + /* FIXME: `error' doesn't appear to support `%%'. */ + error ("Field number specified together with `%c' conversion", + '%'); + goto copy_char; + } ++n; if (! (n < nargs)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 8019eb03838..f76c6c9fd36 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -177,4 +177,22 @@ (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil (concat (make-string 2048 ?X) "0"))))) +(ert-deftest format-with-field () + (should (equal (format "First argument %2$s, then %s, then %1$s" 1 2 3) + "First argument 2, then 3, then 1")) + (should (equal (format "a %2$s %d %1$d %2$S %d %d b" 11 "22" 33 44) + "a 22 33 11 \"22\" 33 44 b")) + (should (equal (format "a %08$s %s b" 1 2 3 4 5 6 7 8 9) "a 8 9 b")) + (should (equal (should-error (format "a %999999$s b" 11)) + '(error "Not enough arguments for format string"))) + (should (equal (should-error (format "a %$s b" 11)) + ;; FIXME: there shouldn't be two % in the error + ;; string! + '(error "Invalid format operation %%$"))) + (should (equal (should-error (format "a %0$s b" 11)) + '(error "Invalid field number `0'"))) + (should (equal + (should-error (format "a %1$% %s b" 11)) + '(error "Field number specified together with `%' conversion")))) + ;;; editfns-tests.el ends here -- cgit v1.2.3 From f858c585a39e83e062ff33e068b8376e7aecabdf Mon Sep 17 00:00:00 2001 From: Andy Moreton Date: Tue, 6 Jun 2017 01:01:55 +0300 Subject: Fix check for package-unsigned-archives during retrieval * lisp/emacs-lisp/package.el (package--download-one-archive): Fix check for package-unsigned-archives. --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index cb8e2d60d6d..bebfd18d7a6 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1529,7 +1529,7 @@ similar to an entry in `package-alist'. Save the cached copy to (when (listp (read-from-string content)) (make-directory dir t) (if (or (not package-check-signature) - (member archive package-unsigned-archives)) + (member name package-unsigned-archives)) ;; If we don't care about the signature, save the file and ;; we're done. (progn (write-region content nil local-file nil 'silent) -- cgit v1.2.3 From 3632633cab801f84a23f60d5585acfae38f6e60c Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Tue, 6 Jun 2017 01:23:41 +0300 Subject: Enable ElDoc messages after the newline command * lisp/emacs-lisp/eldoc.el: Add "newline" to the eldoc-add-command-completions call (bug#27228). --- lisp/emacs-lisp/eldoc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 40f5e2ef96a..a05bd7cc4d4 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -418,7 +418,7 @@ return any documentation.") "down-list" "end-of-" "exchange-point-and-mark" "forward-" "goto-" "handle-select-window" "indent-for-tab-command" "left-" "mark-page" "mark-paragraph" "mouse-set-point" "move-" "move-beginning-of-" - "move-end-of-" "next-" "other-window" "pop-global-mark" "previous-" + "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" "previous-" "recenter" "right-" "scroll-" "self-insert-command" "split-window-" "up-list") -- cgit v1.2.3 From 0648edf3e05e224ee8410ab244df7364f919dc58 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Fri, 21 Apr 2017 23:37:05 -0400 Subject: Split variable macro env from function env * lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand): Remove. (cl-symbol-macrolet): Instead of adding each binding directly into the main environment with a special key format, put all symbol macro bindings into a single entry in the main environment under `:cl-symbol-macros'. (cl--sm-macroexpand): Look up symbol bindings in the `:cl-symbol-macros' entry of the environment. --- lisp/emacs-lisp/cl-macs.el | 64 ++++++++++++++++++++-------------------------- 1 file changed, 28 insertions(+), 36 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index db1518ce611..b1ada00f4a4 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2047,28 +2047,22 @@ This is like `cl-flet', but for macros instead of functions. cl--old-macroexpand (symbol-function 'macroexpand))) -(defun cl--symbol-macro-key (sym) - "Return the key used in `macroexpand-all-environment' for symbol macro SYM." - ;; In the past we've used `symbol-name' instead, but that doesn't - ;; preserve the `eq'uality between different symbols of the same name. - `(:cl-symbol-macro . ,sym)) - (defun cl--sm-macroexpand (exp &optional env) "Special macro expander used inside `cl-symbol-macrolet'. This function replaces `macroexpand' during macro expansion of `cl-symbol-macrolet', and does the same thing as `macroexpand' except that it additionally expands symbol macros." - (let ((macroexpand-all-environment env)) + (let ((macroexpand-all-environment env) + (venv (alist-get :cl-symbol-macros env))) (while (progn (setq exp (funcall cl--old-macroexpand exp env)) (pcase exp ((pred symbolp) ;; Perform symbol-macro expansion. - ;; FIXME: Calling `cl--symbol-macro-key' for every var reference - ;; is a bit more costly than I'd like. - (when (cdr (assoc (cl--symbol-macro-key exp) env)) - (setq exp (cadr (assoc (cl--symbol-macro-key exp) env))))) + (let ((symval (assq exp venv))) + (when symval + (setq exp (cadr symval))))) (`(setq . ,_) ;; Convert setq to setf if required by symbol-macro expansion. (let* ((args (mapcar (lambda (f) (cl--sm-macroexpand f env)) @@ -2086,7 +2080,7 @@ except that it additionally expands symbol macros." (let ((letf nil) (found nil) (nbs ())) (dolist (binding bindings) (let* ((var (if (symbolp binding) binding (car binding))) - (sm (assoc (cl--symbol-macro-key var) env))) + (sm (assq var venv))) (push (if (not (cdr sm)) binding (let ((nexp (cadr sm))) @@ -2144,30 +2138,28 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). \(fn ((NAME EXPANSION) ...) FORM...)" (declare (indent 1) (debug ((&rest (symbolp sexp)) cl-declarations body))) - (cond - ((cdr bindings) - `(cl-symbol-macrolet (,(car bindings)) - (cl-symbol-macrolet ,(cdr bindings) ,@body))) - ((null bindings) (macroexp-progn body)) - (t - (let ((previous-macroexpand (symbol-function 'macroexpand))) - (unwind-protect - (progn - (fset 'macroexpand #'cl--sm-macroexpand) - (let ((expansion - ;; FIXME: For N bindings, this will traverse `body' N times! - (macroexpand-all (macroexp-progn body) - (cons (list (cl--symbol-macro-key - (caar bindings)) - (cl-cadar bindings)) - macroexpand-all-environment)))) - (if (or (null (cdar bindings)) (cl-cddar bindings)) - (macroexp--warn-and-return - (format-message "Malformed `cl-symbol-macrolet' binding: %S" - (car bindings)) - expansion) - expansion))) - (fset 'macroexpand previous-macroexpand)))))) + (let ((previous-macroexpand (symbol-function 'macroexpand)) + (malformed-bindings nil)) + (dolist (binding bindings) + (unless (and (consp binding) (symbolp (car binding)) + (consp (cdr binding)) (null (cddr binding))) + (push binding malformed-bindings))) + (unwind-protect + (progn + (fset 'macroexpand #'cl--sm-macroexpand) + (let* ((venv (cdr (assq :cl-symbol-macros macroexpand-all-environment))) + (expansion + (macroexpand-all (macroexp-progn body) + (cons (cons :cl-symbol-macros + (append bindings venv)) + macroexpand-all-environment)))) + (if malformed-bindings + (macroexp--warn-and-return + (format-message "Malformed `cl-symbol-macrolet' binding(s): %S" + (nreverse malformed-bindings)) + expansion) + expansion))) + (fset 'macroexpand previous-macroexpand)))) ;;; Multiple values. -- cgit v1.2.3 From 9b0f52a86e8e3767d7fcf3ef2adf7aa1f58e0e93 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 11 Jun 2017 09:49:44 -0400 Subject: Buttonize # part of printed functions (Bug#25226) * lisp/emacs-lisp/cl-print.el: Autoload `disassemble-1'. (cl-print-compiled-button): New variable. (help-byte-code): New button type, calls `disassemble' in its action. (cl-print-object): Use it if `cl-print-compiled-button' is non-nil. --- lisp/emacs-lisp/cl-print.el | 33 +++++++++++++++++++++++++++++---- 1 file changed, 29 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 70ccaac17b3..89a71d1b6c5 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -33,6 +33,8 @@ ;;; Code: +(require 'button) + (defvar cl-print-readably nil "If non-nil, try and make sure the result can be `read'.") @@ -76,13 +78,27 @@ call other entry points instead, such as `cl-prin1'." (cl-print-object (aref object i) stream)) (princ "]" stream)) +(define-button-type 'help-byte-code + 'follow-link t + 'action (lambda (button) + (disassemble (button-get button 'byte-code-function))) + 'help-echo (purecopy "mouse-2, RET: disassemble this function")) + (defvar cl-print-compiled nil "Control how to print byte-compiled functions. Can be: - `static' to print the vector of constants. - `disassemble' to print the disassembly of the code. - nil to skip printing any details about the code.") +(defvar cl-print-compiled-button nil + "Control how to print byte-compiled functions into buffers. +When the stream is a buffer, make the bytecode part of the output +into a button whose action shows the function's disassembly.") + +(autoload 'disassemble-1 "disass") + (cl-defmethod cl-print-object ((object compiled-function) stream) + (unless stream (setq stream standard-output)) ;; We use "#f(...)" rather than "#<...>" so that pp.el gives better results. (princ "#f(compiled-function " stream) (let ((args (help-function-arglist object 'preserve-names))) @@ -110,10 +126,19 @@ call other entry points instead, such as `cl-prin1'." (disassemble-1 object 0) (buffer-string)) stream) - (princ " #" stream) - (when (eq cl-print-compiled 'static) - (princ " " stream) - (cl-print-object (aref object 2) stream))) + (princ " " stream) + (let ((button-start (and cl-print-compiled-button + (bufferp stream) + (with-current-buffer stream (point))))) + (princ "#" stream) + (when (eq cl-print-compiled 'static) + (princ " " stream) + (cl-print-object (aref object 2) stream)) + (when button-start + (with-current-buffer stream + (make-text-button button-start (point) + :type 'help-byte-code + 'byte-code-function object))))) (princ ")" stream)) ;; This belongs in nadvice.el, of course, but some load-ordering issues make it -- cgit v1.2.3 From cc8aa484cdab6b2f33a8c95a5778193c762412b9 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 10 Jun 2017 09:50:48 -0400 Subject: Fix wrong indentation after string literal (Bug#27306) * lisp/emacs-lisp/lisp-mode.el (lisp-indent-state) (lisp-indent-calc-next): Remove `depth' field, use (car ppss) instead. * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-indent-region-after-string-literal): New test. --- lisp/emacs-lisp/lisp-mode.el | 27 +++++++++++++-------------- test/lisp/emacs-lisp/lisp-mode-tests.el | 13 +++++++++++++ 2 files changed, 26 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1e38d44e1b1..59db00d5f96 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -773,11 +773,9 @@ complete sexp in the innermost containing list at position (:constructor lisp-indent-initial-state (&aux (ppss (lisp-ppss)) (ppss-point (point)) - (depth (car ppss)) - (stack (make-list (1+ depth) nil))))) + (stack (make-list (1+ (car ppss)) nil))))) stack ;; Cached indentation, per depth. ppss - depth ppss-point) (defun lisp-indent-calc-next (state) @@ -785,9 +783,11 @@ complete sexp in the innermost containing list at position STATE is updated by side effect, the first state should be created by `lisp-indent-initial-state'. This function may move by more than one line to cross a string literal." - (pcase-let (((cl-struct lisp-indent-state - (stack indent-stack) ppss depth ppss-point) - state)) + (pcase-let* (((cl-struct lisp-indent-state + (stack indent-stack) ppss ppss-point) + state) + (indent-depth (car ppss)) ; Corresponding to indent-stack. + (depth indent-depth)) ;; Parse this line so we can learn the state to indent the ;; next line. (while (let ((last-sexp (nth 2 ppss))) @@ -799,22 +799,22 @@ by more than one line to cross a string literal." (if (and (not (nth 2 ppss)) (= depth (car ppss))) (setf (nth 2 ppss) last-sexp) (setq last-sexp (nth 2 ppss))) + (setq depth (car ppss)) ;; Skip over newlines within strings. (nth 3 ppss)) (let ((string-start (nth 8 ppss))) - (setq ppss (parse-partial-sexp (point) (point-max) - nil nil ppss 'syntax-table)) - (setf (nth 2 ppss) string-start)) ; Finished a complete string. + (setq ppss (parse-partial-sexp (point) (point-max) + nil nil ppss 'syntax-table)) + (setf (nth 2 ppss) string-start) ; Finished a complete string. + (setq depth (car ppss))) (setq ppss-point (point))) (setq ppss-point (point)) - (let* ((next-depth (car ppss)) - (depth-delta (- next-depth depth))) + (let* ((depth-delta (- depth indent-depth))) (cond ((< depth-delta 0) (setq indent-stack (nthcdr (- depth-delta) indent-stack))) ((> depth-delta 0) (setq indent-stack (nconc (make-list depth-delta nil) - indent-stack)))) - (setq depth next-depth)) + indent-stack))))) (prog1 (let (indent) (cond ((= (forward-line 1) 1) nil) @@ -826,7 +826,6 @@ by more than one line to cross a string literal." ;; This only happens if we're in a string. (t (error "This shouldn't happen")))) (setf (lisp-indent-state-stack state) indent-stack) - (setf (lisp-indent-state-depth state) depth) (setf (lisp-indent-state-ppss-point state) ppss-point) (setf (lisp-indent-state-ppss state) ppss)))) diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index f2fe7a6cf41..582041cfc2d 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -185,6 +185,19 @@ Test indentation in emacs-lisp-mode\" (indent-region (point) (point-max)) (should (equal (buffer-string) correct))))) +(ert-deftest lisp-indent-region-after-string-literal () + (with-temp-buffer + (insert "\ +\(user-error \"Unexpected initialization file: `%s' +Expected initialization file: `%s'\" + (abbreviate-file-name user-init-file) + (abbreviate-file-name this-init-file))") + (let ((indent-tabs-mode nil) + (correct (buffer-string))) + (emacs-lisp-mode) + (indent-region (point-min) (point-max)) + (should (equal (buffer-string) correct))))) + (provide 'lisp-mode-tests) ;;; lisp-mode-tests.el ends here -- cgit v1.2.3 From 65b323e14e09fa6024fee93fd484deea4b7f51a2 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 19 Jun 2017 14:39:25 -0400 Subject: Don't put deleted packages in the trash (bug#14967) * lisp/emacs-lisp/package.el (package-delete): Don't pay attention to delete-by-moving-to-trash. ; * etc/NEWS: Mention this. --- etc/NEWS | 3 +++ lisp/emacs-lisp/package.el | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 85d12733670..78d374840aa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -755,6 +755,9 @@ header's value. where the GnuPG home directory (used for signature verification) is located and whether GnuPG's option "--homedir" is used or not. +--- +*** Deleting a package no longer respects 'delete-by-moving-to-trash'. + ** Tramp +++ diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bebfd18d7a6..4245294457f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2127,7 +2127,7 @@ If NOSAVE is non-nil, the package is not removed from (package-desc-name pkg-used-elsewhere-by))) (t (add-hook 'post-command-hook #'package-menu--post-refresh) - (delete-directory dir t t) + (delete-directory dir t) ;; Remove NAME-VERSION.signed and NAME-readme.txt files. (dolist (suffix '(".signed" "readme.txt")) (let* ((version (package-version-join (package-desc-version pkg-desc))) -- cgit v1.2.3 From c75eb1030fbb606765cc8a5e5ecbab4a9cf435ed Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Fri, 16 Jun 2017 07:43:29 -0400 Subject: Don't change byte-compile-delete-errors at runtime (Bug#27340) * lisp/emacs-lisp/eieio-core.el: Confine `cl-declaim' calls to compile time. --- lisp/emacs-lisp/eieio-core.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index dfe1c06bfaf..9d618e1dc81 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -84,7 +84,7 @@ Currently under control of this var: (progn ;; Arrange for field access not to bother checking if the access is indeed ;; made to an eieio--class object. - (cl-declaim (optimize (safety 0))) + (eval-when-compile (cl-declaim (optimize (safety 0)))) (cl-defstruct (eieio--class (:constructor nil) @@ -103,8 +103,12 @@ Currently under control of this var: options ;; storage location of tagged class option ; Stored outright without modifications or stripping ) - ;; Set it back to the default value. - (cl-declaim (optimize (safety 1)))) + ;; Set it back to the default value. NOTE: Using the default + ;; `safety' value does NOT give the default + ;; `byte-compile-delete-errors' value. Therefore limit this (and + ;; the above `cl-declaim') to compile time so that we don't affect + ;; code which only loads this library. + (eval-when-compile (cl-declaim (optimize (safety 1))))) (eval-and-compile -- cgit v1.2.3 From 431471376440a69a2f5ca2a49e3c7e09c834c132 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 24 Jun 2017 17:54:21 -0700 Subject: Adjust lm-verify to accept current notices Problem reported by Mike Kupfer in: http://lists.gnu.org/archive/html/emacs-devel/2017-06/msg00512.html * lisp/emacs-lisp/lisp-mnt.el (lm-crack-copyright): Do not require later lines in a copyright notice to have more indentation than earlier lines. --- lisp/emacs-lisp/lisp-mnt.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index fc3caf3359a..a1c5b6977f8 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -326,12 +326,13 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")" (start (point)) (end (line-end-position))) ;; Cope with multi-line copyright `lines'. Assume the second - ;; line is indented (with the same commenting style). + ;; line is indented at least as much as the original, with the + ;; same commenting style. (save-excursion (beginning-of-line 2) - (let ((str (concat (match-string-no-properties 1) "[ \t]+"))) + (let ((str (match-string-no-properties 1))) (beginning-of-line) - (while (looking-at str) + (while (and (looking-at str) (not (looking-at lm-copyright-prefix))) (setq end (line-end-position)) (beginning-of-line 2)))) ;; Make a single line and parse that. -- cgit v1.2.3 From 522e3c15853279bf2a0ed1759c5b0ba3c9e0b7be Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 09:19:00 -0500 Subject: Operate on frame list instead of printed backtrace * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): New function, prints the given backtrace frames. (debugger-setup-buffer): Use it instead of editing the backtrace buffer text. --- lisp/emacs-lisp/debug.el | 90 +++++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 39 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 83456fc31a2..62e413bd8d0 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -264,6 +264,40 @@ first will be printed into the backtrace buffer." (setq debug-on-next-call debugger-step-after-exit) debugger-value))) + +(defun debugger-insert-backtrace (frames do-xrefs) + "Format and insert the backtrace FRAMES at point. +Make functions into cross-reference buttons if DO-XREFS is non-nil." + (let ((standard-output (current-buffer)) + (eval-buffers eval-buffer-list)) + (require 'help-mode) ; Define `help-function-def' button type. + (pcase-dolist (`(,evald ,fun ,args ,flags) frames) + (insert (if (plist-get flags :debug-on-exit) + "* " " ")) + (let ((fun-file (and do-xrefs (symbol-file fun 'defun))) + (fun-pt (point))) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (prin1 fun) + (if args (prin1 args) (princ "()"))) + (t + (prin1 (cons fun args)) + (cl-incf fun-pt))) + (when fun-file + (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) + :type 'help-function-def + 'help-args (list fun fun-file)))) + ;; After any frame that uses eval-buffer, insert a line that + ;; states the buffer position it's reading at. + (when (and eval-buffers (memq fun '(eval-buffer eval-region))) + (insert (format " ; Reading at buffer position %d" + ;; This will get the wrong result if there are + ;; two nested eval-region calls for the same + ;; buffer. That's not a very useful case. + (with-current-buffer (pop eval-buffers) + (point))))) + (insert "\n")))) + (defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. That buffer should be current already." @@ -271,27 +305,20 @@ That buffer should be current already." (erase-buffer) (set-buffer-multibyte t) ;Why was it nil ? -stef (setq buffer-undo-list t) - (let ((standard-output (current-buffer)) - (print-escape-newlines t) - (print-level 8) - (print-length 50)) - ;; FIXME the debugger could pass a custom callback to mapbacktrace - ;; instead of manipulating printed results. - (mapbacktrace #'backtrace--print-frame 'debug)) - (goto-char (point-min)) - (delete-region (point) - (progn - (forward-line (if (eq (car args) 'debug) - ;; Remove debug--implement-debug-on-entry - ;; and the advice's `apply' frame. - 3 - 1)) - (point))) (insert "Debugger entered") - ;; lambda is for debug-on-call when a function call is next. - ;; debug is for debug-on-entry function called. - (let ((pos (point))) + (let ((frames (nthcdr + ;; Remove debug--implement-debug-on-entry and the + ;; advice's `apply' frame. + (if (eq (car args) 'debug) 3 1) + (backtrace-frames 'debug))) + (print-escape-newlines t) + (print-escape-control-characters t) + (print-level 8) + (print-length 50) + (pos (point))) (pcase (car args) + ;; lambda is for debug-on-call when a function call is next. + ;; debug is for debug-on-entry function called. ((or `lambda `debug) (insert "--entering a function:\n") (setq pos (1- (point)))) @@ -301,10 +328,8 @@ That buffer should be current already." (setq pos (point)) (setq debugger-value (nth 1 args)) (prin1 debugger-value (current-buffer)) - (insert ?\n) - (delete-char 1) - (insert ? ) - (beginning-of-line)) + (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) + (insert ?\n)) ;; Watchpoint triggered. ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) (insert @@ -341,23 +366,10 @@ That buffer should be current already." (cdr args) args) (current-buffer)) (insert ?\n))) + (debugger-insert-backtrace frames t) ;; Place point on "stack frame 0" (bug#15101). - (goto-char pos)) - ;; After any frame that uses eval-buffer, - ;; insert a line that states the buffer position it's reading at. - (save-excursion - (let ((tem eval-buffer-list)) - (while (and tem - (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t)) - (end-of-line) - (insert (format " ; Reading at buffer position %d" - ;; This will get the wrong result - ;; if there are two nested eval-region calls - ;; for the same buffer. That's not a very useful case. - (with-current-buffer (car tem) - (point)))) - (pop tem)))) - (debugger-make-xrefs)) + (goto-char pos))) + (defun debugger-make-xrefs (&optional buffer) "Attach cross-references to function names in the `*Backtrace*' buffer." -- cgit v1.2.3 From ead545824e511ab18d18b5223eab80e1f4fe3d64 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 11 Feb 2017 17:19:41 -0500 Subject: Improve ert backtrace recording Change ert to use the new `backtrace-frames' function instead of collecting frames one by one with `backtrace-frame'. Additionally, collect frames starting from `signal' instead the somewhat arbitrary "6 from the bottom". Skipping 6 frames would skip the expression that actually caused the signal that triggered the debugger. Possibly 6 was chosen because in the case of a failed test, the triggering frame is an `ert-fail' call, which is not so interesting. But in case of a test throwing an error, this drops the `error' call which is too much. * lisp/emacs-lisp/debug.el (debugger-make-xrefs): Remove. * lisp/emacs-lisp/ert.el (ert--make-xrefs-region): Bring in relevant code from `debugger-make-xrefs'. (ert--print-backtrace): Add DO-XREFS parameter, delegate to `debugger-insert-backtrace'. (ert--run-test-debugger): Record the backtrace frames starting from the instigating `signal' call. (ert-run-tests-batch): Pass nil for `ert--print-backtrace's new DO-XREFS parameter. (ert-results-pop-to-backtrace-for-test-at-point): Pass t as DO-XREFS to `ert--print-backtrace' and remove call to `debugger-make-xrefs'. * test/lisp/emacs-lisp/ert-tests.el (ert-test-record-backtrace): Check the backtrace list instead of comparing its string representation. Expect `signal' to be the first frame. --- lisp/emacs-lisp/debug.el | 71 -------------------------------- lisp/emacs-lisp/ert.el | 85 +++++++++++++++++---------------------- test/lisp/emacs-lisp/ert-tests.el | 8 +--- 3 files changed, 38 insertions(+), 126 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 62e413bd8d0..7db0f91b746 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -370,77 +370,6 @@ That buffer should be current already." ;; Place point on "stack frame 0" (bug#15101). (goto-char pos))) - -(defun debugger-make-xrefs (&optional buffer) - "Attach cross-references to function names in the `*Backtrace*' buffer." - (interactive "b") - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (setq buffer (current-buffer)) - (let ((inhibit-read-only t) - (old-end (point-min)) (new-end (point-min))) - ;; If we saved an old backtrace, find the common part - ;; between the new and the old. - ;; Compare line by line, starting from the end, - ;; because that's the part that is likely to be unchanged. - (if debugger-previous-backtrace - (let (old-start new-start (all-match t)) - (goto-char (point-max)) - (with-temp-buffer - (insert debugger-previous-backtrace) - (while (and all-match (not (bobp))) - (setq old-end (point)) - (forward-line -1) - (setq old-start (point)) - (with-current-buffer buffer - (setq new-end (point)) - (forward-line -1) - (setq new-start (point))) - (if (not (zerop - (let ((case-fold-search nil)) - (compare-buffer-substrings - (current-buffer) old-start old-end - buffer new-start new-end)))) - (setq all-match nil)))) - ;; Now new-end is the position of the start of the - ;; unchanged part in the current buffer, and old-end is - ;; the position of that same text in the saved old - ;; backtrace. But we must subtract (point-min) since strings are - ;; indexed in origin 0. - - ;; Replace the unchanged part of the backtrace - ;; with the text from debugger-previous-backtrace, - ;; since that already has the proper xrefs. - ;; With this optimization, we only need to scan - ;; the changed part of the backtrace. - (delete-region new-end (point-max)) - (goto-char (point-max)) - (insert (substring debugger-previous-backtrace - (- old-end (point-min)))) - ;; Make the unchanged part of the backtrace inaccessible - ;; so it won't be scanned. - (narrow-to-region (point-min) new-end))) - - ;; Scan the new part of the backtrace, inserting xrefs. - (goto-char (point-min)) - (while (progn - (goto-char (+ (point) 2)) - (skip-syntax-forward "^w_") - (not (eobp))) - (let* ((beg (point)) - (end (progn (skip-syntax-forward "w_") (point))) - (sym (intern-soft (buffer-substring-no-properties - beg end))) - (file (and sym (symbol-file sym 'defun)))) - (when file - (goto-char beg) - ;; help-xref-button needs to operate on something matched - ;; by a regexp, so set that up for it. - (re-search-forward "\\(\\sw\\|\\s_\\)+") - (help-xref-button 0 'help-function-def sym file))) - (forward-line 1)) - (widen)) - (setq debugger-previous-backtrace (buffer-string))))) (defun debugger-step-through () "Proceed, stepping through subexpressions of this expression. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 2c49a634e35..7edc40188e1 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -670,48 +670,12 @@ and is displayed in front of the value of MESSAGE-FORM." (cl-defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) - -(defun ert--record-backtrace () - "Record the current backtrace (as a list) and return it." - ;; Since the backtrace is stored in the result object, result - ;; objects must only be printed with appropriate limits - ;; (`print-level' and `print-length') in place. For interactive - ;; use, the cost of ensuring this possibly outweighs the advantage - ;; of storing the backtrace for - ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we - ;; already have `ert-results-rerun-test-debugging-errors-at-point'. - ;; For batch use, however, printing the backtrace may be useful. - (cl-loop - ;; 6 is the number of frames our own debugger adds (when - ;; compiled; more when interpreted). FIXME: Need to describe a - ;; procedure for determining this constant. - for i from 6 - for frame = (backtrace-frame i) - while frame - collect frame)) - -(defun ert--print-backtrace (backtrace) +(defun ert--print-backtrace (backtrace do-xrefs) "Format the backtrace BACKTRACE to the current buffer." - ;; This is essentially a reimplementation of Fbacktrace - ;; (src/eval.c), but for a saved backtrace, not the current one. (let ((print-escape-newlines t) (print-level 8) (print-length 50)) - (dolist (frame backtrace) - (pcase-exhaustive frame - (`(nil ,special-operator . ,arg-forms) - ;; Special operator. - (insert - (format " %S\n" (cons special-operator arg-forms)))) - (`(t ,fn . ,args) - ;; Function call. - (insert (format " %S(" fn)) - (cl-loop for firstp = t then nil - for arg in args do - (unless firstp - (insert " ")) - (insert (format "%S" arg))) - (insert ")\n")))))) + (debugger-insert-backtrace backtrace do-xrefs))) ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. @@ -750,7 +714,19 @@ run. ARGS are the arguments to `debugger'." ((quit) 'quit) ((ert-test-skipped) 'skipped) (otherwise 'failed))) - (backtrace (ert--record-backtrace)) + ;; We store the backtrace in the result object for + ;; `ert-results-pop-to-backtrace-for-test-at-point'. + ;; This means we have to limit `print-level' and + ;; `print-length' when printing result objects. That + ;; might not be worth while when we can also use + ;; `ert-results-rerun-test-debugging-errors-at-point', + ;; (i.e., when running interactively) but having the + ;; backtrace ready for printing is important for batch + ;; use. + ;; + ;; Grab the frames starting from `signal', frames below + ;; that are all from the debugger. + (backtrace (backtrace-frames 'signal)) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) (cl-ecase type @@ -1409,8 +1385,9 @@ Returns the stats object." (ert-test-result-with-condition (message "Test %S backtrace:" (ert-test-name test)) (with-temp-buffer - (ert--print-backtrace (ert-test-result-with-condition-backtrace - result)) + (ert--print-backtrace + (ert-test-result-with-condition-backtrace result) + nil) (goto-char (point-min)) (while (not (eobp)) (let ((start (point)) @@ -1828,12 +1805,23 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'." BEGIN and END specify a region in the current buffer." (save-excursion - (save-restriction - (narrow-to-region begin end) - ;; Inhibit optimization in `debugger-make-xrefs' that would - ;; sometimes insert unrelated backtrace info into our buffer. - (let ((debugger-previous-backtrace nil)) - (debugger-make-xrefs))))) + (goto-char begin) + (while (progn + (goto-char (+ (point) 2)) + (skip-syntax-forward "^w_") + (< (point) end)) + (let* ((beg (point)) + (end (progn (skip-syntax-forward "w_") (point))) + (sym (intern-soft (buffer-substring-no-properties + beg end))) + (file (and sym (symbol-file sym 'defun)))) + (when file + (goto-char beg) + ;; help-xref-button needs to operate on something matched + ;; by a regexp, so set that up for it. + (re-search-forward "\\(\\sw\\|\\s_\\)+") + (help-xref-button 0 'help-function-def sym file))) + (forward-line 1)))) (defun ert--string-first-line (s) "Return the first line of S, or S if it contains no newlines. @@ -2420,8 +2408,7 @@ To be used in the ERT results buffer." ;; Use unibyte because `debugger-setup-buffer' also does so. (set-buffer-multibyte nil) (setq truncate-lines t) - (ert--print-backtrace backtrace) - (debugger-make-xrefs) + (ert--print-backtrace backtrace t) (goto-char (point-min)) (insert (substitute-command-keys "Backtrace for test `")) (ert-insert-test-name-button (ert-test-name test)) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index fc5790c3659..317838b250f 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -367,12 +367,8 @@ This macro is used to test if macroexpansion in `should' works." (test (make-ert-test :body test-body)) (result (ert-run-test test))) (should (ert-test-failed-p result)) - (with-temp-buffer - (ert--print-backtrace (ert-test-failed-backtrace result)) - (goto-char (point-min)) - (end-of-line) - (let ((first-line (buffer-substring-no-properties (point-min) (point)))) - (should (equal first-line (format " %S()" test-body))))))) + (should (eq (nth 1 (car (ert-test-failed-backtrace result))) + 'signal)))) (ert-deftest ert-test-messages () :tags '(:causes-redisplay) -- cgit v1.2.3 From b567c48869b1484c6b1d263afc5cb67f22e99125 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 27 May 2017 22:40:46 -0400 Subject: Don't redundantly cl-print arglist in function docstring again * lisp/emacs-lisp/cl-print.el (cl-print-object): Don't print arglist part of docstring. * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-1): Update test accordingly. --- lisp/emacs-lisp/cl-print.el | 9 +++++---- test/lisp/emacs-lisp/cl-print-tests.el | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 89a71d1b6c5..824d0b7b4f5 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -105,10 +105,11 @@ into a button whose action shows the function's disassembly.") (if args (prin1 args stream) (princ "()" stream))) - (let ((doc (documentation object 'raw))) - (when doc - (princ " " stream) - (prin1 doc stream))) + (pcase (help-split-fundoc (documentation object 'raw) object) + ;; Drop args which `help-function-arglist' already printed. + (`(,_usage . ,(and doc (guard (stringp doc)))) + (princ " " stream) + (prin1 doc stream))) (let ((inter (interactive-form object))) (when inter (princ " " stream) diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index dfbe18d7844..6448a1b37f7 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -34,7 +34,7 @@ (let ((print-circle t)) (should (equal (cl-prin1-to-string `((x . ,x) (y . ,x))) "((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))"))) - (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'" + (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'" (cl-prin1-to-string (symbol-function #'caar)))))) (ert-deftest cl-print-tests-2 () -- cgit v1.2.3 From 0ae28c71c739dfecbe94a5ff6786e81021d2d1cf Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 28 Jun 2017 07:23:47 -0400 Subject: Hide byte code in backtraces (Bug#6991) * lisp/emacs-lisp/debug.el (debugger-print-function): New defcustom, defaulting to `cl-print'. (debugger-insert-backtrace, debugger-setup-buffer): Use it instead of `prin1'. * etc/NEWS: Announce it. --- etc/NEWS | 5 +++++ lisp/emacs-lisp/debug.el | 26 ++++++++++++++++++-------- 2 files changed, 23 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/etc/NEWS b/etc/NEWS index 5e10ca9cb62..319b40f5d1a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -320,6 +320,11 @@ questions, with a handy way to display help texts. all call stack frames in a Lisp backtrace buffer as lists. Both debug.el and edebug.el have been updated to heed to this variable. +--- +** Values in call stack frames are now displayed using 'cl-prin1'. +The old behaviour of using 'prin1' can be restored by customizing the +new option 'debugger-print-function'. + +++ ** The new variable 'x-ctrl-keysym' has been added to the existing roster of X keysyms. It can be used in combination with another diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 7db0f91b746..726005af9b1 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -49,6 +49,12 @@ the middle is discarded, and just the beginning and end are displayed." :group 'debugger :version "21.1") +(defcustom debugger-print-function #'cl-prin1 + "Function used to print values in the debugger backtraces." + :type 'function + :options '(cl-prin1 prin1) + :version "26.1") + (defcustom debugger-bury-or-kill 'bury "What to do with the debugger buffer when exiting `debug'. The value affects the behavior of operations on any window @@ -265,10 +271,13 @@ first will be printed into the backtrace buffer." debugger-value))) +(defvar cl-print-compiled-button) + (defun debugger-insert-backtrace (frames do-xrefs) "Format and insert the backtrace FRAMES at point. Make functions into cross-reference buttons if DO-XREFS is non-nil." (let ((standard-output (current-buffer)) + (cl-print-compiled-button t) (eval-buffers eval-buffer-list)) (require 'help-mode) ; Define `help-function-def' button type. (pcase-dolist (`(,evald ,fun ,args ,flags) frames) @@ -278,10 +287,10 @@ Make functions into cross-reference buttons if DO-XREFS is non-nil." (fun-pt (point))) (cond ((and evald (not debugger-stack-frame-as-list)) - (prin1 fun) - (if args (prin1 args) (princ "()"))) + (funcall debugger-print-function fun) + (if args (funcall debugger-print-function args) (princ "()"))) (t - (prin1 (cons fun args)) + (funcall debugger-print-function (cons fun args)) (cl-incf fun-pt))) (when fun-file (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) @@ -327,7 +336,7 @@ That buffer should be current already." (insert "--returning value: ") (setq pos (point)) (setq debugger-value (nth 1 args)) - (prin1 debugger-value (current-buffer)) + (funcall debugger-print-function debugger-value (current-buffer)) (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) (insert ?\n)) ;; Watchpoint triggered. @@ -352,7 +361,7 @@ That buffer should be current already." (`error (insert "--Lisp error: ") (setq pos (point)) - (prin1 (nth 1 args) (current-buffer)) + (funcall debugger-print-function (nth 1 args) (current-buffer)) (insert ?\n)) ;; debug-on-call, when the next thing is an eval. (`t @@ -362,9 +371,10 @@ That buffer should be current already." (_ (insert ": ") (setq pos (point)) - (prin1 (if (eq (car args) 'nil) - (cdr args) args) - (current-buffer)) + (funcall debugger-print-function + (if (eq (car args) 'nil) + (cdr args) args) + (current-buffer)) (insert ?\n))) (debugger-insert-backtrace frames t) ;; Place point on "stack frame 0" (bug#15101). -- cgit v1.2.3 From 7618d29db36396fbd736672cadaca641186c1dc5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 30 Jun 2017 18:01:01 -0400 Subject: * lisp/emacs-lisp/debug.el (debugger-list-functions): Remove obsolete msg --- lisp/emacs-lisp/debug.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 726005af9b1..b836e823c73 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -817,9 +817,13 @@ To specify a nil argument interactively, exit with an empty minibuffer." 'type 'help-function 'help-args (list fun)) (terpri)) - (terpri) - (princ "Note: if you have redefined a function, then it may no longer\n") - (princ "be set to debug on entry, even if it is in the list.")))))) + ;; Now that debug--function-list uses advice-member-p, its + ;; output should be reliable (except for bugs and the exceptional + ;; case where some other advice ends up overriding ours). + ;;(terpri) + ;;(princ "Note: if you have redefined a function, then it may no longer\n") + ;;(princ "be set to debug on entry, even if it is in the list.") + ))))) (defun debug--implement-debug-watch (symbol newval op where) "Conditionally call the debugger. -- cgit v1.2.3 From 6fb45b7b368c8041936c52f2b2c261136c070721 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 30 Jun 2017 22:01:38 -0400 Subject: * lisp/emacs-lisp/cl-extra.el (cl--random-state): New defstruct (cl--random-state, cl--random-time): Move from cl-lib.el. (cl-random): Use struct accessors. (cl-random-state-p): Remove, provided by the defstruct. (cl-make-random-state): Rewrite to struct constructor. --- lisp/emacs-lisp/cl-extra.el | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 3852ceb6c31..99df209d1a2 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -437,22 +437,38 @@ as an integer unless JUNK-ALLOWED is non-nil." ;; Random numbers. +(defun cl--random-time () + (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) + (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) + v)) + +;;;###autoload (autoload 'cl-random-state-p "cl-extra") +(cl-defstruct (cl--random-state + (:copier nil) + (:predicate cl-random-state-p) + (:constructor nil) + (:constructor cl--make-random-state (vec))) + (i -1) (j 30) vec) + +(defvar cl--random-state (cl--make-random-state (cl--random-time))) + ;;;###autoload (defun cl-random (lim &optional state) "Return a random nonnegative number less than LIM, an integer or float. Optional second arg STATE is a random-state object." (or state (setq state cl--random-state)) ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. - (let ((vec (aref state 3))) + (let ((vec (cl--random-state-vec state))) (if (integerp vec) (let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1)) - (aset state 3 (setq vec (make-vector 55 nil))) + (setf (cl--random-state-vec state) + (setq vec (make-vector 55 nil))) (aset vec 0 j) (while (> (setq i (% (+ i 21) 55)) 0) (aset vec i (setq j (prog1 k (setq k (- j k)))))) (while (< (setq i (1+ i)) 200) (cl-random 2 state)))) - (let* ((i (aset state 1 (% (1+ (aref state 1)) 55))) - (j (aset state 2 (% (1+ (aref state 2)) 55))) + (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state))) + (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state))) (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) (if (integerp lim) (if (<= lim 512) (% n lim) @@ -466,17 +482,10 @@ Optional second arg STATE is a random-state object." (defun cl-make-random-state (&optional state) "Return a copy of random-state STATE, or of the internal state if omitted. If STATE is t, return a new state object seeded from the time of day." - (cond ((null state) (cl-make-random-state cl--random-state)) - ((vectorp state) (copy-tree state t)) - ((integerp state) (vector 'cl--random-state-tag -1 30 state)) - (t (cl-make-random-state (cl--random-time))))) - -;;;###autoload -(defun cl-random-state-p (object) - "Return t if OBJECT is a random-state object." - (and (vectorp object) (= (length object) 4) - (eq (aref object 0) 'cl--random-state-tag))) - + (unless state (setq state cl--random-state)) + (if (cl-random-state-p state) + (copy-tree state t) + (cl--make-random-state (if (integerp state) state (cl--random-time))))) ;; Implementation limits. -- cgit v1.2.3 From 9a2a7bb6e6e08c2107a94c9a2e90e316a6f91d48 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 1 Jul 2017 22:37:12 -0400 Subject: Let test summary go through even if some logs were not generated * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): Check for existence of log files before reading. --- lisp/emacs-lisp/ert.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7edc40188e1..eb2b2e3e11b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1468,7 +1468,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." (with-temp-buffer (while (setq logfile (pop command-line-args-left)) (erase-buffer) - (insert-file-contents logfile) + (when (file-readable-p logfile) (insert-file-contents logfile)) (if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t)) (push logfile notests) (setq ntests (+ ntests (string-to-number (match-string 1)))) -- cgit v1.2.3 From 9a65b5779629d4f0f88d568ff164629e82db5ba8 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sat, 1 Jul 2017 20:54:41 -0400 Subject: * lisp/emacs-lisp/cl-print.el (cl-print-compiled-button): t by default. * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): * lisp/help-fns.el (describe-variable): No need to let-bind `cl-print-compiled-button' to t anymore. --- lisp/emacs-lisp/cl-print.el | 2 +- lisp/emacs-lisp/debug.el | 3 --- lisp/help-fns.el | 5 +---- 3 files changed, 2 insertions(+), 8 deletions(-) (limited to 'lisp/emacs-lisp') diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 824d0b7b4f5..e9ca0412848 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -90,7 +90,7 @@ call other entry points instead, such as `cl-prin1'." - `disassemble' to print the disassembly of the code. - nil to skip printing any details about the code.") -(defvar cl-print-compiled-button nil +(defvar cl-print-compiled-button t "Control how to print byte-compiled functions into buffers. When the stream is a buffer, make the bytecode part of the output into a button whose action shows the function's disassembly.") diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index b836e823c73..2b8782590c4 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -271,13 +271,10 @@ first will be printed into the backtrace buffer." debugger-value))) -(defvar cl-print-compiled-button) - (defun debugger-insert-backtrace (frames do-xrefs) "Format and insert the backtrace FRAMES at point. Make functions into cross-reference buttons if DO-XREFS is non-nil." (let ((standard-output (current-buffer)) - (cl-print-compiled-button t) (eval-buffers eval-buffer-list)) (require 'help-mode) ; Define `help-function-def' button type. (pcase-dolist (`(,evald ,fun ,args ,flags) frames) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d7c31f9e2b8..32324ae3bcb 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -776,8 +776,6 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound." version package)))))) output)) -(defvar cl-print-compiled-button) - ;;;###autoload (defun describe-variable (variable &optional buffer frame) "Display the full documentation of VARIABLE (a symbol). @@ -858,8 +856,7 @@ it is displayed along with the global value." (print-rep (let ((rep (let ((print-quoted t) - (print-circle t) - (cl-print-compiled-button t)) + (print-circle t)) (cl-prin1-to-string val)))) (if (and (symbolp val) (not (booleanp val))) (format-message "`%s'" rep) -- cgit v1.2.3