commit 50c117fe86d94719807cbe08353c032779b3b910 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Wed Mar 18 23:02:26 2015 -0400 EIEIO: Change class's representation to unify instance & class slots * lisp/emacs-lisp/eieio-core.el (eieio--class): Change field names and order to match those of cl--class; use cl--slot for both instance slots and class slots. (eieio--object-num-slots): Use cl-struct-slot-info. (eieio--object-class): Rename from eieio--object-class-object. (eieio--object-class-name): Remove. (eieio-defclass-internal): Adjust to new slot representation. Store doc in class rather than in `variable-documentation'. (eieio--perform-slot-validation-for-default): Change API to take a slot object. (eieio--slot-override): New function. (eieio--add-new-slot): Rewrite. (eieio-copy-parents-into-subclass): Rewrite. (eieio--validate-slot-value, eieio--validate-class-slot-value) (eieio-oref-default, eieio-oset-default) (eieio--class-slot-name-index, eieio-set-defaults): Adjust to new slot representation. (eieio--c3-merge-lists): Simplify. (eieio--class/struct-parents): New function. (eieio--class-precedence-bfs): Use it. * lisp/emacs-lisp/eieio.el (with-slots): Use macroexp-let2. (object-class-fast): Change recommend replacement. (eieio-object-class): Rewrite. (slot-exists-p): Adjust to new slot representation. (initialize-instance): Adjust to new slot representation. (object-write): Adjust to new slot representation. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object): Manually map initargs to slot names. (eieio-persistent-validate/fix-slot-value): Adjust to new slot representation. * lisp/emacs-lisp/eieio-compat.el (eieio--generic-static-symbol-specializers): Extract from eieio--generic-static-symbol-generalizer. (eieio--generic-static-symbol-generalizer): Use it. * lisp/emacs-lisp/eieio-custom.el (eieio-object-value-create) (eieio-object-value-get): Adjust to new slot representation. * lisp/emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots): Declare to silence warnings. (data-debug-insert-object-button): Avoid `object-slots'. (data-debug/eieio-insert-slots): Adjust to new slot representation. * lisp/emacs-lisp/eieio-opt.el (eieio--help-print-slot): New function extracted from eieio-help-class-slots. (eieio-help-class-slots): Use it. Adjust to new slot representation. * test/automated/eieio-test-methodinvoke.el (make-instance): Use new-style `subclass' specializer for a change. * test/automated/eieio-test-persist.el (persist-test-save-and-compare): Adjust to new slot representation. * test/automated/eieio-tests.el (eieio-test-17-virtual-slot): Don't use initarg in `oset'. (eieio-test-32-slot-attribute-override-2): Adjust to new slot representation. * lisp/emacs-lisp/cl-preloaded.el (cl--class): Fix type of `parents'. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e75f81b..7c751f4 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,57 @@ +2015-03-19 Stefan Monnier + + * emacs-lisp/eieio.el (with-slots): Use macroexp-let2. + (object-class-fast): Change recommend replacement. + (eieio-object-class): Rewrite. + (slot-exists-p): Adjust to new slot representation. + (initialize-instance): Adjust to new slot representation. + (object-write): Adjust to new slot representation. + + * emacs-lisp/eieio-opt.el (eieio--help-print-slot): New function + extracted from eieio-help-class-slots. + (eieio-help-class-slots): Use it. Adjust to new slot representation. + + * emacs-lisp/eieio-datadebug.el (data-debug/eieio-insert-slots): + Declare to silence warnings. + (data-debug-insert-object-button): Avoid `object-slots'. + (data-debug/eieio-insert-slots): Adjust to new slot representation. + + * emacs-lisp/eieio-custom.el (eieio-object-value-create) + (eieio-object-value-get): Adjust to new slot representation. + + EIEIO: Change class's representation to unify instance and class slots + * emacs-lisp/eieio-core.el (eieio--class): Change field names and order + to match those of cl--class; use cl--slot for both instance slots and + class slots. + (eieio--object-num-slots): Use cl-struct-slot-info. + (eieio--object-class): Rename from eieio--object-class-object. + (eieio--object-class-name): Remove. + (eieio-defclass-internal): Adjust to new slot representation. + Store doc in class rather than in `variable-documentation'. + (eieio--perform-slot-validation-for-default): Change API to take + a slot object. + (eieio--slot-override): New function. + (eieio--add-new-slot): Rewrite. + (eieio-copy-parents-into-subclass): Rewrite. + (eieio--validate-slot-value, eieio--validate-class-slot-value) + (eieio-oref-default, eieio-oset-default) + (eieio--class-slot-name-index, eieio-set-defaults): Adjust to new + slot representation. + (eieio--c3-merge-lists): Simplify. + (eieio--class/struct-parents): New function. + (eieio--class-precedence-bfs): Use it. + + * emacs-lisp/eieio-compat.el (eieio--generic-static-symbol-specializers): + Extract from eieio--generic-static-symbol-generalizer. + (eieio--generic-static-symbol-generalizer): Use it. + + * emacs-lisp/eieio-base.el (eieio-persistent-convert-list-to-object): + Manually map initargs to slot names. + (eieio-persistent-validate/fix-slot-value): Adjust to new + slot representation. + + * emacs-lisp/cl-preloaded.el (cl--class): Fix type of `parents'. + 2015-03-19 Vibhav Pant * lisp/leim/quail/hangul.el diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index a18e0e5..ed0639b 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -212,7 +212,9 @@ ;; Intended to be shared between defstruct and defclass. (name nil :type symbol) ;The type name. (docstring nil :type string) - (parents nil :type (or cl--class (list-of cl--class))) + ;; For structs there can only be one parent, but when EIEIO classes inherit + ;; from cl--class, we'll need this to hold a list. + (parents nil :type (list-of cl--class)) (slots nil :type (vector cl-slot-descriptor)) (index-table nil :type hash-table)) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 1cc9f89..5b3d902 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -254,25 +254,28 @@ malicious code. Note: This function recurses when a slot of :type of some object is identified, and needing more object creation." - (let ((objclass (nth 0 inputlist)) - ;; (objname (nth 1 inputlist)) - (slots (nthcdr 2 inputlist)) - (createslots nil)) - - ;; If OBJCLASS is an eieio autoload object, then we need to load it. - (eieio-class-un-autoload objclass) + (let* ((objclass (nth 0 inputlist)) + ;; (objname (nth 1 inputlist)) + (slots (nthcdr 2 inputlist)) + (createslots nil) + (class + (progn + ;; If OBJCLASS is an eieio autoload object, then we need to + ;; load it. + (eieio-class-un-autoload objclass) + (eieio--class-object objclass)))) (while slots - (let ((name (car slots)) + (let ((initarg (car slots)) (value (car (cdr slots)))) ;; Make sure that the value proposed for SLOT is valid. ;; In addition, strip out quotes, list functions, and update ;; object constructors as needed. (setq value (eieio-persistent-validate/fix-slot-value - (eieio--class-v objclass) name value)) + class (eieio--initarg-to-attribute class initarg) value)) - (push name createslots) + (push initarg createslots) (push value createslots) ) @@ -290,16 +293,11 @@ constructor functions are considered valid. 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)) - (type nil) - (classtype nil)) - (setq slot-idx (- slot-idx + (let* ((slot-idx (- (eieio--slot-name-index class slot) (eval-when-compile eieio--object-num-slots))) - (setq type (aref (eieio--class-public-type class) - slot-idx)) - - (setq classtype (eieio-persistent-slot-type-is-class-p - type)) + (type (cl--slot-descriptor-type (aref (eieio--class-slots class) + slot-idx))) + (classtype (eieio-persistent-slot-type-is-class-p type))) (cond ((eq (car proposed-value) 'quote) (car (cdr proposed-value))) diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index ee8e731..0283704 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -124,19 +124,22 @@ Summary: (defgeneric ,method ,args) (eieio--defmethod ',method ',key ',class #',code)))) +(defun eieio--generic-static-symbol-specializers (tag) + (cl-assert (or (null tag) (eieio--class-p tag))) + (when (eieio--class-p tag) + (let ((superclasses (eieio--generic-subclass-specializers tag)) + (specializers ())) + (dolist (superclass superclasses) + (push superclass specializers) + (push `(eieio--static ,(cadr superclass)) specializers)) + (nreverse specializers)))) + (defconst eieio--generic-static-symbol-generalizer (cl-generic-make-generalizer ;; Give it a slightly higher priority than `subclass' so that the ;; interleaved list comes before subclass's non-interleaved list. 61 (lambda (name) `(and (symbolp ,name) (eieio--class-v ,name))) - (lambda (tag) - (when (eieio--class-p tag) - (let ((superclasses (eieio--generic-subclass-specializers tag)) - (specializers ())) - (dolist (superclass superclasses) - (push superclass specializers) - (push `(eieio--static ,(cadr superclass)) specializers)) - (nreverse specializers)))))) + #'eieio--generic-static-symbol-specializers)) (defconst eieio--generic-static-object-generalizer (cl-generic-make-generalizer ;; Give it a slightly higher priority than `class' so that the @@ -148,7 +151,7 @@ Summary: (let ((superclasses (eieio--class-precedence-list tag)) (specializers ())) (dolist (superclass superclasses) - (setq superclass (eieio--class-symbol superclass)) + (setq superclass (eieio--class-name superclass)) (push superclass specializers) (push `(eieio--static ,superclass) specializers)) (nreverse specializers)))))) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 1e226c1..6fd9c14 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -85,9 +85,10 @@ Currently under control of this var: ;; Arrange for field access not to bother checking if the access is indeed ;; made to an eieio--class object. (cl-declaim (optimize (safety 0))) + (cl-defstruct (eieio--class (:constructor nil) - (:constructor eieio--class-make (symbol &aux (tag 'defclass))) + (:constructor eieio--class-make (name &aux (tag 'defclass))) (:type vector) (:copier nil)) ;; We use an untagged cl-struct, with our own hand-made tag as first field @@ -96,30 +97,16 @@ Currently under control of this var: ;; predicate for us), but that breaks compatibility with .elc files compiled ;; against older versions of EIEIO. tag - symbol ;; symbol (self-referencing) - parent children - symbol-hashtable ;; hashtable permitting fast access to variable position indexes - ;; @todo - ;; the word "public" here is leftovers from the very first version. - ;; Get rid of it! - public-a ;; class attribute index - public-d ;; class attribute defaults index - public-doc ;; class documentation strings for attributes - public-type ;; class type for a slot - public-custom ;; class custom type for a slot - public-custom-label ;; class custom group for a slot - public-custom-group ;; class custom group for a slot - public-printer ;; printer for a slot - protection ;; protection for a slot + ;; Fields we could inherit from cl--class (if we used a tagged cl-struct): + (name nil :type symbol) ;The type name. + (docstring nil :type string) + (parents nil :type (or eieio--class (list-of eieio--class))) + (slots nil :type (vector cl-slot-descriptor)) + (index-table nil :type hash-table) + ;; Fields specific to EIEIO classes: + children initarg-tuples ;; initarg tuples list - class-allocation-a ;; class allocated attributes - class-allocation-doc ;; class allocated documentation - class-allocation-type ;; class allocated value type - class-allocation-custom ;; class allocated custom descriptor - class-allocation-custom-label ;; class allocated custom descriptor - class-allocation-custom-group ;; class allocated custom group - class-allocation-printer ;; class allocated printer for a slot - class-allocation-protection ;; class allocated protection list + (class-slots nil :type eieio--slot) class-allocation-values ;; class allocated value vector default-object-cache ;; what a newly created object would look like. ; This will speed up instantiation time as @@ -142,18 +129,13 @@ Currently under control of this var: ;; object/struct in its `symbol-value' slot. class-tag) -(eval-and-compile +(eval-when-compile (defconst eieio--object-num-slots - (length (get 'eieio--object 'cl-struct-slots)))) + (length (cl-struct-slot-info 'eieio--object)))) -(defsubst eieio--object-class-object (obj) +(defsubst eieio--object-class (obj) (symbol-value (eieio--object-class-tag obj))) -(defsubst eieio--object-class-name (obj) - ;; FIXME: Most uses of this function should be changed to use - ;; eieio--object-class-object instead! - (eieio--class-symbol (eieio--object-class-object obj))) - ;;; Important macros used internally in eieio. @@ -189,7 +171,7 @@ CLASS is a symbol." ;FIXME: Is it a vector or a symbol? "Return a Lisp like symbol name for CLASS." (setq class (eieio--class-object class)) (cl-check-type class eieio--class) - (eieio--class-symbol class)) + (eieio--class-name class)) (define-obsolete-function-alias 'class-name #'eieio-class-name "24.4") (defalias 'eieio--class-constructor #'identity @@ -354,10 +336,10 @@ See `defclass' for more information." (mapc (lambda (g) (cl-pushnew g groups :test #'equal)) (eieio--class-option c :custom-groups)) ;; Save parent in child. - (push c (eieio--class-parent newc)))))) + (push c (eieio--class-parents newc)))))) ;; Reverse the list of our parents so that they are prioritized in ;; the same order as specified in the code. - (cl-callf nreverse (eieio--class-parent newc))) + (cl-callf nreverse (eieio--class-parents newc))) ;; If there is nothing to loop over, then inherit from the ;; default superclass. (unless (eq cname 'eieio-default-superclass) @@ -366,7 +348,7 @@ See `defclass' for more information." ;; save new child in parent (cl-pushnew cname (eieio--class-children eieio-default-superclass)) ;; save parent in child - (setf (eieio--class-parent newc) (list eieio-default-superclass)))) + (setf (eieio--class-parents newc) (list eieio-default-superclass)))) ;; turn this into a usable self-pointing symbol; FIXME: Why? (when eieio-backward-compatibility @@ -442,62 +424,70 @@ See `defclass' for more information." (make-obsolete-variable initarg (format "use '%s instead" initarg) "25.1")))) - ;; The customgroup should be a list of symbols - (cond ((null customg) + ;; The customgroup should be a list of symbols. + (cond ((and (null customg) custom) (setq customg '(default))) ((not (listp customg)) (setq customg (list customg)))) - ;; The customgroup better be a symbol, or list of symbols. - (mapc (lambda (cg) - (if (not (symbolp cg)) - (signal 'invalid-slot-type (list :group cg)))) - customg) + ;; The customgroup better be a list of symbols. + (dolist (cg customg) + (unless (symbolp cg) + (signal 'invalid-slot-type (list :group cg)))) ;; First up, add this slot into our new class. - (eieio--add-new-slot newc name init docstr type custom label customg printer - prot initarg alloc 'defaultoverride skip-nil) + (eieio--add-new-slot + newc (cl--make-slot-descriptor + name init type + `(,@(if docstr `((:documentation . ,docstr))) + ,@(if custom `((:custom . ,custom))) + ,@(if label `((:label . ,label))) + ,@(if customg `((:group . ,customg))) + ,@(if printer `((:printer . ,printer))) + ,@(if prot `((:protection . ,prot))))) + initarg alloc 'defaultoverride skip-nil) ;; We need to id the group, and store them in a group list attribute. (dolist (cg customg) - (cl-pushnew cg groups :test 'equal)) + (cl-pushnew cg groups :test #'equal)) )) ;; Now that everything has been loaded up, all our lists are backwards! - ;; Fix that up now. - (cl-callf nreverse (eieio--class-public-a newc)) - (cl-callf nreverse (eieio--class-public-d newc)) - (cl-callf nreverse (eieio--class-public-doc newc)) - (cl-callf (lambda (types) (apply #'vector (nreverse types))) - (eieio--class-public-type newc)) - (cl-callf nreverse (eieio--class-public-custom newc)) - (cl-callf nreverse (eieio--class-public-custom-label newc)) - (cl-callf nreverse (eieio--class-public-custom-group newc)) - (cl-callf nreverse (eieio--class-public-printer newc)) - (cl-callf nreverse (eieio--class-protection newc)) + ;; Fix that up now and then them into vectors. + (cl-callf (lambda (slots) (apply #'vector (nreverse slots))) + (eieio--class-slots newc)) (cl-callf nreverse (eieio--class-initarg-tuples newc)) ;; The storage for class-class-allocation-type needs to be turned into ;; a vector now. - (cl-callf (lambda (cat) (apply #'vector cat)) - (eieio--class-class-allocation-type newc)) - - ;; Also, take class allocated values, and vectorize them for speed. - (cl-callf (lambda (cavs) (apply #'vector cavs)) - (eieio--class-class-allocation-values newc)) + (cl-callf (lambda (slots) (apply #'vector slots)) + (eieio--class-class-slots newc)) + + ;; Also, setup the class allocated values. + (let* ((slots (eieio--class-class-slots newc)) + (n (length slots)) + (v (make-vector n nil))) + (dotimes (i n) + (setf (aref v i) (eieio-default-eval-maybe + (cl--slot-descriptor-initform (aref slots i))))) + (setf (eieio--class-class-allocation-values newc) v)) ;; Attach slot symbols into a hashtable, and store the index of ;; this slot as the value this table. - (let* ((cnt 0) + (let* ((slots (eieio--class-slots newc)) + ;; (cslots (eieio--class-class-slots newc)) (oa (make-hash-table :test #'eq))) - (dolist (pubsym (eieio--class-public-a newc)) - (setf (gethash pubsym oa) cnt) - (setq cnt (1+ cnt))) - (setf (eieio--class-symbol-hashtable newc) oa)) + ;; (dotimes (cnt (length cslots)) + ;; (setf (gethash (cl--slot-descriptor-name (aref cslots cnt)) oa) (- -1 cnt))) + (dotimes (cnt (length slots)) + (setf (gethash (cl--slot-descriptor-name (aref slots cnt)) oa) cnt)) + (setf (eieio--class-index-table newc) oa)) ;; Set up a specialized doc string. ;; Use stored value since it is calculated in a non-trivial way - (put cname 'variable-documentation - (eieio--class-option-assoc options :documentation)) + (let ((docstring (eieio--class-option-assoc options :documentation))) + (setf (eieio--class-docstring newc) docstring) + (when eieio-backward-compatibility + (put cname 'variable-documentation docstring))) ;; Save the file location where this class is defined. (add-to-list 'current-load-list `(eieio-defclass . ,cname)) @@ -514,10 +504,10 @@ See `defclass' for more information." ;; if this is a superclass, clear out parent (which was set to the ;; default superclass eieio-default-superclass) - (if clearparent (setf (eieio--class-parent newc) nil)) + (if clearparent (setf (eieio--class-parents newc) nil)) ;; Create the cached default object. - (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) + (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 @@ -544,239 +534,133 @@ See `defclass' for more information." "Whether the default value VAL should be evaluated for use." (and (consp val) (symbolp (car val)) (fboundp (car val)))) -(defun eieio--perform-slot-validation-for-default (slot spec value skipnil) - "For SLOT, signal if SPEC does not match VALUE. -If SKIPNIL is non-nil, then if VALUE is nil return t instead." - (if (not (or (eieio-eval-default-p value) ;FIXME: Why? - eieio-skip-typecheck - (and skipnil (null value)) - (eieio--perform-slot-validation spec value))) - (signal 'invalid-slot-type (list slot spec value)))) - -(defun eieio--add-new-slot (newc a d doc type cust label custg print prot init alloc +(defun eieio--perform-slot-validation-for-default (slot skipnil) + "For SLOT, signal if its type does not match its default value. +If SKIPNIL is non-nil, then if default value is nil return t instead." + (let ((value (cl--slot-descriptor-initform slot)) + (spec (cl--slot-descriptor-type slot))) + (if (not (or (eieio-eval-default-p value) ;FIXME: Why? + eieio-skip-typecheck + (and skipnil (null value)) + (eieio--perform-slot-validation spec value))) + (signal 'invalid-slot-type (list (cl--slot-descriptor-name slot) spec value))))) + +(defun eieio--slot-override (old new skipnil) + (cl-assert (eq (cl--slot-descriptor-name old) (cl--slot-descriptor-name new))) + ;; There is a match, and we must override the old value. + (let* ((a (cl--slot-descriptor-name old)) + (tp (cl--slot-descriptor-type old)) + (d (cl--slot-descriptor-initform new)) + (type (cl--slot-descriptor-type new)) + (oprops (cl--slot-descriptor-props old)) + (nprops (cl--slot-descriptor-props new)) + (custg (alist-get :group nprops))) + ;; If type is passed in, is it the same? + (if (not (eq type t)) + (if (not (equal type tp)) + (error + "Child slot type `%s' does not match inherited type `%s' for `%s'" + type tp a)) + (setf (cl--slot-descriptor-type new) tp)) + ;; If we have a repeat, only update the initarg... + (unless (eq d eieio-unbound) + (eieio--perform-slot-validation-for-default new skipnil) + (setf (cl--slot-descriptor-initform old) d)) + + ;; PLN Tue Jun 26 11:57:06 2007 : The protection is + ;; checked and SHOULD match the superclass + ;; protection. Otherwise an error is thrown. However + ;; I wonder if a more flexible schedule might be + ;; implemented. + ;; + ;; EML - We used to have (if prot... here, + ;; but a prot of 'nil means public. + ;; + (let ((super-prot (alist-get :protection oprops)) + (prot (alist-get :protection nprops))) + (if (not (eq prot super-prot)) + (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" + prot super-prot a))) + ;; End original PLN + + ;; PLN Tue Jun 26 11:57:06 2007 : + ;; Do a non redundant combination of ancient custom + ;; groups and new ones. + (when custg + (let* ((list1 (alist-get :group oprops))) + (dolist (elt custg) + (unless (memq elt list1) + (push elt list1))) + (setf (alist-get :group (cl--slot-descriptor-props old)) list1))) + ;; End PLN + + ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is + ;; set, simply replaces the old one. + (dolist (prop '(:custom :label :documentation :printer)) + (when (alist-get prop (cl--slot-descriptor-props new)) + (setf (alist-get prop (cl--slot-descriptor-props old)) + (alist-get prop (cl--slot-descriptor-props new)))) + + ) )) + +(defun eieio--add-new-slot (newc slot init alloc &optional defaultoverride skipnil) - "Add into NEWC attribute A. -If A already exists in NEWC, then do nothing. If it doesn't exist, -then also add in D (default), DOC, TYPE, CUST, LABEL, CUSTG, PRINT, PROT, and INIT arg. + "Add into NEWC attribute SLOT. +If a slot of that name already exists in NEWC, then do nothing. If it doesn't exist, +INIT is the initarg, if any. Argument ALLOC specifies if the slot is allocated per instance, or per class. If optional DEFAULTOVERRIDE is non-nil, then if A exists in NEWC, we must override its value for a default. Optional argument SKIPNIL indicates if type checking should be skipped if default value is nil." ;; Make sure we duplicate those items that are sequences. + (let* ((a (cl--slot-descriptor-name slot)) + (d (cl--slot-descriptor-initform slot)) + (old (car (cl-member a (eieio--class-slots newc) + :key #'cl--slot-descriptor-name))) + (cold (car (cl-member a (eieio--class-class-slots newc) + :key #'cl--slot-descriptor-name)))) (condition-case nil (if (sequencep d) (setq d (copy-sequence d))) - ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's skip it if it doesn't work. + ;; This copy can fail on a cons cell with a non-cons in the cdr. Let's + ;; skip it if it doesn't work. (error nil)) - (if (sequencep type) (setq type (copy-sequence type))) - (if (sequencep cust) (setq cust (copy-sequence cust))) - (if (sequencep custg) (setq custg (copy-sequence custg))) + ;; (if (sequencep type) (setq type (copy-sequence type))) + ;; (if (sequencep cust) (setq cust (copy-sequence cust))) + ;; (if (sequencep custg) (setq custg (copy-sequence custg))) ;; To prevent override information w/out specification of storage, ;; we need to do this little hack. - (if (member a (eieio--class-class-allocation-a newc)) (setq alloc :class)) + (if cold (setq alloc :class)) - (if (or (not alloc) (and (symbolp alloc) (eq alloc :instance))) + (if (memq alloc '(nil :instance)) ;; In this case, we modify the INSTANCE version of a given slot. - (progn - - ;; Only add this element if it is so-far unique - (if (not (member a (eieio--class-public-a newc))) - (progn - (eieio--perform-slot-validation-for-default a type d skipnil) - (push a (eieio--class-public-a newc)) - (push d (eieio--class-public-d newc)) - (push doc (eieio--class-public-doc newc)) - (push type (eieio--class-public-type newc)) - (push cust (eieio--class-public-custom newc)) - (push label (eieio--class-public-custom-label newc)) - (push custg (eieio--class-public-custom-group newc)) - (push print (eieio--class-public-printer newc)) - (push prot (eieio--class-protection newc)) - (setf (eieio--class-initarg-tuples newc) (cons (cons init a) (eieio--class-initarg-tuples newc))) - ) - ;; When defaultoverride is true, we are usually adding new local - ;; attributes which must override the default value of any slot - ;; passed in by one of the parent classes. - (when defaultoverride - ;; There is a match, and we must override the old value. - (let* ((ca (eieio--class-public-a newc)) - (np (member a ca)) - (num (- (length ca) (length np))) - (dp (if np (nthcdr num (eieio--class-public-d newc)) - nil)) - (tp (if np (nth num (eieio--class-public-type newc)))) - ) - (if (not np) - (error "EIEIO internal error overriding default value for %s" - a) - ;; If type is passed in, is it the same? - (if (not (eq type t)) - (if (not (equal type tp)) - (error - "Child slot type `%s' does not match inherited type `%s' for `%s'" - type tp a))) - ;; If we have a repeat, only update the initarg... - (unless (eq d eieio-unbound) - (eieio--perform-slot-validation-for-default a tp d skipnil) - (setcar dp d)) - ;; If we have a new initarg, check for it. - (when init - (let* ((inits (eieio--class-initarg-tuples newc)) - (inita (rassq a inits))) - ;; Replace the CAR of the associate INITA. - ;;(message "Initarg: %S replace %s" inita init) - (setcar inita init) - )) - - ;; PLN Tue Jun 26 11:57:06 2007 : The protection is - ;; checked and SHOULD match the superclass - ;; protection. Otherwise an error is thrown. However - ;; I wonder if a more flexible schedule might be - ;; implemented. - ;; - ;; EML - We used to have (if prot... here, - ;; but a prot of 'nil means public. - ;; - (let ((super-prot (nth num (eieio--class-protection newc))) - ) - (if (not (eq prot super-prot)) - (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" - prot super-prot a))) - ;; End original PLN - - ;; PLN Tue Jun 26 11:57:06 2007 : - ;; Do a non redundant combination of ancient custom - ;; groups and new ones. - (when custg - (let* ((groups - (nthcdr num (eieio--class-public-custom-group newc))) - (list1 (car groups)) - (list2 (if (listp custg) custg (list custg)))) - (if (< (length list1) (length list2)) - (setq list1 (prog1 list2 (setq list2 list1)))) - (dolist (elt list2) - (unless (memq elt list1) - (push elt list1))) - (setcar groups list1))) - ;; End PLN - - ;; PLN Mon Jun 25 22:44:34 2007 : If a new cust is - ;; set, simply replaces the old one. - (when cust - ;; (message "Custom type redefined to %s" cust) - (setcar (nthcdr num (eieio--class-public-custom newc)) cust)) - - ;; If a new label is specified, it simply replaces - ;; the old one. - (when label - ;; (message "Custom label redefined to %s" label) - (setcar (nthcdr num (eieio--class-public-custom-label newc)) label)) - ;; End PLN - - ;; PLN Sat Jun 30 17:24:42 2007 : when a new - ;; doc is specified, simply replaces the old one. - (when doc - ;;(message "Documentation redefined to %s" doc) - (setcar (nthcdr num (eieio--class-public-doc newc)) - doc)) - ;; End PLN - - ;; If a new printer is specified, it simply replaces - ;; the old one. - (when print - ;; (message "printer redefined to %s" print) - (setcar (nthcdr num (eieio--class-public-printer newc)) print)) - - ))) - )) + ;; Only add this element if it is so-far unique + (if (not old) + (progn + (eieio--perform-slot-validation-for-default slot skipnil) + (push slot (eieio--class-slots newc)) + ) + ;; When defaultoverride is true, we are usually adding new local + ;; attributes which must override the default value of any slot + ;; passed in by one of the parent classes. + (when defaultoverride + (eieio--slot-override old slot skipnil))) + (when init + (cl-pushnew (cons init a) (eieio--class-initarg-tuples newc) + :test #'equal))) ;; CLASS ALLOCATED SLOTS - (let ((value (eieio-default-eval-maybe d))) - (if (not (member a (eieio--class-class-allocation-a newc))) - (progn - (eieio--perform-slot-validation-for-default a type value skipnil) - ;; Here we have found a :class version of a slot. This - ;; requires a very different approach. - (push a (eieio--class-class-allocation-a newc)) - (push doc (eieio--class-class-allocation-doc newc)) - (push type (eieio--class-class-allocation-type newc)) - (push cust (eieio--class-class-allocation-custom newc)) - (push label (eieio--class-class-allocation-custom-label newc)) - (push custg (eieio--class-class-allocation-custom-group newc)) - (push prot (eieio--class-class-allocation-protection newc)) - ;; Default value is stored in the 'values section, since new objects - ;; can't initialize from this element. - (push value (eieio--class-class-allocation-values newc))) - (when defaultoverride - ;; There is a match, and we must override the old value. - (let* ((ca (eieio--class-class-allocation-a newc)) - (np (member a ca)) - (num (- (length ca) (length np))) - (dp (if np - (nthcdr num - (eieio--class-class-allocation-values newc)) - nil)) - (tp (if np (nth num (eieio--class-class-allocation-type newc)) - nil))) - (if (not np) - (error "EIEIO internal error overriding default value for %s" - a) - ;; If type is passed in, is it the same? - (if (not (eq type t)) - (if (not (equal type tp)) - (error - "Child slot type `%s' does not match inherited type `%s' for `%s'" - type tp a))) - ;; EML - Note: the only reason to override a class bound slot - ;; is to change the default, so allow unbound in. - - ;; If we have a repeat, only update the value... - (eieio--perform-slot-validation-for-default a tp value skipnil) - (setcar dp value)) - - ;; PLN Tue Jun 26 11:57:06 2007 : The protection is - ;; checked and SHOULD match the superclass - ;; protection. Otherwise an error is thrown. However - ;; I wonder if a more flexible schedule might be - ;; implemented. - (let ((super-prot - (car (nthcdr num (eieio--class-class-allocation-protection newc))))) - (if (not (eq prot super-prot)) - (error "Child slot protection `%s' does not match inherited protection `%s' for `%s'" - prot super-prot a))) - ;; Do a non redundant combination of ancient custom groups - ;; and new ones. - (when custg - (let* ((groups - (nthcdr num (eieio--class-class-allocation-custom-group newc))) - (list1 (car groups)) - (list2 (if (listp custg) custg (list custg)))) - (if (< (length list1) (length list2)) - (setq list1 (prog1 list2 (setq list2 list1)))) - (dolist (elt list2) - (unless (memq elt list1) - (push elt list1))) - (setcar groups list1))) - - ;; PLN Sat Jun 30 17:24:42 2007 : when a new - ;; doc is specified, simply replaces the old one. - (when doc - ;;(message "Documentation redefined to %s" doc) - (setcar (nthcdr num (eieio--class-class-allocation-doc newc)) - doc)) - ;; End PLN - - ;; If a new printer is specified, it simply replaces - ;; the old one. - (when print - ;; (message "printer redefined to %s" print) - (setcar (nthcdr num (eieio--class-class-allocation-printer newc)) print)) - - )) - )) - )) + (if (not cold) + (progn + (eieio--perform-slot-validation-for-default slot skipnil) + ;; Here we have found a :class version of a slot. This + ;; requires a very different approach. + (push slot (eieio--class-class-slots newc))) + (when defaultoverride + ;; There is a match, and we must override the old value. + (eieio--slot-override cold slot skipnil)))))) (defun eieio-copy-parents-into-subclass (newc) "Copy into NEWC the slots of PARENTS. @@ -784,63 +668,22 @@ Follow the rules of not overwriting early parents when applying to the new child class." (let ((sn (eieio--class-option-assoc (eieio--class-options newc) :allow-nil-initform))) - (dolist (pcv (eieio--class-parent newc)) + (dolist (pcv (eieio--class-parents newc)) ;; First, duplicate all the slots of the parent. - (let ((pa (eieio--class-public-a pcv)) - (pd (eieio--class-public-d pcv)) - (pdoc (eieio--class-public-doc pcv)) - (ptype (eieio--class-public-type pcv)) - (pcust (eieio--class-public-custom pcv)) - (plabel (eieio--class-public-custom-label pcv)) - (pcustg (eieio--class-public-custom-group pcv)) - (printer (eieio--class-public-printer pcv)) - (pprot (eieio--class-protection pcv)) - (pinit (eieio--class-initarg-tuples pcv)) - (i 0)) - (while pa - (eieio--add-new-slot newc - (car pa) (car pd) (car pdoc) (aref ptype i) - (car pcust) (car plabel) (car pcustg) - (car printer) - (car pprot) (car-safe (car pinit)) nil nil sn) + (let ((pslots (eieio--class-slots pcv)) + (pinit (eieio--class-initarg-tuples pcv))) + (dotimes (i (length pslots)) + (eieio--add-new-slot newc (cl--copy-slot-descriptor (aref pslots i)) + (car-safe (car pinit)) nil nil sn) ;; Increment each value. - (setq pa (cdr pa) - pd (cdr pd) - pdoc (cdr pdoc) - i (1+ i) - pcust (cdr pcust) - plabel (cdr plabel) - pcustg (cdr pcustg) - printer (cdr printer) - pprot (cdr pprot) - pinit (cdr pinit)) + (setq pinit (cdr pinit)) )) ;; while/let ;; Now duplicate all the class alloc slots. - (let ((pa (eieio--class-class-allocation-a pcv)) - (pdoc (eieio--class-class-allocation-doc pcv)) - (ptype (eieio--class-class-allocation-type pcv)) - (pcust (eieio--class-class-allocation-custom pcv)) - (plabel (eieio--class-class-allocation-custom-label pcv)) - (pcustg (eieio--class-class-allocation-custom-group pcv)) - (printer (eieio--class-class-allocation-printer pcv)) - (pprot (eieio--class-class-allocation-protection pcv)) - (pval (eieio--class-class-allocation-values pcv)) - (i 0)) - (while pa - (eieio--add-new-slot newc - (car pa) (aref pval i) (car pdoc) (aref ptype i) - (car pcust) (car plabel) (car pcustg) - (car printer) - (car pprot) nil :class sn) - ;; Increment each value. - (setq pa (cdr pa) - pdoc (cdr pdoc) - pcust (cdr pcust) - plabel (cdr plabel) - pcustg (cdr pcustg) - printer (cdr printer) - pprot (cdr pprot) - i (1+ i)) + (let ((pcslots (eieio--class-class-slots pcv))) + (dotimes (i (length pcslots)) + (eieio--add-new-slot newc (cl--copy-slot-descriptor + (aref pcslots i)) + nil :class sn) ))))) @@ -865,10 +708,11 @@ an error." nil ;; Trim off object IDX junk added in for the object index. (setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots))) - (let ((st (aref (eieio--class-public-type class) slot-idx))) + (let ((st (cl--slot-descriptor-type (aref (eieio--class-slots class) + slot-idx)))) (if (not (eieio--perform-slot-validation st value)) (signal 'invalid-slot-type - (list (eieio--class-symbol class) slot st value)))))) + (list (eieio--class-name class) slot st value)))))) (defun eieio--validate-class-slot-value (class slot-idx value slot) "Make sure that for CLASS referencing SLOT-IDX, VALUE is valid. @@ -877,11 +721,11 @@ SLOT is the slot that is being checked, and is only used when throwing an error." (if eieio-skip-typecheck nil - (let ((st (aref (eieio--class-class-allocation-type class) - slot-idx))) + (let ((st (cl--slot-descriptor-type (aref (eieio--class-class-slots class) + slot-idx)))) (if (not (eieio--perform-slot-validation st value)) (signal 'invalid-slot-type - (list (eieio--class-symbol class) slot st value)))))) + (list (eieio--class-name class) slot st value)))))) (defun eieio-barf-if-slot-unbound (value instance slotname fn) "Throw a signal if VALUE is a representation of an UNBOUND slot. @@ -889,7 +733,7 @@ INSTANCE is the object being referenced. SLOTNAME is the offending slot. If the slot is ok, return VALUE. Argument FN is the function calling this verifier." (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) - (slot-unbound instance (eieio--object-class-object instance) slotname fn) + (slot-unbound instance (eieio--object-class instance) slotname fn) value)) @@ -904,7 +748,7 @@ Argument FN is the function calling this verifier." (let ((c (eieio--class-v obj))) (if (eieio--class-p c) (eieio-class-un-autoload obj)) c)) - (t (eieio--object-class-object obj)))) + (t (eieio--object-class obj)))) (c (eieio--slot-name-index class slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. @@ -928,7 +772,7 @@ Fills in OBJ's SLOT with its default value." (cl-check-type obj (or eieio-object class)) (cl-check-type slot symbol) (let* ((cl (cond ((symbolp obj) (eieio--class-v obj)) - (t (eieio--object-class-object obj)))) + (t (eieio--object-class obj)))) (c (eieio--slot-name-index cl slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. @@ -942,10 +786,11 @@ Fills in OBJ's SLOT with its default value." ;;(signal 'invalid-slot-name (list (class-name cl) slot)) ) (eieio-barf-if-slot-unbound - (let ((val (nth (- c (eval-when-compile eieio--object-num-slots)) - (eieio--class-public-d cl)))) + (let ((val (cl--slot-descriptor-initform + (aref (eieio--class-slots cl) + (- c (eval-when-compile eieio--object-num-slots)))))) (eieio-default-eval-maybe val)) - obj (eieio--class-symbol cl) 'oref-default)))) + obj (eieio--class-name cl) 'oref-default)))) (defun eieio-default-eval-maybe (val) "Check VAL, and return what `oref-default' would provide." @@ -966,7 +811,7 @@ Fills in OBJ's SLOT with its default value." Fills in OBJ's SLOT with VALUE." (cl-check-type obj eieio-object) (cl-check-type slot symbol) - (let* ((class (eieio--object-class-object obj)) + (let* ((class (eieio--object-class obj)) (c (eieio--slot-name-index class slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. @@ -1001,13 +846,24 @@ Fills in the default value in CLASS' in SLOT with VALUE." (eieio--validate-class-slot-value class c value slot) (aset (eieio--class-class-allocation-values class) c value)) - (signal 'invalid-slot-name (list (eieio--class-symbol class) slot))) + (signal 'invalid-slot-name (list (eieio--class-name class) slot))) + ;; `oset-default' on an instance-allocated slot is allowed by EIEIO but + ;; not by CLOS and is mildly inconsistent with the :initform thingy, so + ;; it'd be nice to get of it. This said, it is/was used at one place by + ;; gnus/registry.el, so it might be used elsewhere as well, so let's + ;; keep it for now. + ;; FIXME: Generate a compile-time warning for it! + ;; (error "Can't `oset-default' an instance-allocated slot: %S of %S" + ;; slot class) (eieio--validate-slot-value class c value slot) ;; Set this into the storage for defaults. (if (eieio-eval-default-p value) (error "Can't set default to a sexp that gets evaluated again")) - (setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots)) - (eieio--class-public-d class)) + (setf (cl--slot-descriptor-initform + ;; FIXME: Apparently we set it both in `slots' and in + ;; `object-cache', which seems redundant. + (aref (eieio--class-slots class) + (- c (eval-when-compile eieio--object-num-slots)))) value) ;; Take the value, and put it into our cache object. (eieio-oset (eieio--class-default-object-cache class) @@ -1023,11 +879,16 @@ The slot is a symbol which is installed in CLASS by the `defclass' call. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; Removed checks to outside this call - (let* ((fsi (gethash slot (eieio--class-symbol-hashtable class)))) + (let* ((fsi (gethash slot (eieio--class-index-table class)))) (if (integerp fsi) (+ (eval-when-compile eieio--object-num-slots) fsi) (let ((fn (eieio--initarg-to-attribute class slot))) - (if fn (eieio--slot-name-index class fn) nil))))) + (if fn + ;; Accessing a slot via its :initarg is accepted by EIEIO + ;; (but not CLOS) but is a bad idea (for one: it's slower). + ;; FIXME: We should emit a compile-time warning when this happens! + (eieio--slot-name-index class fn) + nil))))) (defun eieio--class-slot-name-index (class slot) "In CLASS find the index of the named SLOT. @@ -1036,13 +897,12 @@ call. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; This will happen less often, and with fewer slots. Do this the ;; storage cheap way. - (let* ((a (eieio--class-class-allocation-a class)) - (l1 (length a)) - (af (memq slot a)) - (l2 (length af))) - ;; Slot # is length of the total list, minus the remaining list of - ;; the found slot. - (if af (- l1 l2)))) + (let ((index nil) + (slots (eieio--class-class-slots class))) + (dotimes (i (length slots)) + (if (eq slot (cl--slot-descriptor-name (aref slots i))) + (setq index i))) + index)) ;;; ;; Way to assign slots based on a list. Used for constructors, or @@ -1053,12 +913,12 @@ reverse-lookup that name, and recurse with the associated slot value." If SET-ALL is non-nil, then when a default is nil, that value is reset. If SET-ALL is nil, the slots are only reset if the default is not nil." - (let ((pub (eieio--class-public-a (eieio--object-class-object obj)))) - (while pub - (let ((df (eieio-oref-default obj (car pub)))) + (let ((slots (eieio--class-slots (eieio--object-class obj)))) + (dotimes (i (length slots)) + (let* ((name (cl--slot-descriptor-name (aref slots i))) + (df (eieio-oref-default obj name))) (if (or df set-all) - (eieio-oset obj (car pub) df))) - (setq pub (cdr pub))))) + (eieio-oset obj name df)))))) (defun eieio--initarg-to-attribute (class initarg) "For CLASS, convert INITARG to the actual attribute name. @@ -1085,11 +945,8 @@ need be... May remove that later...)" (defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs) "Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible. If a consistent order does not exist, signal an error." - (if (let ((tail remaining-inputs) - (found nil)) - (while (and tail (not found)) - (setq found (car tail) tail (cdr tail))) - (not found)) + (setq remaining-inputs (delq nil remaining-inputs)) + (if (null remaining-inputs) ;; If all remaining inputs are empty lists, we are done. (nreverse reversed-partial-result) ;; Otherwise, we try to find the next element of the result. This @@ -1100,9 +957,8 @@ If a consistent order does not exist, signal an error." (tail remaining-inputs) (next (progn (while (and tail (not found)) - (setq found (and (car tail) - (eieio--c3-candidate (caar tail) - remaining-inputs)) + (setq found (eieio--c3-candidate (caar tail) + remaining-inputs) tail (cdr tail))) found))) (if next @@ -1116,9 +972,13 @@ If a consistent order does not exist, signal an error." ;; The graph is inconsistent, give up (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) +(defsubst eieio--class/struct-parents (class) + (or (eieio--class-parents class) + `(,eieio-default-superclass))) + (defun eieio--class-precedence-c3 (class) "Return all parents of CLASS in c3 order." - (let ((parents (eieio--class-parent (eieio--class-v class)))) + (let ((parents (eieio--class-parents (eieio--class-v class)))) (eieio--c3-merge-lists (list class) (append @@ -1132,7 +992,7 @@ If a consistent order does not exist, signal an error." (defun eieio--class-precedence-dfs (class) "Return all parents of CLASS in depth-first order." - (let* ((parents (eieio--class-parent class)) + (let* ((parents (eieio--class-parents class)) (classes (copy-sequence (apply #'append (list class) @@ -1155,15 +1015,13 @@ If a consistent order does not exist, signal an error." (defun eieio--class-precedence-bfs (class) "Return all parents of CLASS in breadth-first order." (let* ((result) - (queue (or (eieio--class-parent class) - `(,eieio-default-superclass)))) + (queue (eieio--class/struct-parents class))) (while queue (let ((head (pop queue))) (unless (member head result) (push head result) (unless (eq head eieio-default-superclass) - (setq queue (append queue (or (eieio--class-parent head) - `(,eieio-default-superclass)))))))) + (setq queue (append queue (eieio--class/struct-parents head))))))) (cons class (nreverse result))) ) @@ -1177,7 +1035,7 @@ method invocation orders of the involved classes." (if (or (null class) (eq class eieio-default-superclass)) nil (unless (eieio--class-default-object-cache class) - (eieio-class-un-autoload (eieio--class-symbol class))) + (eieio-class-un-autoload (eieio--class-name class))) (cl-case (eieio--class-method-invocation-order class) (:depth-first (eieio--class-precedence-dfs class)) @@ -1211,7 +1069,7 @@ method invocation orders of the involved classes." 50 #'cl--generic-struct-tag (lambda (tag) (and (symbolp tag) (boundp tag) (eieio--class-p (symbol-value tag)) - (mapcar #'eieio--class-symbol + (mapcar #'eieio--class-name (eieio--class-precedence-list (symbol-value tag))))))) (cl-defmethod cl-generic-generalizers :extra "class" (specializer) @@ -1235,7 +1093,7 @@ method invocation orders of the involved classes." (defun eieio--generic-subclass-specializers (tag) (when (eieio--class-p tag) (mapcar (lambda (class) - `(subclass ,(eieio--class-symbol class))) + `(subclass ,(eieio--class-name class))) (eieio--class-precedence-list tag)))) (defconst eieio--generic-subclass-generalizer @@ -1247,7 +1105,7 @@ method invocation orders of the involved classes." (list eieio--generic-subclass-generalizer)) -;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "25a66814a400e7dea16bf0f3bfe245ed") +;;;### (autoloads nil "eieio-compat" "eieio-compat.el" "0609a7bdcd6f38876b7f5647047ddca9") ;;; Generated autoloads from eieio-compat.el (autoload 'eieio--defalias "eieio-compat" "\ diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 0e0b31e..26fc452 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -193,12 +193,8 @@ Optional argument IGNORE is an extraneous parameter." (let* ((chil nil) (obj (widget-get widget :value)) (master-group (widget-get widget :eieio-group)) - (cv (eieio--object-class-object obj)) - (slots (eieio--class-public-a cv)) - (flabel (eieio--class-public-custom-label cv)) - (fgroup (eieio--class-public-custom-group cv)) - (fdoc (eieio--class-public-doc cv)) - (fcust (eieio--class-public-custom cv))) + (cv (eieio--object-class obj)) + (slots (eieio--class-slots cv))) ;; First line describes the object, but may not editable. (if (widget-get widget :eieio-show-name) (setq chil (cons (widget-create-child-and-convert @@ -208,7 +204,7 @@ Optional argument IGNORE is an extraneous parameter." chil))) ;; Display information about the group being shown (when master-group - (let ((groups (eieio--class-option (eieio--object-class-object obj) + (let ((groups (eieio--class-option (eieio--object-class obj) :custom-groups))) (widget-insert "Groups:") (while groups @@ -225,63 +221,59 @@ Optional argument IGNORE is an extraneous parameter." (setq groups (cdr groups))) (widget-insert "\n\n"))) ;; Loop over all the slots, creating child widgets. - (while slots - ;; Output this slot if it has a customize flag associated with it. - (when (and (car fcust) - (or (not master-group) (member master-group (car fgroup))) - (slot-boundp obj (car slots))) - ;; In this case, this slot has a custom type. Create its - ;; children widgets. - (let ((type (eieio-filter-slot-type widget (car fcust))) - (stuff nil)) - ;; This next bit is an evil hack to get some EDE functions - ;; working the way I like. - (if (and (listp type) - (setq stuff (member :slotofchoices type))) - (let ((choices (eieio-oref obj (car (cdr stuff)))) - (newtype nil)) - (while (not (eq (car type) :slotofchoices)) - (setq newtype (cons (car type) newtype) - type (cdr type))) - (while choices - (setq newtype (cons (list 'const (car choices)) - newtype) - choices (cdr choices))) - (setq type (nreverse newtype)))) - (setq chil (cons (widget-create-child-and-convert - widget 'object-slot - :childtype type - :sample-face 'eieio-custom-slot-tag-face - :tag - (concat - (make-string - (or (widget-get widget :indent) 0) - ? ) - (if (car flabel) - (car flabel) - (let ((s (symbol-name - (or - (eieio--class-slot-initarg - (eieio--object-class-object obj) - (car slots)) - (car slots))))) - (capitalize - (if (string-match "^:" s) - (substring s (match-end 0)) - s))))) - :value (slot-value obj (car slots)) - :doc (if (car fdoc) (car fdoc) - "Slot not Documented.") - :eieio-custom-visibility 'visible - ) - chil)) - ) - ) - (setq slots (cdr slots) - fdoc (cdr fdoc) - fcust (cdr fcust) - flabel (cdr flabel) - fgroup (cdr fgroup))) + (dotimes (i (length slots)) + (let* ((slot (aref slots i)) + (props (cl--slot-descriptor-props slot))) + ;; Output this slot if it has a customize flag associated with it. + (when (and (alist-get :custom props) + (or (not master-group) + (member master-group (alist-get :group props))) + (slot-boundp obj (cl--slot-descriptor-name slot))) + ;; In this case, this slot has a custom type. Create its + ;; children widgets. + (let ((type (eieio-filter-slot-type widget (alist-get :custom props))) + (stuff nil)) + ;; This next bit is an evil hack to get some EDE functions + ;; working the way I like. + (if (and (listp type) + (setq stuff (member :slotofchoices type))) + (let ((choices (eieio-oref obj (car (cdr stuff)))) + (newtype nil)) + (while (not (eq (car type) :slotofchoices)) + (setq newtype (cons (car type) newtype) + type (cdr type))) + (while choices + (setq newtype (cons (list 'const (car choices)) + newtype) + choices (cdr choices))) + (setq type (nreverse newtype)))) + (setq chil (cons (widget-create-child-and-convert + widget 'object-slot + :childtype type + :sample-face 'eieio-custom-slot-tag-face + :tag + (concat + (make-string + (or (widget-get widget :indent) 0) + ?\s) + (or (alist-get :label props) + (let ((s (symbol-name + (or + (eieio--class-slot-initarg + (eieio--object-class obj) + (car slots)) + (car slots))))) + (capitalize + (if (string-match "^:" s) + (substring s (match-end 0)) + s))))) + :value (slot-value obj (car slots)) + :doc (or (alist-get :documentation props) + "Slot not Documented.") + :eieio-custom-visibility 'visible + ) + chil)) + )))) (widget-put widget :children (nreverse chil)) )) @@ -289,34 +281,33 @@ Optional argument IGNORE is an extraneous parameter." "Get the value of WIDGET." (let* ((obj (widget-get widget :value)) (master-group eieio-cog) - (cv (eieio--object-class-object obj)) - (fgroup (eieio--class-public-custom-group cv)) (wids (widget-get widget :children)) (name (if (widget-get widget :eieio-show-name) (car (widget-apply (car wids) :value-inline)) nil)) (chil (if (widget-get widget :eieio-show-name) (nthcdr 1 wids) wids)) - (cv (eieio--object-class-object obj)) - (slots (eieio--class-public-a cv)) - (fcust (eieio--class-public-custom cv))) + (cv (eieio--object-class obj)) + (i 0) + (slots (eieio--class-slots cv))) ;; If there are any prefix widgets, clear them. ;; -- None yet ;; Create a batch of initargs for each slot. - (while (and slots chil) - (if (and (car fcust) - (or eieio-custom-ignore-eieio-co - (not master-group) (member master-group (car fgroup))) - (slot-boundp obj (car slots))) - (progn - ;; Only customized slots have widgets - (let ((eieio-custom-ignore-eieio-co t)) - (eieio-oset obj (car slots) - (car (widget-apply (car chil) :value-inline)))) - (setq chil (cdr chil)))) - (setq slots (cdr slots) - fgroup (cdr fgroup) - fcust (cdr fcust))) + (while (and (< i (length slots)) chil) + (let* ((slot (aref slots i)) + (props (cl--slot-descriptor-props slot)) + (cust (alist-get :custom props))) + (if (and cust + (or eieio-custom-ignore-eieio-co + (not master-group) + (member master-group (alist-get :group props))) + (slot-boundp obj (cl--slot-descriptor-name slot))) + (progn + ;; Only customized slots have widgets + (let ((eieio-custom-ignore-eieio-co t)) + (eieio-oset obj (cl--slot-descriptor-name slot) + (car (widget-apply (car chil) :value-inline)))) + (setq chil (cdr chil)))))) ;; Set any name updates on it. (if name (eieio-object-set-name-string obj name)) ;; This is the same object we had before. @@ -452,7 +443,7 @@ Must return the created widget." (vector (concat "Group " (symbol-name group)) (list 'customize-object obj (list 'quote group)) t)) - (eieio--class-option (eieio--object-class-object obj) :custom-groups))) + (eieio--class-option (eieio--object-class obj) :custom-groups))) (defvar eieio-read-custom-group-history nil "History for the custom group reader.") @@ -460,7 +451,7 @@ Must return the created widget." (cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass)) "Do a completing read on the name of a customization group in OBJ. Return the symbol for the group, or nil" - (let ((g (eieio--class-option (eieio--object-class-object obj) + (let ((g (eieio--class-option (eieio--object-class obj) :custom-groups))) (if (= (length g) 1) (car g) diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 8234919..c820180 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -31,6 +31,9 @@ ;;; Code: +(declare-function data-debug/eieio-insert-slots "eieio-datadebug" + (obj eieio-default-superclass)) + (defun data-debug-insert-object-slots (object prefix) "Insert all the slots of OBJECT. PREFIX specifies what to insert at the start of each line." @@ -54,16 +57,17 @@ PREFIX specifies what to insert at the start of each line." "Insert a button representing OBJECT. PREFIX is the text that precedes the button. PREBUTTONTEXT is some text between PREFIX and the object button." - (let ((start (point)) - (end nil) - (str (object-print object)) - (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots" - (eieio-object-name-string object) - (eieio-object-class object) - (eieio-class-parents (eieio-object-class object)) - (length (object-slots object)) - )) - ) + (let* ((start (point)) + (end nil) + (str (object-print object)) + (class (eieio-object-class object)) + (tip (format "Object %s\nClass: %S\nParent(s): %S\n%d slots" + (eieio-object-name-string object) + class + (eieio-class-parents class) + (length (eieio-class-slots class)) + )) + ) (insert prefix prebuttontext str) (setq end (point)) (put-text-property (- end (length str)) end 'face 'font-lock-keyword-face) @@ -80,41 +84,31 @@ PREBUTTONTEXT is some text between PREFIX and the object button." ;; Each object should have an opportunity to show stuff about itself. (cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass) - prefix) + prefix) "Insert the slots of OBJ into the current DDEBUG buffer." (let ((inhibit-read-only t)) (data-debug-insert-thing (eieio-object-name-string obj) prefix "Name: ") - (let* ((cl (eieio-object-class obj)) - (cv (eieio--class-v cl))) - (data-debug-insert-thing (eieio--class-constructor cl) + (let* ((cv (eieio--object-class obj))) + (data-debug-insert-thing (eieio--class-name cv) prefix "Class: ") ;; Loop over all the public slots - (let ((publa (eieio--class-public-a cv)) - ) - (while publa - (if (slot-boundp obj (car publa)) - (let* ((i (eieio--class-slot-initarg (eieio--class-v cl) - (car publa))) - (v (eieio-oref obj (car publa)))) - (data-debug-insert-thing - v prefix (concat - (if i (symbol-name i) - (symbol-name (car publa))) - " "))) - ;; Unbound case - (let ((i (eieio--class-slot-initarg (eieio--class-v cl) - (car publa)))) - (data-debug-insert-custom - "#unbound" prefix - (concat (if i (symbol-name i) - (symbol-name (car publa))) - " ") - 'font-lock-keyword-face)) - ) - (setq publa (cdr publa))))))) + (let ((slots (eieio--class-slots cv))) + (dotimes (i (length slots)) + (let* ((slot (aref slots i)) + (sname (cl--slot-descriptor-name slot)) + (i (eieio--class-slot-initarg cv sname)) + (sstr (concat (symbol-name (or i sname)) " "))) + (if (slot-boundp obj sname) + (let* ((v (eieio-oref obj sname))) + (data-debug-insert-thing v prefix sstr)) + ;; Unbound case + (data-debug-insert-custom + "#unbound" prefix sstr + 'font-lock-keyword-face) + ))))))) ;;; Augment the Data debug thing display list. (data-debug-add-specialized-thing (lambda (thing) (eieio-object-p thing)) diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index a769ca7..7f98730 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -99,7 +99,7 @@ If CLASS is actually an object, then also display current values of that object. (when pl (insert " Inherits from ") (while (setq cur (pop pl)) - (setq cur (eieio--class-symbol cur)) + (setq cur (eieio--class-name cur)) (insert "`") (help-insert-xref-button (symbol-name cur) 'help-function cur) @@ -136,74 +136,40 @@ If CLASS is actually an object, then also display current values of that object. (or doc ""))) (insert "\n\n"))))) +(defun eieio--help-print-slot (slot) + (insert + (concat + (propertize "Slot: " 'face 'bold) + (prin1-to-string (cl--slot-descriptor-name slot)) + (unless (eq (cl--slot-descriptor-type slot) t) + (concat " type = " + (prin1-to-string (cl--slot-descriptor-type slot)))) + (unless (eq (cl--slot-descriptor-initform slot) eieio-unbound) + (concat " default = " + (prin1-to-string (cl--slot-descriptor-initform slot)))) + (when (alist-get :printer (cl--slot-descriptor-props slot)) + (concat " printer = " + (prin1-to-string + (alist-get :printer (cl--slot-descriptor-props slot))))) + (when (alist-get :documentation (cl--slot-descriptor-props slot)) + (concat "\n " (alist-get :documentation (cl--slot-descriptor-props slot)) + "\n"))) + "\n")) + (defun eieio-help-class-slots (class) "Print help description for the slots in CLASS. Outputs to the current buffer." (let* ((cv (eieio--class-v class)) - (docs (eieio--class-public-doc cv)) - (names (eieio--class-public-a cv)) - (deflt (eieio--class-public-d cv)) - (types (eieio--class-public-type cv)) - (publp (eieio--class-public-printer cv)) - (i 0) - (prot (eieio--class-protection cv)) - ) + (slots (eieio--class-slots cv)) + (cslots (eieio--class-class-slots cv))) (insert (propertize "Instance Allocated Slots:\n\n" 'face 'bold)) - (while names - (insert - (concat - (when (car prot) - (propertize "Private " 'face 'bold)) - (propertize "Slot: " 'face 'bold) - (prin1-to-string (car names)) - (unless (eq (aref types i) t) - (concat " type = " - (prin1-to-string (aref types i)))) - (unless (eq (car deflt) eieio-unbound) - (concat " default = " - (prin1-to-string (car deflt)))) - (when (car publp) - (concat " printer = " - (prin1-to-string (car publp)))) - (when (car docs) - (concat "\n " (car docs) "\n")) - "\n")) - (setq names (cdr names) - docs (cdr docs) - deflt (cdr deflt) - publp (cdr publp) - prot (cdr prot) - i (1+ i))) - (setq docs (eieio--class-class-allocation-doc cv) - names (eieio--class-class-allocation-a cv) - types (eieio--class-class-allocation-type cv) - i 0 - prot (eieio--class-class-allocation-protection cv)) - (when names + (dotimes (i (length slots)) + (eieio--help-print-slot (aref slots i))) + (when (> (length cslots) 0) (insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))) - (while names - (insert - (concat - (when (car prot) - "Private ") - "Slot: " - (prin1-to-string (car names)) - (unless (eq (aref types i) t) - (concat " type = " - (prin1-to-string (aref types i)))) - (condition-case nil - (let ((value (eieio-oref class (car names)))) - (concat " value = " - (prin1-to-string value))) - (error nil)) - (when (car docs) - (concat "\n\n " (car docs) "\n")) - "\n")) - (setq names (cdr names) - docs (cdr docs) - prot (cdr prot) - i (1+ i))))) + (dotimes (i (length cslots)) + (eieio--help-print-slot (aref cslots i))))) (defun eieio-build-class-alist (&optional class instantiable-only buildlist) "Return an alist of all currently active classes for completion purposes. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index cdf1992..4ba6769 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -320,19 +320,21 @@ variable name of the same name as the slot." (declare (indent 2) (debug (sexp sexp def-body))) (require 'cl-lib) ;; Transform the spec-list into a cl-symbol-macrolet spec-list. - (let ((mappings (mapcar (lambda (entry) - (let ((var (if (listp entry) (car entry) entry)) - (slot (if (listp entry) (cadr entry) entry))) - (list var `(slot-value ,object ',slot)))) - spec-list))) - (append (list 'cl-symbol-macrolet mappings) - body))) + (macroexp-let2 nil object object + `(cl-symbol-macrolet + ,(mapcar (lambda (entry) + (let ((var (if (listp entry) (car entry) entry)) + (slot (if (listp entry) (cadr entry) entry))) + (list var `(slot-value ,object ',slot)))) + spec-list) + ,@body))) ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. ;; + (define-obsolete-function-alias - 'object-class-fast #'eieio--object-class-name "24.4") + 'object-class-fast #'eieio-object-class "24.4") (cl-defgeneric eieio-object-name-string (obj) "Return a string which is OBJ's name." @@ -342,7 +344,7 @@ variable name of the same name as the slot." "Return a printed representation for object OBJ. If EXTRA, include that in the string returned to represent the symbol." (cl-check-type obj eieio-object) - (format "#<%s %s%s>" (eieio--object-class-name obj) + (format "#<%s %s%s>" (eieio-object-class obj) (eieio-object-name-string obj) (or extra ""))) (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") @@ -370,7 +372,7 @@ If EXTRA, include that in the string returned to represent the symbol." "Return the class struct defining OBJ." ;; FIXME: We say we return a "struct" but we return a symbol instead! (cl-check-type obj eieio-object) - (eieio--object-class-name obj)) + (eieio--class-name (eieio--object-class obj))) (define-obsolete-function-alias 'object-class #'eieio-object-class "24.4") ;; CLOS name, maybe? (define-obsolete-function-alias 'class-of #'eieio-object-class "24.4") @@ -378,7 +380,7 @@ If EXTRA, include that in the string returned to represent the symbol." (defun eieio-object-class-name (obj) "Return a Lisp like symbol name for OBJ's class." (cl-check-type obj eieio-object) - (eieio-class-name (eieio--object-class-object obj))) + (eieio-class-name (eieio--object-class obj))) (define-obsolete-function-alias 'object-class-name 'eieio-object-class-name "24.4") @@ -386,7 +388,7 @@ If EXTRA, include that in the string returned to represent the symbol." "Return parent classes to CLASS. (overload of variable). The CLOS function `class-direct-superclasses' is aliased to this function." - (eieio--class-parent (eieio--class-object class))) + (eieio--class-parents (eieio--class-object class))) (define-obsolete-function-alias 'class-parents #'eieio-class-parents "24.4") @@ -414,13 +416,13 @@ The CLOS function `class-direct-subclasses' is aliased to this function." (setq class (eieio--class-object class)) (cl-check-type class eieio--class) (cl-check-type obj eieio-object) - (eq (eieio--object-class-object obj) class)) + (eq (eieio--object-class obj) class)) (defun object-of-class-p (obj class) "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." (cl-check-type obj eieio-object) ;; class will be checked one layer down - (child-of-class-p (eieio--object-class-object obj) class)) + (child-of-class-p (eieio--object-class obj) class)) ;; Backwards compatibility (defalias 'obj-of-class-p 'object-of-class-p) @@ -428,36 +430,36 @@ The CLOS function `class-direct-subclasses' is aliased to this function." "Return non-nil if CHILD class is a subclass of CLASS." (setq child (eieio--class-object child)) (cl-check-type child eieio--class) - ;; `eieio-default-superclass' is never mentioned in eieio--class-parent, + ;; `eieio-default-superclass' is never mentioned in eieio--class-parents, ;; so we have to special case it here. (or (eq class 'eieio-default-superclass) (let ((p nil)) (setq class (eieio--class-object class)) (cl-check-type class eieio--class) (while (and child (not (eq child class))) - (setq p (append p (eieio--class-parent child)) + (setq p (append p (eieio--class-parents child)) child (pop p))) (if child t)))) -(defun eieio-slot-descriptor-name (slot) slot) +(defun eieio-slot-descriptor-name (slot) + (cl--slot-descriptor-name slot)) (defun eieio-class-slots (class) "Return list of slots available in instances of CLASS." ;; FIXME: This only gives the instance slots and ignores the ;; class-allocated slots. - ;; FIXME: It only gives the slot's *names* rather than actual - ;; slot descriptors. (setq class (eieio--class-object class)) (cl-check-type class eieio--class) - (eieio--class-public-a class)) + (mapcar #'identity (eieio--class-slots class))) (defun object-slots (obj) "Return list of slots available in OBJ." (declare (obsolete eieio-class-slots "25.1")) (cl-check-type obj eieio-object) - (eieio-class-slots (eieio--object-class-object obj))) + (eieio-class-slots (eieio--object-class obj))) -(defun eieio--class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." +(defun eieio--class-slot-initarg (class slot) + "Fetch from CLASS, SLOT's :initarg." (cl-check-type class eieio--class) (let ((ia (eieio--class-initarg-tuples class)) (f nil)) @@ -507,12 +509,18 @@ OBJECT can be an instance or a class." (defun slot-exists-p (object-or-class slot) "Return non-nil if OBJECT-OR-CLASS has SLOT." (let ((cv (cond ((eieio-object-p object-or-class) - (eieio--object-class-object object-or-class)) + (eieio--object-class object-or-class)) ((eieio--class-p object-or-class) object-or-class) (t (find-class object-or-class 'error))))) - (or (memq slot (eieio--class-public-a cv)) - (memq slot (eieio--class-class-allocation-a cv))) - )) + (or (gethash slot (eieio--class-index-table cv)) + ;; FIXME: We could speed this up by adding class slots into the + ;; index-table (e.g. with a negative index?). + (let ((cs (eieio--class-class-slots cv)) + found) + (dotimes (i (length cs)) + (if (eq slot (cl--slot-descriptor-name (aref cs i))) + (setq found t))) + found)))) (defun find-class (symbol &optional errorp) "Return the class that SYMBOL represents. @@ -671,7 +679,7 @@ Called from the constructor routine.") "Set slots of OBJ with SLOTS which is a list of name/value pairs. Called from the constructor routine." (while slots - (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj) + (let ((rn (eieio--initarg-to-attribute (eieio--object-class obj) (car slots)))) (if (not rn) (slot-missing obj (car slots) 'oset (car (cdr slots))) @@ -694,9 +702,9 @@ not taken, then new objects of your class will not have their values dynamically set from SLOTS." ;; First, see if any of our defaults are `lambda', and ;; re-evaluate them and apply the value to our slots. - (let* ((this-class (eieio--object-class-object this)) - (defaults (eieio--class-public-d this-class))) - (dolist (slot (eieio--class-public-a this-class)) + (let* ((this-class (eieio--object-class this)) + (slots (eieio--class-slots this-class))) + (dotimes (i (length slots)) ;; For each slot, see if we need to evaluate it. ;; ;; Paul Landes said in an email: @@ -704,11 +712,12 @@ dynamically set from SLOTS." ;; > the quoted thing as you already have. This is by the ;; > Sonya E. Keene book and other things I've look at on the ;; > web. - (let ((dflt (eieio-default-eval-maybe (car defaults)))) - (when (not (eq dflt (car defaults))) - (eieio-oset this slot dflt) )) - ;; Next. - (setq defaults (cdr defaults)))) + (let* ((slot (aref slots i)) + (initform (cl--slot-descriptor-initform slot)) + (dflt (eieio-default-eval-maybe initform))) + (when (not (eq dflt initform)) + ;; FIXME: We should be able to just do (aset this (+ i ) dflt)! + (eieio-oset this (cl--slot-descriptor-name slot) dflt))))) ;; Shared initialize will parse our slots for us. (shared-initialize this slots)) @@ -825,32 +834,31 @@ this object." (prin1 (eieio-object-name-string this)) (princ "\n") ;; Loop over all the public slots - (let ((publa (eieio--class-public-a cv)) - (publd (eieio--class-public-d cv)) - (publp (eieio--class-public-printer cv)) + (let ((slots (eieio--class-slots cv)) (eieio-print-depth (1+ eieio-print-depth))) - (while publa - (when (slot-boundp this (car publa)) - (let ((i (eieio--class-slot-initarg cv (car publa))) - (v (eieio-oref this (car publa))) - ) - (unless (or (not i) (equal v (car publd))) - (unless (bolp) - (princ "\n")) - (princ (make-string (* eieio-print-depth 2) ? )) - (princ (symbol-name i)) - (if (car publp) - ;; Use our public printer - (progn - (princ " ") - (funcall (car publp) v)) - ;; Use our generic override prin1 function. - (princ (if (or (eieio-object-p v) - (eieio-object-p (car-safe v))) - "\n" " ")) - (eieio-override-prin1 v))))) - (setq publa (cdr publa) publd (cdr publd) - publp (cdr publp)))) + (dotimes (i (length slots)) + (let ((slot (aref slots i))) + (when (slot-boundp this (cl--slot-descriptor-name slot)) + (let ((i (eieio--class-slot-initarg + cv (cl--slot-descriptor-name slot))) + (v (eieio-oref this (cl--slot-descriptor-name slot)))) + (unless (or (not i) (equal v (cl--slot-descriptor-initform slot))) + (unless (bolp) + (princ "\n")) + (princ (make-string (* eieio-print-depth 2) ? )) + (princ (symbol-name i)) + (if (alist-get :printer (cl--slot-descriptor-props slot)) + ;; Use our public printer + (progn + (princ " ") + (funcall (alist-get :printer + (cl--slot-descriptor-props slot)) + v)) + ;; Use our generic override prin1 function. + (princ (if (or (eieio-object-p v) + (eieio-object-p (car-safe v))) + "\n" " ")) + (eieio-override-prin1 v)))))))) (princ ")") (when (= eieio-print-depth 0) (princ "\n")))) @@ -919,7 +927,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2ec91e473fcad1ff20cd76edc4aab706") +;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "813d32fbf76d4248fc6b4dc97ebcd720") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ @@ -930,7 +938,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;*** -;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "d1910eb455f102989fc33bb3f5a9b614") +;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "3005b815c6b30eccbf0642170b3f82a5") ;;; Generated autoloads from eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ diff --git a/test/ChangeLog b/test/ChangeLog index e150aba..15408a3 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,16 @@ +2015-03-19 Stefan Monnier + + * automated/eieio-tests.el (eieio-test-17-virtual-slot): Don't use + initarg in `oset'. + (eieio-test-32-slot-attribute-override-2): Adjust to new + slot representation. + + * automated/eieio-test-persist.el (persist-test-save-and-compare): + Adjust to new slot representation. + + * automated/eieio-test-methodinvoke.el (make-instance): Use new-style + `subclass' specializer for a change. + 2015-03-17 Stefan Monnier * automated/cl-lib-tests.el: Use lexical-binding. diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index 62f5603..52630134 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el @@ -184,7 +184,7 @@ (if (next-method-p) (call-next-method)) ) -(defmethod make-instance :STATIC ((p C) &rest args) +(cl-defmethod make-instance ((p (subclass C)) &rest args) (eieio-test-method-store :STATIC 'C) (call-next-method) ) diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el index 7bb2f1c..6710ead 100644 --- a/test/automated/eieio-test-persist.el +++ b/test/automated/eieio-test-persist.el @@ -45,20 +45,20 @@ This is usually a symbol that starts with `:'." (eieio-persistent-save original) - (let* ((file (oref original :file)) + (let* ((file (oref original file)) (class (eieio-object-class original)) (fromdisk (eieio-persistent-read file class)) (cv (eieio--class-v class)) - (slot-names (eieio--class-public-a cv)) - (slot-deflt (eieio--class-public-d cv)) + (slots (eieio--class-slots cv)) ) (unless (object-of-class-p fromdisk class) (error "Persistent class %S != original class %S" (eieio-object-class fromdisk) class)) - (while slot-names - (let* ((oneslot (car slot-names)) + (dotimes (i (length slots)) + (let* ((slot (aref slots i)) + (oneslot (cl--slot-descriptor-name slot)) (origvalue (eieio-oref original oneslot)) (fromdiskvalue (eieio-oref fromdisk oneslot)) (initarg-p (eieio--attribute-to-initarg @@ -70,12 +70,9 @@ This is usually a symbol that starts with `:'." (error "Slot %S Original Val %S != Persistent Val %S" oneslot origvalue fromdiskvalue)) ;; Else !initarg-p - (unless (equal (car slot-deflt) fromdiskvalue) + (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue) (error "Slot %S Persistent Val %S != Default Value %S" - oneslot fromdiskvalue (car slot-deflt)))) - - (setq slot-names (cdr slot-names) - slot-deflt (cdr slot-deflt)) + oneslot fromdiskvalue (cl--slot-descriptor-initform slot)))) )))) ;;; Simple Case diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el index 7532609..01131d8 100644 --- a/test/automated/eieio-tests.el +++ b/test/automated/eieio-tests.el @@ -406,21 +406,21 @@ METHOD is the method that was attempting to be called." (ert-deftest eieio-test-17-virtual-slot () (setq eitest-vsca (virtual-slot-class :base-value 1)) ;; Check slot values - (should (= (oref eitest-vsca :base-value) 1)) + (should (= (oref eitest-vsca base-value) 1)) (should (= (oref eitest-vsca :derived-value) 2)) - (oset eitest-vsca :derived-value 3) - (should (= (oref eitest-vsca :base-value) 2)) + (oset eitest-vsca derived-value 3) + (should (= (oref eitest-vsca base-value) 2)) (should (= (oref eitest-vsca :derived-value) 3)) - (oset eitest-vsca :base-value 3) - (should (= (oref eitest-vsca :base-value) 3)) + (oset eitest-vsca base-value 3) + (should (= (oref eitest-vsca base-value) 3)) (should (= (oref eitest-vsca :derived-value) 4)) ;; should also be possible to initialize instance using virtual slot (setq eitest-vscb (virtual-slot-class :derived-value 5)) - (should (= (oref eitest-vscb :base-value) 4)) + (should (= (oref eitest-vscb base-value) 4)) (should (= (oref eitest-vscb :derived-value) 5))) (ert-deftest eieio-test-18-slot-unbound () @@ -560,7 +560,8 @@ METHOD is the method that was attempting to be called." (setq eitest-t1 (class-c)) ;; Slot initialization (should (eq (oref eitest-t1 slot-1) 'moose)) - (should (eq (oref eitest-t1 :moose) 'moose)) + ;; Accessing via the initarg name is deprecated! + ;; (should (eq (oref eitest-t1 :moose) 'moose)) ;; Don't pass reference of private slot ;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name) ;; Check private slot accessor @@ -580,7 +581,8 @@ METHOD is the method that was attempting to be called." ;; See previous test, nor for subclass (setq eitest-t2 (class-subc)) (should (eq (oref eitest-t2 slot-1) 'moose)) - (should (eq (oref eitest-t2 :moose) 'moose)) + ;; Accessing via the initarg name is deprecated! + ;;(should (eq (oref eitest-t2 :moose) 'moose)) (should (string= (get-slot-2 eitest-t2) "linux")) ;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name) (should (string= (get-slot-2 eitest-t2) "linux")) @@ -802,30 +804,24 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-32-slot-attribute-override-2 () (let* ((cv (eieio--class-v 'slotattr-ok)) - (docs (eieio--class-public-doc cv)) - (names (eieio--class-public-a cv)) - (cust (eieio--class-public-custom cv)) - (label (eieio--class-public-custom-label cv)) - (group (eieio--class-public-custom-group cv)) - (types (eieio--class-public-type cv)) - (args (eieio--class-initarg-tuples cv)) - (i 0)) + (slots (eieio--class-slots cv)) + (args (eieio--class-initarg-tuples cv))) ;; :initarg should override for subclass (should (assoc :initblarg args)) - (while (< i (length names)) - (cond - ((eq (nth i names) 'custom) - ;; Custom slot attributes must override - (should (eq (nth i cust) 'string)) - ;; Custom label slot attribute must override - (should (string= (nth i label) "One String")) - (let ((grp (nth i group))) - ;; Custom group slot attribute must combine - (should (and (memq 'moose grp) (memq 'cow grp))))) - (t nil)) - - (setq i (1+ i))))) + (dotimes (i (length slots)) + (let* ((slot (aref slots i)) + (props (cl--slot-descriptor-props slot))) + (cond + ((eq (cl--slot-descriptor-name slot) 'custom) + ;; Custom slot attributes must override + (should (eq (alist-get :custom props) 'string)) + ;; Custom label slot attribute must override + (should (string= (alist-get :label props) "One String")) + (let ((grp (alist-get :group props))) + ;; Custom group slot attribute must combine + (should (and (memq 'moose grp) (memq 'cow grp))))) + (t nil)))))) (defvar eitest-CLONETEST1 nil) (defvar eitest-CLONETEST2 nil) @@ -891,8 +887,7 @@ Subclasses to override slot attributes.") (should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2)) (should (= (length (eieio-build-class-alist 'opt-test1 t)) 1))) -(defclass eieio--testing () - ()) +(defclass eieio--testing () ()) (defmethod constructor :static ((_x eieio--testing) newname &rest _args) (list newname 2)) commit f469024eea692a163beb98a824b5cc0a4e8bcda8 Author: Vibhav Pant Date: Thu Mar 19 06:45:58 2015 +0530 Use delete-char instead of delete-backward-char. * lisp/leim/quail/hangul.el * lisp/progmodes/cperl-mode.el: Use delete-char instead of delete-backward-char, fixes compilation warnings. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index de940c3..e75f81b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2015-03-19 Vibhav Pant + + * lisp/leim/quail/hangul.el + * lisp/progmodes/cperl-mode.el: Use delete-char instead of + delete-backward-char, fixes compilation warnings. + 2015-03-18 Michael Albinus * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat): diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index 243fa04..12d7358 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -351,7 +351,7 @@ Other parts are the same as a `hangul3-input-method-cho'." (aset hangul-queue i 0)) (if (notzerop (apply '+ (append hangul-queue nil))) (hangul-insert-character hangul-queue) - (delete-backward-char 1))) + (delete-char -1))) (defun hangul-to-hanja-conversion () "Convert the previous hangul character to the corresponding hanja character. @@ -363,7 +363,7 @@ When a Korean input method is off, convert the following hangul character." (if (and (overlayp quail-overlay) (overlay-start quail-overlay)) (progn (setq hanja-character (hangul-to-hanja-char (preceding-char))) - (setq delete-func (lambda () (delete-backward-char 1)))) + (setq delete-func (lambda () (delete-char -1)))) (setq hanja-character (hangul-to-hanja-char (following-char))) (setq delete-func (lambda () (delete-char 1)))) (when hanja-character diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 3b8742e..f207016 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -2281,8 +2281,8 @@ to nil." (search-backward ")") (if (eq last-command-event ?\() (progn ; Avoid "if (())" - (delete-backward-char 1) - (delete-backward-char -1)))) + (delete-char -1) + (delete-char 1)))) (if delete (cperl-putback-char cperl-del-back-ch)) (if cperl-message-electric-keyword @@ -2588,7 +2588,7 @@ Will untabify if `cperl-electric-backspace-untabify' is non-nil." (delete-region (point) p)) (if cperl-electric-backspace-untabify (backward-delete-char-untabify arg) - (delete-backward-char arg))))) + (delete-char (- arg)))))) (put 'cperl-electric-backspace 'delete-selection 'supersede) commit 611a4791a4499eaaa5d1d652e538485b7c15ff0b Author: Michael Albinus Date: Wed Mar 18 20:32:16 2015 +0100 Mark apostrophs with ?/ instead of \037 in Tramp Fixes: debbugs:20117 * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat): Mark apostrophs with ?/ instead of \037. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 2db0f9a..de940c3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2015-03-18 Michael Albinus + + * net/tramp-sh.el (tramp-do-directory-files-and-attributes-with-stat): + Mark apostrophs with ?/ instead of \037. (Bug#20117) + 2015-03-18 Stefan Monnier Add classes as run-time descriptors of cl-structs. @@ -72,7 +77,7 @@ 2015-03-17 Michael Albinus - * tramp-sh.el (tramp-maybe-send-script): Avoid leading tabs in + * net/tramp-sh.el (tramp-maybe-send-script): Avoid leading tabs in shell scripts. (Bug#20118) 2015-03-17 Eli Zaretskii diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 133d886..b82b4de 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1719,12 +1719,12 @@ be non-negative integers." ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, ;; but it does not work on all remote systems. Therefore, we ;; use \000 as file separator. - ;; Apostrophes in the stat output are masked as \037 characters, in + ;; Apostrophes in the stat output are masked as ?/ characters, in ;; order to make a proper shell escape of them in file names. "cd %s && echo \"(\"; (%s %s -a | " "xargs %s -c " - "'(\037%%n\037 (\037%%N\037) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \037%%A\037 t %%ie0 -1)'" - " -- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/\037/\"/g'); echo \")\"") + "'(/%%n/ (/%%N/) %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 /%%A/ t %%ie0 -1)' " + "-- 2>/dev/null | sed -e 's/\"/\\\\\"/g' -e 's/\\//\"/g'); echo \")\"") (tramp-shell-quote-argument localname) (tramp-get-ls-command vec) ;; On systems which have no quoting style, file names with @@ -1732,8 +1732,8 @@ be non-negative integers." (if (tramp-get-ls-command-with-quoting-style vec) "--quoting-style=shell" "") (tramp-get-remote-stat vec) - (if (eq id-format 'integer) "%ue0" "\037%U\037") - (if (eq id-format 'integer) "%ge0" "\037%G\037")))) + (if (eq id-format 'integer) "%ue0" "/%U/") + (if (eq id-format 'integer) "%ge0" "/%G/")))) ;; This function should return "foo/" for directories and "bar" for ;; files. commit 81deba3d7a2b187d58fe26bd8b4eafb5687095e1 Merge: 8dfff87 1a941d6 Author: Paul Eggert Date: Wed Mar 18 11:45:36 2015 -0700 Merge from origin/emacs-24 1a941d6 Fix incorrect usage of @key in the User Manual (Bug#20135) 14c47d3 doc/misc/efaq-w32.texi: Spell-check. ac85901 doc/misc/efaq-w32.texi: Remove outdated information and update. c43762d Fix description of fullscreen mode on MS-Windows (Bug#20110). ea8cab3 doc/lispref/minibuf.texi (Basic Completion): Fix a typo. (Bug#20108) 2fdec80 Improve indexing in Emacs manual (Bug#20105) cc11321 Fix --no-bitmap-icon Conflicts: doc/emacs/ChangeLog doc/lispref/ChangeLog doc/misc/ChangeLog src/ChangeLog commit 1a941d6c9eab9a35682408d6b85a1a98cfb6b01d (refs/remotes/origin/emacs-24) Author: Eli Zaretskii Date: Wed Mar 18 19:32:22 2015 +0200 Fix incorrect usage of @key in the User Manual (Bug#20135) doc/emacs/misc.texi (Term Mode): doc/emacs/programs.texi (Basic Indent, Custom C Indent): doc/emacs/mini.texi (Minibuffer History): doc/emacs/text.texi (Org Mode): doc/emacs/display.texi (View Mode): Use @kbd where @key was mistakenly used. diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index b9c16c9..aba1e92 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,12 @@ +2015-03-18 Eli Zaretskii + + * misc.texi (Term Mode): + * programs.texi (Basic Indent, Custom C Indent): + * mini.texi (Minibuffer History): + * text.texi (Org Mode): + * display.texi (View Mode): Use @kbd where @key was mistakenly + used. (Bug#20135) + 2015-03-14 Eli Zaretskii * basic.texi (Moving Point): Improve indexing for HOME and END. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 34f84e7..4046d69 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -428,7 +428,7 @@ it. @xref{Disabling}. screenfuls. It provides commands for scrolling through the buffer conveniently but not for changing it. Apart from the usual Emacs cursor motion commands, you can type @key{SPC} to scroll forward one -windowful, @key{S-@key{SPC}} or @key{DEL} to scroll backward, and @kbd{s} to +windowful, @kbd{S-@key{SPC}} or @key{DEL} to scroll backward, and @kbd{s} to start an incremental search. @kindex q @r{(View mode)} diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 2a86af3..f0bedf8 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -622,7 +622,7 @@ typed @kbd{M-p}), Emacs tries fetching from a list of default arguments: values that you are likely to enter. You can think of this as moving through the ``future history'' list. - If you edit the text inserted by the @kbd{M-p} or @key{M-n} + If you edit the text inserted by the @kbd{M-p} or @kbd{M-n} minibuffer history commands, this does not change its entry in the history list. However, the edited argument does go at the end of the history list when you submit it. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 0431e84..b3f8325 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1306,7 +1306,7 @@ char mode. @table @kbd @item C-c C-c -Send a literal @key{C-c} to the sub-shell. +Send a literal @kbd{C-c} to the sub-shell. @item C-c @var{char} This is equivalent to @kbd{C-x @var{char}} in normal Emacs. For diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 3291754..ff7bed0 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -383,7 +383,7 @@ the preceding lines; if the region is active, @key{TAB} indents each line within the region, not just the current line. The command @key{RET} (@code{newline}), which was documented in -@ref{Inserting Text}, does the same as @key{C-j} followed by +@ref{Inserting Text}, does the same as @kbd{C-j} followed by @key{TAB}: it inserts a new line, then adjusts the line's indentation. When indenting a line that starts within a parenthetical grouping, @@ -559,7 +559,7 @@ predefined styles, including @code{gnu}, @code{k&r}, @code{bsd}, styles are primarily intended for one language, but any of them can be used with any of the languages supported by these modes. To find out what a style looks like, select it and reindent some code, e.g., by -typing @key{C-M-q} at the start of a function definition. +typing @kbd{C-M-q} at the start of a function definition. @kindex C-c . @r{(C mode)} @findex c-set-style diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 11b916a..9bc5ade 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1293,7 +1293,7 @@ executed. @kindex S-TAB @r{(Org Mode)} @findex org-shifttab - Typing @key{S-TAB} (@code{org-shifttab}) anywhere in an Org mode + Typing @kbd{S-@key{TAB}} (@code{org-shifttab}) anywhere in an Org mode buffer cycles the visibility of the entire outline structure, between (i) showing only top-level heading lines, (ii) showing all heading lines but no body lines, and (iii) showing everything. commit 8dfff871bdf0e420c6f5570e72afc80471d40d51 Author: Stefan Monnier Date: Wed Mar 18 10:49:55 2015 -0400 * cl-generic.el (cl-generic-generalizers): Clean up after braindamage diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index c9ca92d..fb11a3e 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -903,8 +903,8 @@ Can only be used from within the lexical body of a primary or around method." ;; take place without requiring cl-lib. (let ((class (cl--find-class type))) (and (cl-typep class 'cl-structure-class) - (when (cl--struct-class-type class) - (error "Can't dispatch on cl-struct %S: type is %S" + (or (null (cl--struct-class-type class)) + (error "Can't dispatch on cl-struct %S: type is %S" type (cl--struct-class-type class))) (progn (cl-assert (null (cl--struct-class-named class))) t) (list cl--generic-struct-generalizer)))) commit 872481d9e26d7569145c897fd319b1104e028878 Author: Stefan Monnier Date: Wed Mar 18 10:31:07 2015 -0400 Add classes as run-time descriptors of cl-structs. * lisp/emacs-lisp/cl-preloaded.el (cl--struct-get-class): New function. (cl--make-slot-desc): New constructor. (cl--plist-remove, cl--struct-register-child): New functions. (cl-struct-define): Rewrite. (cl-structure-class, cl-structure-object, cl-slot-descriptor) (cl--class): New structs. (cl--struct-default-parent): Initialize it here. * lisp/emacs-lisp/cl-macs.el (cl--find-class): New macro. (cl-defsubst, cl--defsubst-expand, cl--sublis): Move before first use. (cl--struct-default-parent): New var. (cl-defstruct): Adjust to new representation of classes; add default parent. In accessors, signal `wrong-type-argument' rather than a generic error. (cl-struct-sequence-type, cl-struct-slot-info) (cl-struct-slot-offset): Rewrite. * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-specializers) (cl-generic-generalizers): Rewrite. * src/alloc.c (purecopy): Handle hash-tables. * lisp/emacs-lisp/debug.el (debug--implement-debug-on-entry): Bind inhibit-debug-on-entry here... (debug): Instead of here. * lisp/emacs-lisp/macroexp.el (macroexp--debug-eager): New var. (internal-macroexpand-for-load): Use it. * lwlib/xlwmenu.c (pop_up_menu): Remove debugging code. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d61a0a6..2db0f9a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,31 @@ +2015-03-18 Stefan Monnier + + Add classes as run-time descriptors of cl-structs. + * emacs-lisp/cl-preloaded.el (cl--struct-get-class): New function. + (cl--make-slot-desc): New constructor. + (cl--plist-remove, cl--struct-register-child): New functions. + (cl-struct-define): Rewrite. + (cl-structure-class, cl-structure-object, cl-slot-descriptor) + (cl--class): New structs. + (cl--struct-default-parent): Initialize it here. + * emacs-lisp/cl-macs.el (cl--find-class): New macro. + (cl-defsubst, cl--defsubst-expand, cl--sublis): Move before first use. + (cl--struct-default-parent): New var. + (cl-defstruct): Adjust to new representation of classes; add + default parent. In accessors, signal `wrong-type-argument' rather than + a generic error. + (cl-struct-sequence-type, cl-struct-slot-info) + (cl-struct-slot-offset): Rewrite. + * emacs-lisp/cl-generic.el (cl--generic-struct-specializers) + (cl-generic-generalizers): Rewrite. + + * emacs-lisp/macroexp.el (macroexp--debug-eager): New var. + (internal-macroexpand-for-load): Use it. + + * emacs-lisp/debug.el (debug--implement-debug-on-entry): + Bind inhibit-debug-on-entry here... + (debug): Instead of here. + 2015-03-18 Dima Kogan Have gud-display-line not display source buffer in gud window. @@ -6,13 +34,13 @@ 2015-03-17 Tassilo Horn - * emacs-lisp/byte-run.el (macro-declarations-alist): New - declaration no-font-lock-keyword. + * emacs-lisp/byte-run.el (macro-declarations-alist): + New declaration no-font-lock-keyword. (defmacro): Flush font-lock in existing elisp buffers. * emacs-lisp/lisp-mode.el (lisp--el-update-after-load) - (lisp--el-update-macro-regexp, lisp--el-macro-regexp): Delete - functions and defconst. + (lisp--el-update-macro-regexp, lisp--el-macro-regexp): + Delete functions and defconst. (lisp--el-match-keyword): Rename from lisp--el-match-macro. (lisp--el-font-lock-flush-elisp-buffers): New function. (lisp-mode-variables): Remove code for updating @@ -21,23 +49,17 @@ 2015-03-17 Simen Heggestøyl - * textmodes/css-mode.el (css--font-lock-keywords): Discriminate - between pseudo-classes and pseudo-elements. + * textmodes/css-mode.el (css--font-lock-keywords): + Discriminate between pseudo-classes and pseudo-elements. (css-pseudo-ids): Remove. - (css-pseudo-class-ids): New variable. - (css-pseudo-element-ids): New variable. - (css--complete-property): New function for completing CSS - properties. - (css--complete-pseudo-element-or-class): New function for + (css-pseudo-class-ids, css-pseudo-element-ids): New variables. + (css--complete-property): New function for completing CSS properties. + (css--complete-pseudo-element-or-class): New function completing CSS pseudo-elements and pseudo-classes. (css--complete-at-rule): New function for completing CSS at-rules. - (css-completion-at-point): New function providing completion for - `css-mode'. + (css-completion-at-point): New function. (css-mode): Add support for completion. - (css-extract-keyword-list): Remove function in favor of manual - extraction. - (css-extract-parse-val-grammar): Remove function in favor of - manual extraction. + (css-extract-keyword-list, css-extract-parse-val-grammar) (css-extract-props-and-vals): Remove function in favor of manual extraction. (css-at-ids): Update list of CSS at-rule ids. @@ -163,7 +185,7 @@ * progmodes/sql.el: Version 3.5 (sql-starts-with-prompt-re, sql-ends-with-prompt-re): Match password prompts. - (sql-interactive-remove-continuation-prompt): Fixed regression. (Bug#6686) + (sql-interactive-remove-continuation-prompt): Fix regression. (Bug#6686) 2015-03-14 Daniel Colascione @@ -178,8 +200,8 @@ info-look fixes for Texinfo 5 * info-look.el (c-mode, bison-mode, makefile-mode) (makefile-automake-mode, texinfo-mode, autoconf-mode, awk-mode) - (latex-mode, emacs-lisp-mode, sh-mode, cfengine-mode): Match - `foo' and 'foo' and ‘foo’ for @item and similar. + (latex-mode, emacs-lisp-mode, sh-mode, cfengine-mode): + Match `foo' and 'foo' and ‘foo’ for @item and similar. (latex-mode): Match multi-arg \frac{num}{den} or \sqrt[root]{n} in suffix regexp. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 41c760e..c9ca92d 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -857,6 +857,18 @@ Can only be used from within the lexical body of a primary or around method." ;;; Support for cl-defstructs specializers. (defun cl--generic-struct-tag (name) + ;; 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))) @@ -864,14 +876,18 @@ Can only be used from within the lexical body of a primary or around method." tag)))) (defun cl--generic-struct-specializers (tag) - (and (symbolp tag) - ;; A method call shouldn't itself mess with the match-data. - (string-match-p "\\`cl-struct-\\(.*\\)" (symbol-name tag)) - (let ((types (list (intern (substring (symbol-name tag) 10))))) - (while (get (car types) 'cl-struct-include) - (push (get (car types) 'cl-struct-include) types)) - (push 'cl-structure-object types) ;The "parent type" of all cl-structs. - (nreverse types)))) + (and (symbolp tag) (boundp tag) + (let ((class (symbol-value tag))) + (when (cl-typep class 'cl-structure-class) + (let ((types ()) + (classes (list class))) + ;; BFS precedence. + (while (let ((class (pop classes))) + (push (cl--class-name class) types) + (setq classes + (append classes + (cl--class-parents class))))) + (nreverse types)))))) (defconst cl--generic-struct-generalizer (cl-generic-make-generalizer @@ -881,27 +897,17 @@ Can only be used from within the lexical body of a primary or around method." (cl-defmethod cl-generic-generalizers :extra "cl-struct" (type) "Support for dispatch on cl-struct types." (or - (and (symbolp type) - (get type 'cl-struct-type) - (or (null (car (get type 'cl-struct-type))) - (error "Can't dispatch on cl-struct %S: type is %S" - type (car (get type 'cl-struct-type)))) - (or (equal '(cl-tag-slot) (car (get type 'cl-struct-slots))) - (error "Can't dispatch on cl-struct %S: no tag in slot 0" - type)) - ;; 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)) - (list cl--generic-struct-generalizer)) + (when (symbolp type) + ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than + ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can + ;; take place without requiring cl-lib. + (let ((class (cl--find-class type))) + (and (cl-typep class 'cl-structure-class) + (when (cl--struct-class-type class) + (error "Can't dispatch on cl-struct %S: type is %S" + type (cl--struct-class-type class))) + (progn (cl-assert (null (cl--struct-class-named class))) t) + (list cl--generic-struct-generalizer)))) (cl-call-next-method))) ;;; Dispatch on "system types". diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 56fbcf0..d386678 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2434,8 +2434,79 @@ Like `cl-callf', but PLACE is the second argument of FUNC, not the first. (if (symbolp func) (cons func rargs) `(funcall #',func ,@rargs)))))))) +;;;###autoload +(defmacro cl-defsubst (name args &rest body) + "Define NAME as a function. +Like `defun', except the function is automatically declared `inline' and +the arguments are immutable. +ARGLIST allows full Common Lisp conventions, and BODY is implicitly +surrounded by (cl-block NAME ...). +The function's arguments should be treated as immutable. + +\(fn NAME ARGLIST [DOCSTRING] BODY...)" + (declare (debug cl-defun) (indent 2)) + (let* ((argns (cl--arglist-args args)) + (p argns) + ;; (pbody (cons 'progn body)) + ) + (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p)) + `(progn + ,(if p nil ; give up if defaults refer to earlier args + `(cl-define-compiler-macro ,name + ,(if (memq '&key args) + `(&whole cl-whole &cl-quote ,@args) + (cons '&cl-quote args)) + (cl--defsubst-expand + ',argns '(cl-block ,name ,@body) + ;; We used to pass `simple' as + ;; (not (or unsafe (cl-expr-access-order pbody argns))) + ;; But this is much too simplistic since it + ;; does not pay attention to the argvs (and + ;; cl-expr-access-order itself is also too naive). + nil + ,(and (memq '&key args) 'cl-whole) nil ,@argns))) + (cl-defun ,name ,args ,@body)))) + +(defun cl--defsubst-expand (argns body simple whole _unsafe &rest argvs) + (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole + (if (cl--simple-exprs-p argvs) (setq simple t)) + (let* ((substs ()) + (lets (delq nil + (cl-mapcar (lambda (argn argv) + (if (or simple (macroexp-const-p argv)) + (progn (push (cons argn argv) substs) + nil) + (list argn argv))) + argns argvs)))) + ;; FIXME: `sublis/subst' will happily substitute the symbol + ;; `argn' in places where it's not used as a reference + ;; to a variable. + ;; FIXME: `sublis/subst' will happily copy `argv' to a different + ;; scope, leading to name capture. + (setq body (cond ((null substs) body) + ((null (cdr substs)) + (cl-subst (cdar substs) (caar substs) body)) + (t (cl--sublis substs body)))) + (if lets `(let ,lets ,body) body)))) + +(defun cl--sublis (alist tree) + "Perform substitutions indicated by ALIST in TREE (non-destructively)." + (let ((x (assq tree alist))) + (cond + (x (cdr x)) + ((consp tree) + (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree)))) + (t tree)))) + ;;; Structures. +(defmacro cl--find-class (type) + `(get ,type 'cl--class)) + +;; Rather than hard code cl-structure-object, we indirect through this variable +;; for bootstrapping reasons. +(defvar cl--struct-default-parent nil) + ;;;###autoload (defmacro cl-defstruct (struct &rest descs) "Define a struct type. @@ -2491,6 +2562,7 @@ non-nil value, that slot cannot be set via `setf'. (tag (intern (format "cl-struct-%s" name))) (tag-symbol (intern (format "cl-struct-%s-tags" name))) (include-descs nil) + (include-name nil) (type nil) (named nil) (forms nil) @@ -2520,12 +2592,14 @@ non-nil value, that slot cannot be set via `setf'. ((eq opt :predicate) (if args (setq predicate (car args)))) ((eq opt :include) - (when include (error "Can't :include more than once")) - (setq include (car args) - include-descs (mapcar (function - (lambda (x) - (if (consp x) x (list x)))) - (cdr args)))) + ;; FIXME: Actually, we can include more than once as long as + ;; we include EIEIO classes rather than cl-structs! + (when include-name (error "Can't :include more than once")) + (setq include-name (car args)) + (setq include-descs (mapcar (function + (lambda (x) + (if (consp x) x (list x)))) + (cdr args)))) ((eq opt :print-function) (setq print-func (car args))) ((eq opt :type) @@ -2537,19 +2611,21 @@ non-nil value, that slot cannot be set via `setf'. descs))) (t (error "Slot option %s unrecognized" opt))))) + (unless (or include-name type) + (setq include-name cl--struct-default-parent)) + (when include-name (setq include (cl--struct-get-class include-name))) (if print-func (setq print-func `(progn (funcall #',print-func cl-x cl-s cl-n) t)) - (or type (and include (not (get include 'cl-struct-print))) + (or type (and include (not (cl--struct-class-print include))) (setq print-auto t print-func (and (or (not (or include type)) (null print-func)) `(progn (princ ,(format "#S(%s" name) cl-s)))))) (if include - (let ((inc-type (get include 'cl-struct-type)) - (old-descs (get include 'cl-struct-slots))) - (or inc-type (error "%s is not a struct name" include)) - (and type (not (eq (car inc-type) type)) + (let* ((inc-type (cl--struct-class-type include)) + (old-descs (cl-struct-slot-info include))) + (and type (not (eq inc-type type)) (error ":type disagrees with :include for %s" name)) (while include-descs (setcar (memq (or (assq (caar include-descs) old-descs) @@ -2558,9 +2634,9 @@ non-nil value, that slot cannot be set via `setf'. old-descs) (pop include-descs))) (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) - type (car inc-type) - named (assq 'cl-tag-slot descs)) - (if (cadr inc-type) (setq tag name named t))) + 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)) @@ -2605,8 +2681,8 @@ non-nil value, that slot cannot be set via `setf'. (declare (side-effect-free t)) ,@(and pred-check (list `(or ,pred-check - (error "%s accessing a non-%s" - ',accessor ',name)))) + (signal 'wrong-type-argument + (list ',name cl-x))))) ,(if (memq type '(nil vector)) `(aref cl-x ,pos) (if (= pos 0) '(car cl-x) `(nth ,pos cl-x)))) @@ -2682,8 +2758,11 @@ non-nil value, that slot cannot be set via `setf'. `(progn (defvar ,tag-symbol) ,@(nreverse forms) + ;; Call cl-struct-define during compilation as well, so that + ;; a subsequent cl-defstruct in the same file can correctly include this + ;; struct as a parent. (eval-and-compile - (cl-struct-define ',name ,docstring ',include + (cl-struct-define ',name ,docstring ',include-name ',type ,(eq named t) ',descs ',tag-symbol ',tag ',print-auto)) ',name))) @@ -2693,7 +2772,7 @@ non-nil value, that slot cannot be set via `setf'. STRUCT-TYPE is a symbol naming a struct type. Return 'vector or 'list, or nil if STRUCT-TYPE is not a struct type. " (declare (side-effect-free t) (pure t)) - (car (get struct-type 'cl-struct-type))) + (cl--struct-class-type (cl--struct-get-class struct-type))) (defun cl-struct-slot-info (struct-type) "Return a list of slot names of struct STRUCT-TYPE. @@ -2702,7 +2781,19 @@ slot name symbol and OPTS is a list of slot options given to `cl-defstruct'. Dummy slots that represent the struct name and slots skipped by :initial-offset may appear in the list." (declare (side-effect-free t) (pure t)) - (get struct-type 'cl-struct-slots)) + (let* ((class (cl--struct-get-class struct-type)) + (slots (cl--struct-class-slots class)) + (type (cl--struct-class-type class)) + (descs (if type () (list '(cl-tag-slot))))) + (dotimes (i (length slots)) + (let ((slot (aref slots i))) + (push `(,(cl--slot-descriptor-name slot) + ,(cl--slot-descriptor-initform slot) + ,@(if (not (eq (cl--slot-descriptor-type slot) t)) + `(:type ,(cl--slot-descriptor-type slot))) + ,@(cl--slot-descriptor-props slot)) + descs))) + (nreverse descs))) (defun cl-struct-slot-offset (struct-type slot-name) "Return the offset of slot SLOT-NAME in STRUCT-TYPE. @@ -2711,9 +2802,8 @@ the structure data type and is adjusted for any structure name and :initial-offset slots. Signal error if struct STRUCT-TYPE does not contain SLOT-NAME." (declare (side-effect-free t) (pure t)) - (or (cl-position slot-name - (cl-struct-slot-info struct-type) - :key #'car :test #'eq) + (or (gethash slot-name + (cl--class-index-table (cl--struct-get-class struct-type))) (error "struct %s has no slot %s" struct-type slot-name))) (defvar byte-compile-function-environment) @@ -2898,70 +2988,6 @@ macro that returns its `&whole' argument." (if cl-found (setcdr cl-found t))) `(throw ,cl-tag ,cl-value)) -;;;###autoload -(defmacro cl-defsubst (name args &rest body) - "Define NAME as a function. -Like `defun', except the function is automatically declared `inline' and -the arguments are immutable. -ARGLIST allows full Common Lisp conventions, and BODY is implicitly -surrounded by (cl-block NAME ...). -The function's arguments should be treated as immutable. - -\(fn NAME ARGLIST [DOCSTRING] BODY...)" - (declare (debug cl-defun) (indent 2)) - (let* ((argns (cl--arglist-args args)) - (p argns) - ;; (pbody (cons 'progn body)) - ) - (while (and p (eq (cl--expr-contains args (car p)) 1)) (pop p)) - `(progn - ,(if p nil ; give up if defaults refer to earlier args - `(cl-define-compiler-macro ,name - ,(if (memq '&key args) - `(&whole cl-whole &cl-quote ,@args) - (cons '&cl-quote args)) - (cl--defsubst-expand - ',argns '(cl-block ,name ,@body) - ;; We used to pass `simple' as - ;; (not (or unsafe (cl-expr-access-order pbody argns))) - ;; But this is much too simplistic since it - ;; does not pay attention to the argvs (and - ;; cl-expr-access-order itself is also too naive). - nil - ,(and (memq '&key args) 'cl-whole) nil ,@argns))) - (cl-defun ,name ,args ,@body)))) - -(defun cl--defsubst-expand (argns body simple whole _unsafe &rest argvs) - (if (and whole (not (cl--safe-expr-p (cons 'progn argvs)))) whole - (if (cl--simple-exprs-p argvs) (setq simple t)) - (let* ((substs ()) - (lets (delq nil - (cl-mapcar (lambda (argn argv) - (if (or simple (macroexp-const-p argv)) - (progn (push (cons argn argv) substs) - nil) - (list argn argv))) - argns argvs)))) - ;; FIXME: `sublis/subst' will happily substitute the symbol - ;; `argn' in places where it's not used as a reference - ;; to a variable. - ;; FIXME: `sublis/subst' will happily copy `argv' to a different - ;; scope, leading to name capture. - (setq body (cond ((null substs) body) - ((null (cdr substs)) - (cl-subst (cdar substs) (caar substs) body)) - (t (cl--sublis substs body)))) - (if lets `(let ,lets ,body) body)))) - -(defun cl--sublis (alist tree) - "Perform substitutions indicated by ALIST in TREE (non-destructively)." - (let ((x (assq tree alist))) - (cond - (x (cdr x)) - ((consp tree) - (cons (cl--sublis alist (car tree)) (cl--sublis alist (cdr tree)))) - (t tree)))) - ;; Compile-time optimizations for some functions defined in this package. (defun cl--compiler-macro-member (form a list &rest keys) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 401d34b..a18e0e5 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -21,36 +21,22 @@ ;;; Commentary: -;; The expectation is that structs defined with cl-defstruct do not -;; need cl-lib at run-time, but we'd like to hide the details of the -;; cl-struct metadata behind the cl-struct-define function, so we put -;; it in this pre-loaded file. +;; The cl-defstruct macro is full of circularities, since it uses the +;; cl-structure-class type (and its accessors) which is defined with itself, +;; and it setups a default parent (cl-structure-object) which is also defined +;; with cl-defstruct, and to make things more interesting, the class of +;; cl-structure-object is of course an object of type cl-structure-class while +;; cl-structure-class's parent is cl-structure-object. +;; Furthermore, the code generated by cl-defstruct generally assumes that the +;; parent will be loaded when the child is loaded. But at the same time, the +;; expectation is that structs defined with cl-defstruct do not need cl-lib at +;; run-time, which means that the `cl-structure-object' parent can't be in +;; cl-lib but should be preloaded. So here's this preloaded circular setup. ;;; Code: (eval-when-compile (require 'cl-lib)) - -(defun cl-struct-define (name docstring parent type named slots children-sym - tag print-auto) - (cl-assert (or type (equal '(cl-tag-slot) (car slots)))) - (cl-assert (or type (not named))) - (if (boundp children-sym) - (add-to-list children-sym tag) - (set children-sym (list tag))) - (let* ((parent-class parent)) - (while parent-class - (add-to-list (intern (format "cl-struct-%s-tags" parent-class)) tag) - (setq parent-class (get parent-class 'cl-struct-include)))) - ;; If the cl-generic support, we need to be able to check - ;; if a vector is a cl-struct object, without knowing its particular type. - ;; So we use the (otherwise) unused function slots of the tag symbol - ;; to put a special witness value, to make the check easy and reliable. - (unless named (fset tag :quick-object-witness-check)) - (put name 'cl-struct-slots slots) - (put name 'cl-struct-type (list type named)) - (if parent (put name 'cl-struct-include parent)) - (if print-auto (put name 'cl-struct-print print-auto)) - (if docstring (put name 'structure-documentation docstring))) +(eval-when-compile (require 'cl-macs)) ;For cl--struct-class. ;; The `assert' macro from the cl package signals ;; `cl-assertion-failed' at runtime so always define it. @@ -63,6 +49,199 @@ (apply #'error string (append sargs args)) (signal 'cl-assertion-failed `(,form ,@sargs))))) +;; When we load this (compiled) file during pre-loading, the cl--struct-class +;; code below will need to access the `cl-struct' info, since it's considered +;; already as its parent (because `cl-struct' was defined while the file was +;; compiled). So let's temporarily setup a fake. +(defvar cl-struct-cl-structure-object-tags nil) +(unless (cl--find-class 'cl-structure-object) + (setf (cl--find-class 'cl-structure-object) 'dummy)) + +(fset 'cl--make-slot-desc + ;; To break circularity, we pre-define the slot constructor by hand. + ;; It's redefined a bit further down as part of the cl-defstruct of + ;; 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 + name initform type props))) + +(defun cl--struct-get-class (name) + (or (if (not (symbolp name)) name) + (cl--find-class name) + (if (not (get name 'cl-struct-type)) + ;; FIXME: Add a conversion for `eieio--class' so we can + ;; create a cl-defstruct that inherits from an eieio class? + (error "%S is not a struct name" name) + ;; Backward compatibility with a defstruct compiled with a version + ;; cl-defstruct from Emacs<25. Convert to new format. + (let ((tag (intern (format "cl-struct-%s" name))) + (type-and-named (get name 'cl-struct-type)) + (descs (get name 'cl-struct-slots))) + (cl-struct-define name nil (get name 'cl-struct-include) + (unless (and (eq (car type-and-named) 'vector) + (null (cadr type-and-named)) + (assq 'cl-tag-slot descs)) + (car type-and-named)) + (cadr type-and-named) + descs + (intern (format "cl-struct-%s-tags" name)) + tag + (get name 'cl-struct-print)) + (cl--find-class name))))) + +(defun cl--plist-remove (plist member) + (cond + ((null plist) nil) + ((null member) plist) + ((eq plist member) (cddr plist)) + (t `(,(car plist) ,(cadr plist) ,@(cl--plist-remove (cddr plist) member))))) + +(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) + (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. + (setq parent (car (cl--struct-class-parents parent))))) + +;;;###autoload +(defun cl-struct-define (name docstring parent type named slots children-sym + tag print) + (cl-assert (or type (not named))) + (if (boundp children-sym) + (add-to-list children-sym tag) + (set children-sym (list tag))) + (and (null type) (eq (caar slots) 'cl-tag-slot) + ;; Hide the tag slot from "standard" (i.e. non-`type'd) structs. + (setq slots (cdr slots))) + (let* ((parent-class (when parent (cl--struct-get-class parent))) + (n (length slots)) + (index-table (make-hash-table :test 'eq :size n)) + (vslots (let ((v (make-vector n nil)) + (i 0) + (offset (if type 0 1))) + (dolist (slot slots) + (let* ((props (cddr slot)) + (typep (plist-member props :type)) + (type (if typep (cadr typep) t))) + (aset v i (cl--make-slot-desc + (car slot) (nth 1 slot) + type (cl--plist-remove props typep)))) + (puthash (car slot) (+ i offset) index-table) + (cl-incf i)) + v)) + (class (cl--struct-new-class + name docstring + (unless (symbolp parent-class) (list parent-class)) + type named vslots index-table children-sym tag print))) + (unless (symbolp parent-class) + (let ((pslots (cl--struct-class-slots parent-class))) + (or (>= n (length pslots)) + (let ((ok t)) + (dotimes (i (length pslots)) + (unless (eq (cl--slot-descriptor-name (aref pslots i)) + (cl--slot-descriptor-name (aref vslots i))) + (setq ok nil))) + ok) + (error "Included struct %S has changed since compilation of %S" + parent name)))) + (cl--struct-register-child parent-class tag) + (unless (eq named t) + (eval `(defconst ,tag ',class) t) + ;; In the cl-generic support, we need to be able to check + ;; if a vector is a cl-struct object, without knowing its particular type. + ;; So we use the (otherwise) unused function slots of the tag symbol + ;; to put a special witness value, to make the check easy and reliable. + (fset tag :quick-object-witness-check)) + (setf (cl--find-class name) class))) + +(cl-defstruct (cl-structure-class + (:conc-name cl--struct-class-) + (:predicate cl--struct-class-p) + (:constructor nil) + (:constructor cl--struct-new-class + (name docstring parents type named slots index-table + children-sym tag print)) + (:copier nil)) + "The type of CL structs descriptors." + ;; The first few fields here are actually inherited from cl--class, but we + ;; have to define this one before, to break the circularity, so we manually + ;; list the fields here and later "backpatch" cl--class as the parent. + ;; BEWARE: Obviously, it's indispensable to keep these two structs in sync! + (name nil :type symbol) ;The type name. + (docstring nil :type string) + (parents nil :type (list-of cl--class)) ;The included struct. + (slots nil :type (vector cl--slot-descriptor)) + (index-table nil :type hash-table) + (tag nil :type symbol) ;Placed in cl-tag-slot. Holds the struct-class object. + (type nil :type (memq (vector list))) + (named nil :type bool) + (print nil :type bool) + (children-sym nil :type symbol) ;This sym's value holds the tags of children. + ) + +(cl-defstruct (cl-structure-object + (:predicate cl-struct-p) + (:constructor nil) + (:copier nil)) + "The root parent of all \"normal\" CL structs") + +(setq cl--struct-default-parent 'cl-structure-object) + +(cl-defstruct (cl-slot-descriptor + (:conc-name cl--slot-descriptor-) + (:constructor nil) + (:constructor cl--make-slot-descriptor + (name &optional initform type props)) + (:copier cl--copy-slot-descriptor)) + ;; FIXME: This is actually not used yet, for circularity reasons! + "Descriptor of structure slot." + name ;Attribute name (symbol). + initform + type + ;; Extra properties, kept in an alist, can include: + ;; :documentation, :protection, :custom, :label, :group, :printer. + (props nil :type alist)) + +(cl-defstruct (cl--class + (:constructor nil) + (:copier nil)) + "Type of descriptors for any kind of structure-like data." + ;; Intended to be shared between defstruct and defclass. + (name nil :type symbol) ;The type name. + (docstring nil :type string) + (parents nil :type (or cl--class (list-of cl--class))) + (slots nil :type (vector cl-slot-descriptor)) + (index-table nil :type hash-table)) + +(cl-assert + (let ((sc-slots (cl--struct-class-slots (cl--find-class 'cl-structure-class))) + (c-slots (cl--struct-class-slots (cl--find-class 'cl--class))) + (eq t)) + (dotimes (i (length c-slots)) + (let ((sc-slot (aref sc-slots i)) + (c-slot (aref c-slots i))) + (unless (eq (cl--slot-descriptor-name sc-slot) + (cl--slot-descriptor-name c-slot)) + (setq eq nil)))) + eq)) + +;; Close the recursion between cl-structure-object and cl-structure-class. +(setf (cl--struct-class-parents (cl--find-class 'cl-structure-class)) + (list (cl--find-class 'cl--class))) +(cl--struct-register-child + (cl--find-class 'cl--class) + (cl--struct-class-tag (cl--find-class 'cl-structure-class))) + +(cl-assert (cl--find-class 'cl-structure-class)) +(cl-assert (cl--find-class 'cl-structure-object)) +(cl-assert (cl-struct-p (cl--find-class 'cl-structure-class))) +(cl-assert (cl-struct-p (cl--find-class 'cl-structure-object))) +(cl-assert (cl--class-p (cl--find-class 'cl-structure-class))) +(cl-assert (cl--class-p (cl--find-class 'cl-structure-object))) + ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie ;; directly on that function, since those cookies only go to cl-loaddefs. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 8c1440d..8321328 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -106,10 +106,10 @@ This is to optimize `debugger-make-xrefs'.") "Non-nil if we expect to get back in the debugger soon.") (defvar inhibit-debug-on-entry nil - "Non-nil means that debug-on-entry is disabled.") + "Non-nil means that `debug-on-entry' is disabled.") (defvar debugger-jumping-flag nil - "Non-nil means that debug-on-entry is disabled. + "Non-nil means that `debug-on-entry' is disabled. This variable is used by `debugger-jump', `debugger-step-through', and `debugger-reenable' to temporarily disable debug-on-entry.") @@ -165,7 +165,6 @@ first will be printed into the backtrace buffer." ;; Don't let these magic variables affect the debugger itself. (let ((last-command nil) this-command track-mouse (inhibit-trace t) - (inhibit-debug-on-entry t) unread-command-events unread-post-input-method-events last-input-event last-command-event last-nonmenu-event @@ -763,7 +762,8 @@ A call to this function is inserted by `debug-on-entry' to cause functions to break on entry." (if (or inhibit-debug-on-entry debugger-jumping-flag) nil - (funcall debugger 'debug))) + (let ((inhibit-debug-on-entry t)) + (funcall debugger 'debug)))) ;;;###autoload (defun debug-on-entry (function) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 68bf4f6..f0410f8 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -465,6 +465,8 @@ itself or not." (defvar macroexp--pending-eager-loads nil "Stack of files currently undergoing eager macro-expansion.") +(defvar macroexp--debug-eager nil) + (defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. (cond @@ -480,8 +482,10 @@ itself or not." (tail (member elem (cdr (member elem bt))))) (if tail (setcdr tail (list '…))) (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt))) - (message "Warning: Eager macro-expansion skipped due to cycle:\n %s" - (mapconcat #'prin1-to-string (nreverse bt) " => ")) + (if macroexp--debug-eager + (debug 'eager-macroexp-cycle) + (message "Warning: Eager macro-expansion skipped due to cycle:\n %s" + (mapconcat #'prin1-to-string (nreverse bt) " => "))) (push 'skip macroexp--pending-eager-loads) form)) (t diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index c98d725..e5dfed2 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,7 @@ +2015-03-18 Stefan Monnier + + * xlwmenu.c (pop_up_menu): Remove debugging code. + 2015-02-28 Jan Djärv * xlwmenu.c (remap_menubar): Re-realize menu to force move under diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index f781b7e..9317dea 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -1719,7 +1719,7 @@ make_shadow_gcs (XlwMenuWidget mw) 1.2, 0x8000)) #else XQueryColor (dpy, cmap, &topc); - /* don't overflow/wrap! */ + /* Don't overflow/wrap! */ topc.red = MINL (65535, topc.red * 1.2); topc.green = MINL (65535, topc.green * 1.2); topc.blue = MINL (65535, topc.blue * 1.2); @@ -1780,8 +1780,8 @@ make_shadow_gcs (XlwMenuWidget mw) } } - if (!mw->menu.top_shadow_pixmap && - mw->menu.top_shadow_color == mw->core.background_pixel) + if (!mw->menu.top_shadow_pixmap + && mw->menu.top_shadow_color == mw->core.background_pixel) { mw->menu.top_shadow_pixmap = mw->menu.gray_pixmap; if (mw->menu.free_top_shadow_color_p) @@ -1791,8 +1791,8 @@ make_shadow_gcs (XlwMenuWidget mw) } mw->menu.top_shadow_color = mw->menu.foreground; } - if (!mw->menu.bottom_shadow_pixmap && - mw->menu.bottom_shadow_color == mw->core.background_pixel) + if (!mw->menu.bottom_shadow_pixmap + && mw->menu.bottom_shadow_color == mw->core.background_pixel) { mw->menu.bottom_shadow_pixmap = mw->menu.gray_pixmap; if (mw->menu.free_bottom_shadow_color_p) @@ -1856,7 +1856,7 @@ openXftFont (XlwMenuWidget mw) if (fname && strcmp (fname, "none") != 0) { int screen = XScreenNumberOfScreen (mw->core.screen); - int len = strlen (fname), i = len-1; + int len = strlen (fname), i = len - 1; /* Try to convert Gtk-syntax (Sans 9) to Xft syntax Sans-9. */ while (i > 0 && '0' <= fname[i] && fname[i] <= '9') --i; @@ -1880,7 +1880,7 @@ openXftFont (XlwMenuWidget mw) static void XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args) { - /* Get the GCs and the widget size */ + /* Get the GCs and the widget size. */ XlwMenuWidget mw = (XlwMenuWidget) w; Window window = RootWindowOfScreen (DefaultScreenOfDisplay (XtDisplay (mw))); Display* display = XtDisplay (mw); @@ -2014,7 +2014,7 @@ XlwMenuRealize (Widget w, Mask *valueMask, XSetWindowAttributes *attributes) /* Only the toplevel menubar/popup is a widget so it's the only one that receives expose events through Xt. So we repaint all the other panes - when receiving an Expose event. */ + when receiving an Expose event. */ static void XlwMenuRedisplay (Widget w, XEvent *ev, Region region) { @@ -2056,14 +2056,14 @@ XlwMenuDestroy (Widget w) release_drawing_gcs (mw); release_shadow_gcs (mw); - /* this doesn't come from the resource db but is created explicitly - so we must free it ourselves. */ + /* This doesn't come from the resource db but is created explicitly + so we must free it ourselves. */ XFreePixmap (XtDisplay (mw), mw->menu.gray_pixmap); mw->menu.gray_pixmap = (Pixmap) -1; /* Don't free mw->menu.contents because that comes from our creator. The `*_stack' elements are just pointers into `contents' so leave - that alone too. But free the stacks themselves. */ + that alone too. But free the stacks themselves. */ if (mw->menu.old_stack) XtFree ((char *) mw->menu.old_stack); if (mw->menu.new_stack) XtFree ((char *) mw->menu.new_stack); @@ -2093,7 +2093,7 @@ XlwMenuDestroy (Widget w) if (mw->menu.windows [0].pixmap != None) XFreePixmap (XtDisplay (mw), mw->menu.windows [0].pixmap); - /* start from 1 because the one in slot 0 is w->core.window */ + /* Start from 1 because the one in slot 0 is w->core.window. */ for (i = 1; i < mw->menu.windows_length; i++) { if (mw->menu.windows [i].pixmap != None) @@ -2170,7 +2170,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new, XSetWindowBackground (XtDisplay (oldmw), oldmw->menu.windows [i].window, newmw->core.background_pixel); - /* clear windows and generate expose events */ + /* Clear windows and generate expose events. */ XClearArea (XtDisplay (oldmw), oldmw->menu.windows[i].window, 0, 0, 0, 0, True); } @@ -2244,7 +2244,7 @@ handle_single_motion_event (XlwMenuWidget mw, XMotionEvent *ev) set_new_state (mw, val, level); remap_menubar (mw); - /* Sync with the display. Makes it feel better on X terms. */ + /* Sync with the display. Makes it feel better on X terms. */ XSync (XtDisplay (mw), False); } @@ -2256,7 +2256,7 @@ handle_motion_event (XlwMenuWidget mw, XMotionEvent *ev) int state = ev->state; XMotionEvent oldev = *ev; - /* allow motion events to be generated again */ + /* Allow motion events to be generated again. */ if (ev->is_hint && XQueryPointer (XtDisplay (mw), ev->window, &ev->root, &ev->subwindow, @@ -2293,11 +2293,11 @@ Start (Widget w, XEvent *ev, String *params, Cardinal *num_params) releasing the button should always pop the menu down. */ next_release_must_exit = 1; - /* notes the absolute position of the menubar window */ + /* Notes the absolute position of the menubar window. */ mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x; mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y; - /* handles the down like a move, slots are compatible */ + /* Handles the down like a move, slots are compatible. */ ev->xmotion.is_hint = 0; handle_motion_event (mw, &ev->xmotion); } @@ -2327,7 +2327,7 @@ find_first_selectable (XlwMenuWidget mw, widget_value *item, int skip_titles) while (lw_separator_p (current->name, &separator, 0) || !current->enabled || (skip_titles && !current->call_data && !current->contents)) if (current->next) - current=current->next; + current = current->next; else return NULL; @@ -2340,9 +2340,9 @@ find_next_selectable (XlwMenuWidget mw, widget_value *item, int skip_titles) widget_value *current = item; enum menu_separator separator; - while (current->next && (current=current->next) && - (lw_separator_p (current->name, &separator, 0) || !current->enabled - || (skip_titles && !current->call_data && !current->contents))) + while (current->next && (current = current->next) + && (lw_separator_p (current->name, &separator, 0) || !current->enabled + || (skip_titles && !current->call_data && !current->contents))) ; if (current == item) @@ -2357,7 +2357,7 @@ find_next_selectable (XlwMenuWidget mw, widget_value *item, int skip_titles) && !current->contents)) { if (current->next) - current=current->next; + current = current->next; if (current == item) break; @@ -2374,12 +2374,12 @@ find_prev_selectable (XlwMenuWidget mw, widget_value *item, int skip_titles) widget_value *current = item; widget_value *prev = item; - while ((current=find_next_selectable (mw, current, skip_titles)) + while ((current = find_next_selectable (mw, current, skip_titles)) != item) { if (prev == current) break; - prev=current; + prev = current; } return prev; @@ -2560,7 +2560,7 @@ Select (Widget w, XEvent *ev, String *params, Cardinal *num_params) < XtGetMultiClickTime (XtDisplay (w)))) return; - /* pop down everything. */ + /* Pop down everything. */ mw->menu.new_depth = 1; remap_menubar (mw); @@ -2582,7 +2582,7 @@ Select (Widget w, XEvent *ev, String *params, Cardinal *num_params) } - /* Special code to pop-up a menu */ + /* Special code to pop-up a menu. */ static void pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event) { @@ -2619,14 +2619,14 @@ pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event) mw->menu.popped_up = True; if (XtIsShell (XtParent ((Widget)mw))) { - fprintf(stderr, "Config %d %d\n", x, y); + /* fprintf (stderr, "Config %d %d\n", x, y); */ XtConfigureWidget (XtParent ((Widget)mw), x, y, w, h, XtParent ((Widget)mw)->core.border_width); XtPopup (XtParent ((Widget)mw), XtGrabExclusive); display_menu (mw, 0, False, NULL, NULL, NULL); mw->menu.windows [0].x = x + borderwidth; mw->menu.windows [0].y = y + borderwidth; - mw->menu.top_depth = 1; /* Popup menus don't have a bar so top is 1 */ + mw->menu.top_depth = 1; /* Popup menus don't have a bar so top is 1. */ } else { @@ -2634,7 +2634,7 @@ pop_up_menu (XlwMenuWidget mw, XButtonPressedEvent *event) XtAddGrab ((Widget) mw, True, True); - /* notes the absolute position of the menubar window */ + /* Notes the absolute position of the menubar window. */ mw->menu.windows [0].x = ev->xmotion.x_root - ev->xmotion.x; mw->menu.windows [0].y = ev->xmotion.y_root - ev->xmotion.y; mw->menu.top_depth = 2; diff --git a/src/ChangeLog b/src/ChangeLog index fbf8fb4..1b1a9c5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2015-03-18 Stefan Monnier + + * alloc.c (purecopy): Handle hash-tables. + 2015-03-16 Stefan Monnier * minibuf.c (Fread_buffer): Add `predicate' argument. @@ -6,13 +10,11 @@ 2015-03-15 Eli Zaretskii * xdisp.c (handle_invisible_prop): Fix up it->position even when - we are going to load overlays at the beginning of the invisible - text. + we are going to load overlays at the beginning of the invisible text. (setup_for_ellipsis): Reset the ignore_overlay_strings_at_pos_p flag also here. (next_overlay_string): Set the overlay_strings_at_end_processed_p - flag only if the overlays just processed were actually loaded at - EOB. + flag only if the overlays just processed were actually loaded at EOB. 2015-03-14 Daniel Colascione @@ -183,8 +185,8 @@ 2015-02-28 Martin Rudalics - * frame.c (make_initial_frame, Fmake_terminal_frame): Set - can_x_set_window_size and after_make_frame (Bug#19962). + * frame.c (make_initial_frame, Fmake_terminal_frame): + Set can_x_set_window_size and after_make_frame (Bug#19962). 2015-02-28 Eli Zaretskii @@ -454,8 +456,8 @@ * indent.c (Fvertical_motion): Accept an additional argument CUR-COL and use it as the starting screen coordinate. - * window.c (window_scroll_line_based, Fmove_to_window_line): All - callers of vertical-motion changed. + * window.c (window_scroll_line_based, Fmove_to_window_line): + All callers of vertical-motion changed. 2015-02-09 Dima Kogan diff --git a/src/alloc.c b/src/alloc.c index 0227825..1f4b1a4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3423,7 +3423,7 @@ union aligned_Lisp_Misc }; /* Allocation of markers and other objects that share that structure. - Works like allocation of conses. */ + Works like allocation of conses. */ #define MARKER_BLOCK_SIZE \ ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc)) @@ -4744,7 +4744,7 @@ mark_maybe_pointer (void *p) #endif /* Mark Lisp objects referenced from the address range START+OFFSET..END - or END+OFFSET..START. */ + or END+OFFSET..START. */ static void ATTRIBUTE_NO_SANITIZE_ADDRESS mark_memory (void *start, void *end) @@ -5356,7 +5356,6 @@ make_pure_vector (ptrdiff_t len) return new; } - DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. @@ -5391,28 +5390,26 @@ purecopy (Lisp_Object obj) else if (FLOATP (obj)) obj = make_pure_float (XFLOAT_DATA (obj)); else if (STRINGP (obj)) - obj = make_pure_string (SSDATA (obj), SCHARS (obj), - SBYTES (obj), - STRING_MULTIBYTE (obj)); - else if (COMPILEDP (obj) || VECTORP (obj)) { - register struct Lisp_Vector *vec; + if (XSTRING (obj)->intervals) + message ("Dropping text-properties when making string pure"); + obj = make_pure_string (SSDATA (obj), SCHARS (obj), + SBYTES (obj), + STRING_MULTIBYTE (obj)); + } + else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj)) + { + struct Lisp_Vector *objp = XVECTOR (obj); + ptrdiff_t nbytes = vector_nbytes (objp); + struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike); register ptrdiff_t i; - ptrdiff_t size; - - size = ASIZE (obj); + ptrdiff_t size = ASIZE (obj); if (size & PSEUDOVECTOR_FLAG) size &= PSEUDOVECTOR_SIZE_MASK; - vec = XVECTOR (make_pure_vector (size)); + memcpy (vec, objp, nbytes); for (i = 0; i < size; i++) - vec->contents[i] = purecopy (AREF (obj, i)); - if (COMPILEDP (obj)) - { - XSETPVECTYPE (vec, PVEC_COMPILED); - XSETCOMPILED (obj, vec); - } - else - XSETVECTOR (obj, vec); + vec->contents[i] = purecopy (vec->contents[i]); + XSETVECTOR (obj, vec); } else if (SYMBOLP (obj)) { @@ -5422,6 +5419,7 @@ purecopy (Lisp_Object obj) XSYMBOL (obj)->pinned = true; symbol_block_pinned = symbol_block; } + /* Don't hash-cons it. */ return obj; } else @@ -6229,13 +6227,14 @@ mark_discard_killed_buffers (Lisp_Object list) void mark_object (Lisp_Object arg) { - register Lisp_Object obj = arg; + register Lisp_Object obj; void *po; #ifdef GC_CHECK_MARKED_OBJECTS struct mem_node *m; #endif ptrdiff_t cdr_count = 0; + obj = arg; loop: po = XPNTR (obj); @@ -6870,7 +6869,7 @@ sweep_symbols (void) total_free_symbols = num_free; } -NO_INLINE /* For better stack traces */ +NO_INLINE /* For better stack traces. */ static void sweep_misc (void) { commit 14c47d39fabf1f5dbc239f7e0f5a994e36ecc2ff Author: Eli Zaretskii Date: Mon Mar 16 20:01:38 2015 +0200 doc/misc/efaq-w32.texi: Spell-check. diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index 1deeeca..3ef8d15 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -191,7 +191,7 @@ development site. @section How can I compile Emacs myself? @cindex compiling Emacs -To compile Emacs on Windows, you will need the MingW port of GCC and +To compile Emacs on Windows, you will need the MinGW port of GCC and Binutils, the MinGW runtime and development environment, and the MSYS suite of tools. For the details, see the file @file{nt/INSTALL} in the Emacs source distribution. @@ -739,7 +739,7 @@ you ran @command{addpm}, you'll need to delete the Start Menu group too. The registry entries inserted by @command{addpm} will not cause any problems if you leave them there, but for the sake of completeness, you can use @command{regedit} to remove the keys under -@code{HKEY_LOCAL_MACHINE} orx @code{HKEY_CURRENT_USER}: +@code{HKEY_LOCAL_MACHINE} or @code{HKEY_CURRENT_USER}: @code{SOFTWARE\GNU\Emacs}, and the key @code{HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\emacs.exe} if it exists. @@ -1907,7 +1907,7 @@ tools to build your project. Christopher Payne wrote a Visual Studio add-in that makes Emacs the default text editor, this has now been taken over by Jeff Paquette. -See the following two URLS for details: +See the following two URLs for details: @itemize @item @uref{http://sourceforge.net/projects/visemacs/} for the latest version. @item @uref{http://www.smathers.net/VisEmacs.htm} for notes on usage. @@ -2174,7 +2174,7 @@ to port software to Windows. The @uref{https://sourceforge.net/projects/ezwinports/, EZWinPorts project} provides many useful ports of recent versions of GNU and Unix software. This includes all the optional libraries used by Emacs -(image libraries, libxml2, GnuTLS), RCS, Terxinfo, a clone of +(image libraries, libxml2, GnuTLS), RCS, Texinfo, a clone of @command{man} command, Grep, xz, bzip2, bsdtar, ID Utils, Findutils, Hunspell, Gawk, GNU Make, Groff, GDB. commit ac85901854a693061371db5562cb16419a022711 Author: Eli Zaretskii Date: Mon Mar 16 19:46:45 2015 +0200 doc/misc/efaq-w32.texi: Remove outdated information and update. diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index e493793..8bb0947 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,7 @@ +2015-03-16 Eli Zaretskii + + * efaq-w32.texi: Remove outdated information and update. + 2015-03-15 Martin Rudalics * efaq.texi (Fullscreen mode on MS-Windows): Fix description (Bug#20110). diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index 8332ad9..1deeeca 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -128,10 +128,12 @@ systems. @cindex supported versions of Windows Emacs @value{EMACSVER} is known to run on all versions of Windows from -@c FIXME does it really still support Windows 98? Does it matter? -Windows 98 and Windows NT 4.0 through to Windows 7. The Windows port is -built using the Win32 API and supports most features of the X version, -including variable width fonts, images and tooltips. +Windows 98 and Windows NT 4.0 through to Windows 8.1. The Windows +port is built using the Win32 API and supports most features of the X +version, including variable width fonts, images and tooltips. + +Emacs on Windows can be compiled as either a 32-bit or a 64-bit +executable, using the MinGW GCC compiler and development tools. @node Other versions of Emacs @section What other versions of Emacs run on Windows? @@ -163,10 +165,12 @@ instructions (requires DJGPP). @cindex where to get Emacs binaries Pre-compiled versions are distributed from @uref{http://ftpmirror.gnu.org/emacs/windows/, ftp.gnu.org mirrors}. -Emacs binaries are distributed as zip files, digitally -signed by the developer who built them. Generally most users will -want the file @file{emacs-@value{EMACSVER}-bin-i386.zip}, which -contains everything you need to get started. +Emacs binaries are distributed as zip files, digitally signed by the +developer who built them. Generally most users will want the file +@file{emacs-@value{EMACSVER}-bin-i686-pc-mingw.zip} for the 32-bit +build, and @file{emacs-@value{EMACSVER}-bin-x86_64-w64-mingw32.zip} +for the 64-bit build. The zip archive contains everything you need to +get started. @cindex where to get sources @cindex Emacs source code @@ -187,17 +191,18 @@ development site. @section How can I compile Emacs myself? @cindex compiling Emacs -To compile Emacs on Windows, you will need the MingW or Cygwin port of -GCC with MingW make, or a Microsoft C compiler with nmake and the -single threaded C runtime library. Recent versions of Microsoft -Visual Studio no longer come with the single threaded C runtime -library, which is required for certain POSIX compatibility, so MingW -is usually the best choice. Image support requires external -libraries, the headers and import libraries for which will need to be -installed where your compiler can find them. You will also need ports -of GNU @command{rm} and @command{cp}, as the Windows native -equivalents are not consistent between versions. GNU texinfo will be -required to build the manuals. @xref{Other useful ports}. +To compile Emacs on Windows, you will need the MingW port of GCC and +Binutils, the MinGW runtime and development environment, and the MSYS +suite of tools. For the details, see the file @file{nt/INSTALL} in +the Emacs source distribution. + +Support for displaying images, as well as XML/HTML rendering and TLS +networking requires external libraries, the headers and import +libraries for which will need to be installed where your compiler can +find them. Again, the details, including URLs of sites where you can +download these libraries are in @file{nt/INSTALL}. @xref{Other useful +ports}, for auxiliary tools you may wish to install and use in +conjunction with Emacs. After unpacking the source, or checking out of the repository, be sure to read the instructions in @file{nt/README} and @file{nt/INSTALL}. @@ -211,39 +216,25 @@ to read the instructions in @file{nt/README} and @file{nt/INSTALL}. By default, Emacs is compiled with debugging on, and optimizations enabled. The optimizations may interfere with some types of debugging; the debugger may not show clearly where it is, or may not be able to inspect certain -variables. If this is the case, reconfigure with @option{--no-opt}. +variables. If this is the case, reconfigure with @kbd{CFLAGS='-O0 -g3'} The file @file{etc/DEBUG} contains general debugging hints, as well as -specific notes about debugging Emacs with both gdb and Microsoft debuggers. - -@menu -* GDB:: -* Microsoft Developer Studio:: -@end menu +specific notes about debugging Emacs. -@node GDB -@subsection GDB -@cindex GDB, debugging Emacs with @cindex debugging Emacs with GDB - GDB is the GNU debugger, which can be used to debug Emacs when it has -been compiled with GCC. The best results will be obtained if you -start gdb from the @file{src} directory as @samp{gdb oo/i386/emacs.exe}. -This will load the init file @file{.gdbinit} in that directory, to -define some extra commands for working with lisp while debugging, and -set up breakpoints to catch abnormal aborts. - -@node Microsoft Developer Studio -@subsection Microsoft Developer Studio -@cindex MSVC++, debugging Emacs with -@cindex DevStudio, debugging Emacs with -@cindex debugging Emacs with MS DevStudio - -MS DevStudio can be used to debug Emacs when it has been compiled with -a Microsoft compiler. To view lisp variables, you can call the -function @code{debug_print} from the Quickwatch window. Some -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/debug.txt, -old tips} are probably still valid. +been compiled with MinGW GCC. The best results will be obtained if +you start gdb from the @file{src} directory as @kbd{gdb ./emacs.exe}. +This will load the init file @file{.gdbinit}@footnote{ +Latest versions of GDB might refuse to load the init file for security +reasons, unless you customize GDB; alternatively, use an explicit +@kbd{source ./gdbinit} command after entering GDB. +} in that directory, to define some extra commands for working with +lisp while debugging, and set up breakpoints to catch abnormal +aborts. + +A Windows port of GDB can be found on MinGW download sites and on some +others. @c ------------------------------------------------------------ @node Installing Emacs @@ -251,7 +242,7 @@ old tips} are probably still valid. @menu * Unpacking:: -* Installing:: +* Installing binaries:: * Image support:: * Init file:: * Location of init file:: @@ -279,24 +270,27 @@ old tips} are probably still valid. The binary distributions are distributed as zip files, which are handled natively by Windows XP and later. For earlier versions, there are many tools that can handle the zip format, from InfoZip's command line unzip -tool, to 7zip's multi-format graphical archive explorer. Although +tool, to 7zip's multi-format graphical archive explorer. (Although popular, WinZip has caused problems with line-ends in the past, and is not -Free software, so we do not recommend it. +Free software, so we do not recommend it.) -Source distributions are distributed as gzipped tar files. 7zip and -similar multi-format graphical tools can handle these, or you can get -Windows ports of the command line gzip and tar tools from multiple sources. +Source distributions are distributed as @file{.tar.gz} or +@file{.tar.xz} files. 7zip and similar multi-format graphical tools +can handle these, or you can get Windows ports of the command line +gzip and tar tools from multiple sources, or use @command{bsdtar}. @xref{Other useful ports}. The command to unpack a source distribution from the command line is: + @example tar xzf emacs-@value{EMACSVER}.tar.gz @end example If this does not work with the versions of tar and gzip that you have, you may need to try a two step process: + @example -gzip -dc emacs-@value{EMACSVER}.tar.gz | tar xvf - +gzip -dc emacs-@value{EMACSVER}.tar.gz | tar xf - @end example You may see many messages from tar complaining about being unable to change @@ -304,8 +298,21 @@ the modification time on directories, and from gzip complaining about a broken pipe. These messages are usually harmless, caused by incomplete ports that are not fully aware of the limitations of Windows. -@node Installing -@section How do I install Emacs after unpacking? +And here's an example of using @command{bsdtar} (from the +@samp{libarchive} package) to unpack a @file{.tar.xz} archive: + +@example +bsdtar -xf emacs-@value{EMACSVER}.tar.xz +@end example + +Expect @command{bsdtar} to unpack the whole distribution without any +complaints. + +Once you unpack the source distribution, look in @file{nt/INSTALL} +file for build instructions. + +@node Installing binaries +@section How do I install Emacs after unpacking the binary zip? @cindex installing Emacs @pindex addpm @cindex Start Menu, creating icons for Emacs @@ -313,7 +320,8 @@ that are not fully aware of the limitations of Windows. You can run Emacs without any extra steps, but if you want icons in your Start Menu, or for Emacs to detect the image libraries that are already installed on your system as part of GTK, then you should run the program -@file{emacs-@value{EMACSVER}\bin\addpm.exe}. +@file{addpm.exe}, which is usually installed into the same @file{bin} +directory with @file{emacs.exe}. @node Image support @section How do I get image support? @@ -323,6 +331,7 @@ installed on your system as part of GTK, then you should run the program @cindex gif, installing image support in Emacs @cindex tiff, installing image support in Emacs @cindex xpm, installing image support in Emacs +@cindex rsvg, installing image support in Emacs @cindex toolbar, installing color icons in @cindex color images, installing support for images in Emacs @cindex monochrome images, getting color images in Emacs @@ -330,12 +339,12 @@ installed on your system as part of GTK, then you should run the program Emacs has built in support for XBM and PBM/PGM/PPM images. This is sufficient to see the monochrome splash screen and tool-bar icons. -Since 22.2, the official precompiled binaries for Windows have bundled +Since v22.2, the official precompiled binaries for Windows have bundled libXpm, which is required to display the color versions of those images. -Emacs is compiled to recognize JPEG, PNG, GIF and TIFF images also, -but displaying these image types require external DLLs which are not -bundled with Emacs. @xref{Other useful ports}. +Emacs is compiled to recognize JPEG, PNG, GIF, TIFF, and RSVG images +also, but displaying these image types require external DLLs which are +not bundled with Emacs. @xref{Other useful ports}. @node Init file @section What is my init file? @@ -344,11 +353,11 @@ bundled with Emacs. @xref{Other useful ports}. When Emacs starts up, it attempts to load and execute the contents of a file commonly called @file{.emacs} (though it may have other names, -@pxref{Installing Emacs,,Where do I put my init file?}) which contains any -customizations you have made. You can manually add lisp code to your -.emacs, or you can use the Customization interface accessible from the -@emph{Options} menu. If the file does not exist, Emacs will start -with the default settings. +@pxref{Location of init file,,Where do I put my init file?}) which +contains any customizations you have made. You can manually add lisp +code to your .emacs, or you can use the Customization interface +accessible from the @emph{Options} menu. If the file does not exist, +Emacs will start with the default settings. @node Location of init file @section Where do I put my init file? @@ -358,15 +367,15 @@ with the default settings. @cindex init.el @cindex registry, setting the HOME directory in -On Windows, the .emacs file may be called _emacs for backward -compatibility with DOS and FAT filesystems where filenames could not -start with a dot. Some users prefer to continue using such a name, -because Explorer cannot create a file with a name starting with a dot, -even though the filesystem and most other programs can handle it. -In Emacs 22 and later, the init file may also be called -@file{.emacs.d/init.el}. Many of the other files that are created -by lisp packages are now stored in the @file{.emacs.d} directory too, -so this keeps all your Emacs related files in one place. +On Windows, the @file{.emacs} file may be called @file{_emacs} for +backward compatibility with DOS and FAT filesystems where filenames +could not start with a dot. Some users prefer to continue using such +a name due to historical problems various Windows tools had in the +past with file names that begin with a dot. In Emacs 22 and later, +the init file may also be called @file{.emacs.d/init.el}. Many of the +other files that are created by lisp packages are now stored in the +@file{.emacs.d} directory too, so this keeps all your Emacs related +files in one place. All the files mentioned above should go in your @env{HOME} directory. The @env{HOME} directory is determined by following the steps below: @@ -387,14 +396,14 @@ backward compatibility, as previous versions defaulted to @file{C:/} if @env{HOME} was not set. @item Use the user's AppData directory, usually a directory called -@file{Application Data} under the user's profile directory, the location +@file{AppData} under the user's profile directory, the location of which varies according to Windows version and whether the computer is part of a domain. @end enumerate Within Emacs, @key{~} at the beginning of a file name is expanded to your -@env{HOME} directory, so you can always find your .emacs file with -@kbd{C-x C-f ~/.emacs}. +@env{HOME} directory, so you can always find your @file{.emacs} file +by typing the command @kbd{C-x C-f ~/.emacs}. @node Troubleshooting init file @section Troubleshooting init file problems @@ -409,15 +418,16 @@ to. You can do this by evaluating the following expression in the @file{*scratch*} buffer using @kbd{C-x C-e}: @example -(insert (getenv "HOME")) +(getenv "HOME") @end example -Look carefully at what is printed and make sure the value is -valid. For example, if the value has trailing whitespace, Emacs won't -be able to find the directory. Also, be sure that the value isn't a -relative drive letter (e.g., @file{d:} without a backslash); if it is, -then @env{HOME} is going to be whatever the current directory on that -drive is, which is likely not what you want to happen. +Look carefully at what is printed in the echo area, and make sure the +value is valid. For example, if the value has trailing whitespace, +Emacs won't be able to find the directory. Also, be sure that the +value isn't a relative drive letter (e.g., @file{d:} without a +backslash or a forward slash after the colon); if it is, then +@env{HOME} is going to be whatever the current directory on that drive +is, which is likely not what you want to happen. @node Associate files with Emacs @section How do I associate files with Emacs? @@ -488,9 +498,9 @@ Thanks to Jason Rumney and Sigbjorn Finne for these tips. The location of the Desktop varies between different versions of Windows, and in a corporate environment can be moved around by the -network administrator. On NT derivatives, you can use the value of -the @env{USERPROFILE} environment variable to find where the desktop -might be: +network administrator. On latest Windows versions, you can use the +value of the @env{USERPROFILE} environment variable to find where the +desktop might be: @example @kbd{C-x C-f $USERPROFILE/Desktop} @@ -512,7 +522,7 @@ menu by default). Once you have a file from the Desktop inside Emacs, @end menu @node Focus follows mouse -@subsection How do it make the active window follow the mouse? +@subsection How do I make the active window follow the mouse? @vindex focus-follows-mouse @cindex point to focus @cindex mouse over to focus @@ -524,6 +534,11 @@ even though Windows has a click to focus policy by default (there is software available to change that though). The latter can be used to make Emacs use a focus-follow-mouse policy within its own frames. +You can also change the Windows click-to-focus policy by changing +settings in the Registry. The details vary according to your Windows +version; look on the Internet for instructions to enable ``active +window tracking'' for your version of Windows. + @node Swap CapsLock and Control @subsection How do I swap CapsLock and Control? @cindex scan codes, modifying @@ -576,7 +591,7 @@ Date: 04 Dec 1996 14:36:21 -0600 Message-ID: Subject: Re: Re[2]: problem with caps/ctrl swap on NT 4.0 @end ignore -@example +@smallexample It's a binary value that lets you map keystrokes in the low-level keyboard drivers in NT. As a result you don't have to worry about applications bypassing mappings that you've done at a higher level (i.e. it just works). @@ -600,7 +615,7 @@ lock key will behave as caps-lock. To swap, you also need to map 0x3a to This registry value is system wide, and can't be made user-specific. It also only takes affect on reboot. -@end example +@end smallexample @item Ulfar Erlingsson has provided a registry file that sets the CapsLock key to be a Control key and the Windows key to be an Alt key: @@ -663,7 +678,8 @@ buffers etc. will instead act on the region. An inactive mark needs to be reactivated to operate on it, unless @code{mark-even-if-inactive} is set. Secondly, @code{transient-mark-mode} also highlights the region when it is active, providing the same visual clue that you get -in other programs. +in other programs. This mode is turned on by default in latest +versions of Emacs. In addition to seeing the highlighting, new Emacs users often expect editing commands to replace the region when it is active. This behavior @@ -717,14 +733,16 @@ message as documented in Microsoft's API documentation. @cindex delete Emacs directory Emacs does not come with an uninstall program. No files are installed -outside of the Emacs base directory, so deleting that directory is -sufficient to clean away the files. If you ran @command{addpm}, -you'll need to delete the Start Menu group too. The registry entries -inserted by @command{addpm} will not cause any problems if you leave -them there, but for the sake of completeness, you can use @command{regedit} -to remove the keys under @code{HKEY_LOCAL_MACHINE} orx -@code{HKEY_CURRENT_USER}: @code{SOFTWARE\GNU\Emacs}, and the key -@code{HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\emacs.exe} if it exists. +outside of the directories you find in the binary zip archive, so +deleting those directories is sufficient to clean away the files. If +you ran @command{addpm}, you'll need to delete the Start Menu group +too. The registry entries inserted by @command{addpm} will not cause +any problems if you leave them there, but for the sake of +completeness, you can use @command{regedit} to remove the keys under +@code{HKEY_LOCAL_MACHINE} orx @code{HKEY_CURRENT_USER}: +@code{SOFTWARE\GNU\Emacs}, and the key +@code{HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App +Paths\emacs.exe} if it exists. @node Does not run @section When I run Emacs nothing happens @@ -751,9 +769,10 @@ been truncated to CONTRIBU or CONTRI~1, your distribution has been corrupted while unpacking and Emacs will not start. @end enumerate -If it is still not working, send mail to the list, describing what -you've done, and what you are seeing. (The more information you send -the more likely it is that you'll receive a helpful response.. +If it is still not working, send mail to the +@email{help-gnu-emacs@@gnu.org} mailing list, describing what you've +done, and what you are seeing. (The more information you send the more +likely it is that you'll receive a helpful response.) @node Virus @section Does Emacs contain a virus? @@ -880,7 +899,6 @@ The doc string contains a list of the system sounds you can use. * Font names:: * Bold and italic:: * Multilingual fonts:: -* BDF fonts:: * Font menu:: * Line ends:: @end menu @@ -910,9 +928,9 @@ an indication of whether the font is outline (.TTF, .ATM) or raster (.FON) based when fonts are listed, which may let you differentiate between two fonts with the same name and different technologies. -From Emacs 23, the preferred font name format will be moving to the simpler -and more flexible fontconfig format. XLFD names will continue to be -supported for backward compatibility. +Starting with Emacs 23, the preferred font name format will be moving +to the simpler and more flexible fontconfig format. XLFD names will +continue to be supported for backward compatibility. @example XLFD: -*-Courier New-normal-r-*-*-13-*-*-*-c-*-iso8859-1 @@ -959,6 +977,9 @@ and manually set the font for italic, bold and bold-italic as follows: (set-face-font 'bold-italic "-*-Courier New-bold-i-*-*-11-*-*-*-c-*-iso8859-1") @end example +The @code{w32-enable-synthesized-fonts} variable is obsolete starting +from Emacs 24.4, as Emacs no longer has this limitation. + @node Multilingual fonts @section Multilingual font support @cindex multilingual display, fonts @@ -985,11 +1006,8 @@ require the BDF fonts from the GNU intlfonts package. For many languages, native truetype fonts are sufficient, and in Emacs 23 the need for BDF fonts will disappear for almost all languages. At -the time of writing, some Arabic characters in the HELLO file still do -not display with native fonts, because they are pre-composed characters -from MULE character sets rather than standard Unicode Arabic, but all -other characters are able to be displayed with appropriate truetype or -opentype fonts. +the time of writing, all supported characters are able to be displayed +with appropriate truetype or opentype fonts. @node Non-latin display @subsection How do I get Emacs to display non-latin characters? @@ -1025,6 +1043,12 @@ new fontset with @code{create-fontset-from-ascii-font} or chinese-big5-2:-*-MingLiU-normal-r-*-*-12-*-*-*-c-*-big5-*" t) @end example +Alternatively, you can augment the default fontset with information of +which fonts to use for certain ranges of characters or for specific +scripts/character sets. @xref{Modifying Fontsets,, Modifying +Fontsets, emacs, The GNU Emacs Manual}, for details and some useful +examples. + @node International fonts @subsection Where can I find fonts for other languages? @cindex language support, finding fonts @@ -1037,10 +1061,10 @@ new fontset with @code{create-fontset-from-ascii-font} or In addition to the wide range of fonts that come with the language support packages of various components of Windows itself, GNU/Linux distributions these days come with a number of Free truetype fonts -that cover a wide range of languages. The GNU intlfonts source -distribution contains BDF fonts covering all of the languages that can -be displayed by Emacs 22, and can be downloaded from -@uref{http://ftpmirror.gnu.org/intlfonts, ftp.gnu.org mirrors}. +that cover a wide range of languages. The GNU Unifont project +contains glyphs for most of the Unicode codespace, and can be +downloaded from @uref{http://ftpmirror.gnu.org/unifont, ftp.gnu.org +mirrors}. @node Third-party multibyte @subsection How do I use third party programs to display multibyte characters? @@ -1058,12 +1082,6 @@ for that language, but the third party software is intercepting it and using a different font behind the scenes). @xref{Non-latin display}. -In addition to defining a fontset with the expected font, you may also need -to disable unicode output with: -@example -(setq w32-enable-unicode-output nil) -@end example - @node Localized fonts @subsection Can I use a font with a name in my language? @cindex fonts, localized font names @@ -1073,87 +1091,9 @@ Normally Emacs should initialize @code{locale-coding-system} appropriately based on your locale, which will let Emacs use font names in your local language successfully. -@node BDF fonts -@section How do I use bdf fonts with Emacs? -@cindex BDF fonts, using -@cindex GNU intlfonts, using -@cindex intlfonts, using -@vindex w32-bdf-filename-alist -@vindex bdf-directory-alist -@vindex font-encoding-alist -@findex w32-find-bdf-fonts -@findex set-frame-font - -To use bdf fonts with Emacs, you need to tell Emacs where the fonts -are located, create fontsets for them, and then use them. We'll use -the 16 dot international fonts from @uref{http://ftpmirror.gnu.org/intlfonts, -ftp.gnu.org/gnu/intlfonts} as an -example put together by Jason Rumney. - -Download @file{16dots.tar.gz} and unpack it; I'll assume that they are in -@file{c:\intlfonts}. Then set @code{w32-bdf-filename-alist} to the list of -fonts returned by using @code{w32-find-bdf-fonts} to enumerate all of -the font files. It is a good idea to set the variable -@code{bdf-directory-list} at the same time so @code{ps-print} knows where -to find the fonts: -@example -(setq bdf-directory-list - '("c:/intlfonts/Asian" "c:/intlfonts/Chinese" - "c:/intlfonts/Chinese-X" "c:/intlfonts/Ethiopic" - "c:/intlfonts/European" "c:/intlfonts/Japanese" - "c:/intlfonts/Japanese-X" "c:/intlfonts/Korean-X" - "c:/intlfonts/Misc/")) - -(setq w32-bdf-filename-alist (w32-find-bdf-fonts bdf-directory-list)) -@end example - -Then create fontsets for the BDF fonts: - -@example -(create-fontset-from-fontset-spec - "-*-fixed-medium-r-normal-*-16-*-*-*-c-*-fontset-bdf, -japanese-jisx0208:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1983-*, -katakana-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*, -latin-jisx0201:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0201*-*, -japanese-jisx0208-1978:-*-*-medium-r-normal-*-16-*-*-*-c-*-jisx0208.1978-*, -thai-tis620:-misc-fixed-medium-r-normal--16-160-72-72-m-80-tis620.2529-1, -lao:-misc-fixed-medium-r-normal--16-160-72-72-m-80-MuleLao-1, -tibetan-1-column:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-80-MuleTibetan-1, -ethiopic:-Admas-Ethiomx16f-Medium-R-Normal--16-150-100-100-M-160-Ethiopic-Unicode, -tibetan:-TibMdXA-fixed-medium-r-normal--16-160-72-72-m-160-MuleTibetan-0") -@end example - -Many of the international bdf fonts from gnu.org are type 0, and therefore -need to be added to font-encoding-alist: - -@example -;; Need to add some fonts to font-encoding-alist since the bdf fonts -;; are type 0 not the default type 1. -(setq font-encoding-alist - (append '(("MuleTibetan-0" (tibetan . 0)) - ("GB2312" (chinese-gb2312 . 0)) - ("JISX0208" (japanese-jisx0208 . 0)) - ("JISX0212" (japanese-jisx0212 . 0)) - ("VISCII" (vietnamese-viscii-lower . 0)) - ("KSC5601" (korean-ksc5601 . 0)) - ("MuleArabic-0" (arabic-digit . 0)) - ("MuleArabic-1" (arabic-1-column . 0)) - ("MuleArabic-2" (arabic-2-column . 0))) font-encoding-alist)) -@end example - -You can now use the Emacs font menu (@pxref{Fonts and text -translation,,How can I have Emacs use a font menu like on X?}) to -select the @emph{bdf: 16-dot medium} fontset, or you can select it by -setting the default font: - -@example - (set-frame-font "fontset-bdf") -@end example - -Try loading the file @file{etc/HELLO}, and you should be able to see the -various international fonts displayed (except for Hindi, which is not -included in the 16-dot font distribution). - +@c This feature disappeared in Emacs 23, but I'm keeping its +@c description here, since I think it was a mistake to remove it, and +@c resurrecting it doesn't sound too problematic. @node Font menu @section How can I have Emacs use a font menu like on X? @cindex fonts, displaying a menu @@ -1171,6 +1111,8 @@ Place the following in your init file: * Add fonts to menu:: @end menu +@c This variable still exists, but will have no effect until +@c w32-use-w32-font-dialog support is resurrected, see above. @node Add fonts to menu @subsection How can I add my font to the font menu? @cindex font menu, adding fonts @@ -1204,7 +1146,6 @@ this collection of email messages} on the topic. @menu * Automatic line ends:: -* Line ends by filename:: * Line ends by file system:: @end menu @@ -1220,19 +1161,6 @@ file in Unix (LF) mode with the Ctrl-M characters displayed as @samp{^M}. It does this to be safe, as no data loss will occur if the file is really binary and the Ctrl-M characters are significant. -@node Line ends by filename -@subsection CR/LF translation by file extension -@cindex line ends, determining by filename -@cindex binary files, determining by file name -@vindex file-name-buffer-file-type-alist - -The variable @code{file-name-buffer-file-type-alist} holds a list of -filename patterns and their associated type; binary or text. Files marked -as binary will not have line-end detection performed on them, and instead -will always be displayed as is. With auto-detection in recent versions of -Emacs, this is seldom useful for existing files, but can still be used -to influence the choice of line ends for newly created files. - @node Line ends by file system @subsection CR/LF translation by file system @cindex line ends, determining by filesystem @@ -1260,8 +1188,9 @@ MS Windows, but this has still been insufficient to keep up with changes in printing technology from text and postscript based printers connected via ports that can be accessed directly, to graphical printers that are only accessible via USB. For details, see -@uref{http://www.emacswiki.org/cgi-bin/wiki/PrintingFromEmacs, Emacs -Wiki}. +@uref{http://www.emacswiki.org/emacs/PrintingFromEmacs, Emacs +Wiki}, @uref{http://www.emacswiki.org/emacs/PrintWithWebBrowser}, and +@uref{http://www.emacswiki.org/emacs/PrintFromWindowsExplorer}. @c ------------------------------------------------------------ @node Sub-processes @@ -1293,9 +1222,7 @@ Wiki}. The quoting rules for native Windows shells and Cygwin shells have some subtle differences. When Emacs spawns subprocesses, it tries to determine whether the process is a Cygwin program and changes its -quoting mechanism appropriately. See this -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/shell-quoting, -previous discussion} for details. +quoting mechanism appropriately. @node Subprocess hang @section Programs reading input hang @@ -1357,9 +1284,11 @@ you can use @code{setbuf} and @code{setvbuf} to manipulate the buffering semantics. Some programs handle this by having an explicit flag to control their -buffering behavior, typically @option{-i} for interactive. Other -programs manage to detect that they are running under Emacs, by -using @samp{getenv("emacs")} internally. +buffering behavior, typically @option{-i} for interactive, or by a +special environment variable. Other programs manage to detect that +they are running under Emacs, by using @samp{getenv("emacs")} +internally. Look in the program's documentation for the way around +this issue. @menu * Perl script buffering:: @@ -1428,6 +1357,7 @@ this discussion} for more details. @vindex explicit-shell-file-name You can start an interactive shell in Emacs by typing @kbd{M-x shell}. +By default, this will start the standard Windows shell @file{cmd.exe}. Emacs uses the @env{SHELL} environment variable to determine which program to use as the shell. To instruct Emacs to use a non-default shell, you can either set this environment variable, or customize @@ -1467,11 +1397,6 @@ default shell in Emacs, you can place the following in your init file: (add-hook 'shell-mode-hook 'my-shell-setup) @end example -If you find that you are having trouble with Emacs tracking drive -changes with bash, see Mike Fabian's -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/drive-tracking, -note}. - WARNING: Some versions of bash set and use the environment variable PID. For some as yet unknown reason, if @env{PID} is set and Emacs passes it on to bash subshells, bash dies (Emacs can inherit the @@ -1489,7 +1414,7 @@ continue to use bash as your subshell: @cindex cygwin mount points, using within Emacs The package -@uref{http://www.emacswiki.org/cgi-bin/wiki/cygwin-mount.el, +@uref{http://www.emacswiki.org/emacs/cygwin-mount.el, cygwin-mount.el} teaches Emacs about Cygwin mount points. @node Dired ls @@ -1849,11 +1774,15 @@ your type (@code{flyspell}). Both packages depend on a copy of @command{ispell} 3.2 or a compatible spell-checking program. GNU Aspell is a popular choice these days, Windows installers are available from the @uref{http://aspell.net/win32/, official site}. +Another possibility is Hunspell, which is available from +@uref{https://sourceforge.net/projects/ezwinports/files/?source=navbar, +the ezwinports site}. Once installed, you will need to configure @code{ispell-program-name} -to tell ispell and flyspell to use @command{aspell} as a replacement for -ispell. You can include the full path to the @file{aspell} binary, which -means you do not need to add its installation directory to the @env{PATH}. +to tell ispell and flyspell to use @command{aspell} or +@command{hunspell} as a replacement for ispell. You can include the +full path to the @file{aspell}/@file{hunspell} binary, which means you +do not need to add its installation directory to the @env{PATH}. @node Encryption @section Emacs and encryption @@ -1942,6 +1871,13 @@ of grep is to use @samp{findstr /n /r}. @node Developing with Emacs @chapter Developing with Emacs +We recommend using the GNU Compiler Collection for developing C/C++ +code from Emacs. The MinGW development toolchain provides Windows +ports of GCC and other compilers. + +The rest of this chapter describes other alternatives which you may +need to use. + @menu * MSVC:: * Borland C++ Builder:: @@ -2178,6 +2114,7 @@ suggestions} for improving the interaction of perldb and Emacs. @menu * Cygwin:: * MinGW:: +* EZWinPorts:: * UWIN:: * GnuWin32:: * GTK:: @@ -2230,6 +2167,17 @@ filesystem mapping to appear more POSIX like to the scripts that it runs. This is intended to complement the MinGW tools to make it easier to port software to Windows. +@node EZWinPorts +@section EZWinPorts +@cindex ezwinports + +The @uref{https://sourceforge.net/projects/ezwinports/, EZWinPorts +project} provides many useful ports of recent versions of GNU and Unix +software. This includes all the optional libraries used by Emacs +(image libraries, libxml2, GnuTLS), RCS, Terxinfo, a clone of +@command{man} command, Grep, xz, bzip2, bsdtar, ID Utils, Findutils, +Hunspell, Gawk, GNU Make, Groff, GDB. + @node UWIN @section UWIN @cindex uwin environment @@ -2251,8 +2199,8 @@ is @command{ksh}, the Korn shell. @uref{http://gnuwin32.sourceforge.net/} GnuWin32 provides precompiled native Windows ports of a wide selection -of Free software and libraries. Tools available here that are useful -for Emacs include: +of Free software and libraries. Unfortunately, the ports are +outdated. Tools available here that are useful for Emacs include: @itemize @item Arc - used by @code{archive-mode} to edit .arc files. @@ -2302,7 +2250,8 @@ Man pages for Emacs and other ported programs that you have can be read using Emacs' built-in manual reader @code{woman}. This requires no external programs, but if you do have a port of @command{man}, there is also an Emacs wrapper @code{man} that -which may be slightly faster. +which may be slightly faster. A Windows version of @command{man} is +available from the EZWinPorts site (@pxref{EZWinPorts}). @c ------------------------------------------------------------ @node Further information commit c43762dd81886382fe2caa6dc434e189bd5106d2 Author: Martin Rudalics Date: Sun Mar 15 20:17:09 2015 +0100 Fix description of fullscreen mode on MS-Windows (Bug#20110). * efaq.texi (Fullscreen mode on MS-Windows): Fix description (Bug#20110). diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 0e43b9f..e493793 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,8 +1,12 @@ +2015-03-15 Martin Rudalics + + * efaq.texi (Fullscreen mode on MS-Windows): Fix description (Bug#20110). + 2015-02-04 Kelvin White * erc.texi (Advanced Usage, Options): Add descriptions and examples for erc-format-nick-function and erc-rename-buffers options. - (Connecting): fix typo + (Connecting): Fix typo 2014-12-29 Michael Albinus diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 8f6515a..3078122 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2678,8 +2678,16 @@ variable in the environment. @cindex Maximize frame @cindex Fullscreen mode -Use the function @code{w32-send-sys-command}. For example, you can -put the following in your @file{.emacs} file: +Beginning with Emacs 24.4 either run Emacs with the @samp{--maximized} +command-line option or put the following form in your @file{.emacs} +file: + +@lisp +(add-hook 'emacs-startup-hook 'toggle-frame-maximized) +@end lisp + +With older versions use the function @code{w32-send-sys-command}. For +example, you can put the following in your @file{.emacs} file: @lisp (add-hook 'emacs-startup-hook commit ea8cab39be1bab165377237bd30eee15e76d991a Author: Eli Zaretskii Date: Sat Mar 14 19:46:01 2015 +0200 doc/lispref/minibuf.texi (Basic Completion): Fix a typo. (Bug#20108) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index be2bb3e..319386d 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2015-03-14 Eli Zaretskii + + * minibuf.texi (Basic Completion): Fix a typo. (Bug#20108) + 2015-02-07 Eli Zaretskii * processes.texi (Synchronous Processes): Update documentation of diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 14ac893..fa4ee04 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -723,7 +723,7 @@ just one matching completion, and the match is exact, it returns @code{t}. Otherwise, it returns the longest initial sequence common to all possible matching completions. -If @var{collection} is an list, the permissible completions are +If @var{collection} is a list, the permissible completions are specified by the elements of the list, each of which should be either a string, or a cons cell whose @sc{car} is either a string or a symbol (a symbol is converted to a string using @code{symbol-name}). If the commit 2fdec80c2cebf486bc708c5a59b0cd52def5285b Author: Eli Zaretskii Date: Sat Mar 14 19:30:36 2015 +0200 Improve indexing in Emacs manual (Bug#20105) doc/emacs/basic.texi (Moving Point): Improve indexing for HOME and END. doc/emacs/cmdargs.texi (General Variables): Improve indexing for environment variables. doc/emacs/msdog.texi (Windows HOME): doc/emacs/msdog-xtra.texi (MS-DOS File Names): Remove markup from HOME in the index entries. diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 7d8fcf4..b9c16c9 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,14 @@ +2015-03-14 Eli Zaretskii + + * basic.texi (Moving Point): Improve indexing for HOME and END. + + * cmdargs.texi (General Variables): Improve indexing for + environment variables. + + * msdog.texi (Windows HOME): + * msdog-xtra.texi (MS-DOS File Names): Remove markup from HOME in + the index entries. (Bug#20105) + 2015-01-31 Eli Zaretskii * msdog.texi (Windows Files): Document characters invalid in diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 2594608..be45856 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -206,14 +206,14 @@ preserves position within the line, like @kbd{C-n}. @item C-a @itemx @key{Home} @kindex C-a -@kindex HOME +@kindex HOME key @findex move-beginning-of-line Move to the beginning of the line (@code{move-beginning-of-line}). @item C-e @itemx @key{End} @kindex C-e -@kindex END +@kindex END key @findex move-end-of-line Move to the end of the line (@code{move-end-of-line}). diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 42c8e33..071cd68 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -442,22 +442,31 @@ special meanings in Emacs. Most of these variables are also used by some other programs. Emacs does not require any of these environment variables to be set, but it uses their values if they are set. -@vtable @env +@c This used to be @vtable, but that enters the variables alone into +@c the Variable Index, which in some cases, like ``HOME'', might be +@c confused with keys by that name, and other cases, like ``NAME'', +@c might be confused with general-purpose phrases. +@table @env @item CDPATH +@vindex CDPATH, environment variable Used by the @code{cd} command to search for the directory you specify, when you specify a relative directory name. @item DBUS_SESSION_BUS_ADDRESS +@vindex DBUS_SESSION_BUS_ADDRESS, environment variable Used by D-Bus when Emacs is compiled with it. Usually, there is no need to change it. Setting it to a dummy address, like @samp{unix:path=/dev/null}, suppresses connections to the D-Bus session bus as well as autolaunching the D-Bus session bus if not running yet. @item EMACSDATA +@vindex EMACSDATA, environment variable Directory for the architecture-independent files that come with Emacs. This is used to initialize the variable @code{data-directory}. @item EMACSDOC +#vindex EMACSDOC, environment variable Directory for the documentation string file, which is used to initialize the Lisp variable @code{doc-directory}. @item EMACSLOADPATH +#vindex EMACSLOADPATH, environment variable A colon-separated list of directories@footnote{Here and below, whenever we say ``colon-separated list of directories'', it pertains to Unix and GNU/Linux systems. On MS-DOS and MS-Windows, the @@ -471,23 +480,28 @@ the default @code{load-path}. To specify an empty element in the middle of the list, use 2 colons in a row, as in @samp{EMACSLOADPATH="/tmp::/foo"}. @item EMACSPATH +@vindex EMACSPATH, environment variable A colon-separated list of directories to search for executable files. If set, Emacs uses this in addition to @env{PATH} (see below) when initializing the variable @code{exec-path} (@pxref{Shell}). @item EMAIL +@vindex EMAIL, environment variable @vindex user-mail-address@r{, initialization} Your email address; used to initialize the Lisp variable @code{user-mail-address}, which the Emacs mail interface puts into the @samp{From} header of outgoing messages (@pxref{Mail Headers}). @item ESHELL +@vindex ESHELL, environment variable Used for shell-mode to override the @env{SHELL} environment variable (@pxref{Interactive Shell}). @item HISTFILE +@vindex HISTFILE, environment variable The name of the file that shell commands are saved in between logins. This variable defaults to @file{~/.bash_history} if you use Bash, to @file{~/.sh_history} if you use ksh, and to @file{~/.history} otherwise. @item HOME +@vindex HOME, environment variable The location of your files in the directory tree; used for expansion of file names starting with a tilde (@file{~}). On MS-DOS, it defaults to the directory from which Emacs was started, with @@ -499,6 +513,7 @@ where @var{username} is your user name), though for backwards compatibility @file{C:/} will be used instead if a @file{.emacs} file is found there. @item HOSTNAME +@vindex HOSTNAME, environment variable The name of the machine that Emacs is running on. @c complete.el is obsolete since 24.1. @ignore @@ -507,15 +522,24 @@ A colon-separated list of directories. Used by the @code{complete} package to search for files. @end ignore @item INFOPATH +@vindex INFOPATH, environment variable A colon-separated list of directories in which to search for Info files. @item LC_ALL +@vindex LC_ALL, environment variable @itemx LC_COLLATE +@vindex LC_COLLATE, environment variable @itemx LC_CTYPE +@vindex LC_CTYPE, environment variable @itemx LC_MESSAGES +@vindex LC_MESSAGES, environment variable @itemx LC_MONETARY +@vindex LC_MONETARY, environment variable @itemx LC_NUMERIC +@vindex LC_NUMERIC, environment variable @itemx LC_TIME +@vindex LC_TIME, environment variable @itemx LANG +@vindex LANG, environment variable The user's preferred locale. The locale has six categories, specified by the environment variables @env{LC_COLLATE} for sorting, @env{LC_CTYPE} for character encoding, @env{LC_MESSAGES} for system @@ -537,73 +561,92 @@ matched against entries in @code{locale-language-names}, @code{locale-preferred-coding-systems}, to select a default language environment and coding system. @xref{Language Environments}. @item LOGNAME +@vindex LOGNAME, environment variable The user's login name. See also @env{USER}. @item MAIL +@vindex MAIL, environment variable The name of your system mail inbox. @ifnottex @item MH +@vindex MH, environment variable Name of setup file for the mh system. @xref{Top,,MH-E,mh-e, The Emacs Interface to MH}. @end ifnottex @item NAME +@vindex NAME, environment variable Your real-world name. This is used to initialize the variable @code{user-full-name} (@pxref{Mail Headers}). @item NNTPSERVER +@vindex NNTPSERVER, environment variable The name of the news server. Used by the mh and Gnus packages. @item ORGANIZATION +@vindex ORGANIZATION, environment variable The name of the organization to which you belong. Used for setting the `Organization:' header in your posts from the Gnus package. @item PATH +@vindex PATH, environment variable A colon-separated list of directories containing executable files. This is used to initialize the variable @code{exec-path} (@pxref{Shell}). @item PWD +@vindex PWD, environment variable If set, this should be the default directory when Emacs was started. @item REPLYTO +@vindex REPLYTO, environment variable If set, this specifies an initial value for the variable @code{mail-default-reply-to} (@pxref{Mail Headers}). @item SAVEDIR +@vindex SAVEDIR, environment variable The name of a directory in which news articles are saved by default. Used by the Gnus package. @item SHELL +@vindex SHELL, environment variable The name of an interpreter used to parse and execute programs run from inside Emacs. @item SMTPSERVER +@vindex SMTPSERVER, environment variable The name of the outgoing mail server. This is used to initialize the variable @code{smtpmail-smtp-server} (@pxref{Mail Sending}). @cindex background mode, on @command{xterm} @item TERM +@vindex TERM, environment variable The type of the terminal that Emacs is using. This variable must be set unless Emacs is run in batch mode. On MS-DOS, it defaults to @samp{internal}, which specifies a built-in terminal emulation that handles the machine's own display. @item TERMCAP +@vindex TERMCAP, environment variable The name of the termcap library file describing how to program the terminal specified by @env{TERM}. This defaults to @file{/etc/termcap}. @item TMPDIR +@vindex TMPDIR, environment variable @itemx TMP +@vindex TMP, environment variable @itemx TEMP +@vindex TEMP, environment variable These environment variables are used to initialize the variable @code{temporary-file-directory}, which specifies a directory in which to put temporary files (@pxref{Backup}). Emacs tries to use @env{TMPDIR} first. If that is unset, Emacs normally falls back on @file{/tmp}, but on MS-Windows and MS-DOS it instead falls back on @env{TMP}, then @env{TEMP}, and finally @file{c:/temp}. - @item TZ +@vindex TZ, environment variable This specifies the current time zone and possibly also daylight saving time information. On MS-DOS, if @env{TZ} is not set in the environment when Emacs starts, Emacs defines a default value as appropriate for the country code returned by DOS@. On MS-Windows, Emacs does not use @env{TZ} at all. @item USER +@vindex USER, environment variable The user's login name. See also @env{LOGNAME}. On MS-DOS, this defaults to @samp{root}. @item VERSION_CONTROL +@vindex VERSION_CONTROL, environment variable Used to initialize the @code{version-control} variable (@pxref{Backup Names}). -@end vtable +@end table @node Misc Variables @appendixsubsec Miscellaneous Variables diff --git a/doc/emacs/msdog-xtra.texi b/doc/emacs/msdog-xtra.texi index 1033aeb..304039e 100644 --- a/doc/emacs/msdog-xtra.texi +++ b/doc/emacs/msdog-xtra.texi @@ -352,7 +352,7 @@ long file name support, set the environment variable @env{LFN} to DOS programs to access long file names, so Emacs built for MS-DOS will only see their short 8+3 aliases. -@cindex @env{HOME} directory under MS-DOS +@cindex HOME directory under MS-DOS MS-DOS has no notion of home directory, so Emacs on MS-DOS pretends that the directory where it is installed is the value of the @env{HOME} environment variable. That is, if your Emacs binary, diff --git a/doc/emacs/msdog.texi b/doc/emacs/msdog.texi index 0245fed..a17d875 100644 --- a/doc/emacs/msdog.texi +++ b/doc/emacs/msdog.texi @@ -425,7 +425,7 @@ names, which might cause misalignment of columns in Dired display. @node Windows HOME @section HOME and Startup Directories on MS-Windows -@cindex @code{HOME} directory on MS-Windows +@cindex HOME directory on MS-Windows The Windows equivalent of @code{HOME} is the @dfn{user-specific application data directory}. The actual location depends on the commit cc1132158206626d9cab7b98ca68e8ca43dddc8c Author: Glenn Morris Date: Thu Mar 12 08:59:56 2015 -0700 Fix --no-bitmap-icon * src/frame.h (x_set_bitmap_icon): Don't set the icon if icon-type is nil/not present in the parameter alist. Fixes: debbugs:19680 diff --git a/src/ChangeLog b/src/ChangeLog index ca5f85a..90908fc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2015-03-12 Glenn Morris + + * frame.h (x_set_bitmap_icon): Don't set the icon if icon-type is + nil/not present in the parameter alist. (Bug#19680) + 2015-02-28 Eli Zaretskii * search.c (find_newline): Avoid assertion violations in diff --git a/src/frame.h b/src/frame.h index 3d3982f..bc49cfa 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1349,7 +1349,7 @@ x_set_bitmap_icon (struct frame *f) { Lisp_Object obj = assq_no_quit (Qicon_type, f->param_alist); - if (CONSP (obj)) + if (CONSP (obj) && !NILP (XCDR (obj))) x_bitmap_icon (f, XCDR (obj)); }