--- eieio-custom.el.orig 2015-04-30 05:34:45.000000000 +0200 +++ eieio-custom.el 2015-05-02 09:53:03.000000000 +0200 @@ -193,8 +193,13 @@ (let* ((chil nil) (obj (widget-get widget :value)) (master-group (widget-get widget :eieio-group)) - (cv (eieio--object-class obj)) - (slots (eieio--class-slots cv))) + ;; + ;; Not needed here if we implement loop with `mapc' + ;; instead of `dotimes'. PLN Sat May 2 09:31:18 2015 + ;; + ;; (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 @@ -221,59 +226,80 @@ (setq groups (cdr groups))) (widget-insert "\n\n"))) ;; Loop over all the slots, creating child widgets. - (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)) - )))) + ;; + ;; Alternative implementation. + ;; + ;; (dotimes (i (length slots)) + ;; (let* ((slot (aref slots i)) + (mapc + (lambda (slot) + (let* ((sym (eieio-slot-descriptor-name slot)) + (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 sym)) + ;; + ;; 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) + sym + ) + sym + )))) + (capitalize + (if (string-match "^:" s) + (substring s (match-end 0)) + s))))) + :value (slot-value obj sym) + :doc (or (alist-get :documentation props) + "Slot not Documented.") + :eieio-custom-visibility 'visible + ) + chil)) + )))) + (eieio--class-slots (eieio--object-class obj))) + ;; + ;; End Modified implementation. + ;; (widget-put widget :children (nreverse chil)) )) @@ -287,27 +313,77 @@ nil)) (chil (if (widget-get widget :eieio-show-name) (nthcdr 1 wids) wids)) - (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 (< 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)))))) + ) + ;; + ;; Not clear that impomentation is more efficient. In fact + ;; if customizable slots are concentrated at the beginning + ;; of the slot list, previous loop will break earlier due + ;; to chil becoming nul. Mor over if there are much more + ;; slots than customizable slots, mapc will run over many + ;; unuseful slots. PLN Sat May 2 08:10:23 2015 + ;; + ;; Alternative loop implementation + (mapc (lambda (slot) + (when chil + ;; + ;; If there are no more children there is no need + ;; to do anything.. + ;; + (let* ((sym + ;; Is it better to use + ;; `eieio-slot-descriptor-name' here or + ;; `cl--slot-descriptor-name' ? + ;; + (eieio-slot-descriptor-name slot)) + (props (cl--slot-descriptor-props slot)) + (cust (alist-get :custom props)) + ) + (when (and cust + (or eieio-custom-ignore-eieio-co + (not master-group) + (member master-group (alist-get :group props))) + (slot-boundp obj sym)) + ;; + ;; Only customized slots have widgets + ;; + (let ((eieio-custom-ignore-eieio-co t)) + (eieio-oset obj sym + (car (widget-apply (car chil) + :value-inline)))) + (setq chil (cdr chil))) + ))) + (eieio--class-slots (eieio--object-class obj))) + ;; End Alternative loop implementation + ;; + ;; + ;; (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 (< i (length slots)) chil) + ;; (let* ((slot (aref slots i)) + ;; (props (cl--slot-descriptor-props slot)) + ;; (cust (alist-get :custom props))) + ;; ;; + ;; ;; Shouldn't i be incremented unconditionnaly ? Or + ;; ;; better shouldn't we simply mapc on the slots vector + ;; ;; avoiding use of this integer variable ? PLN Sat May + ;; ;; 2 07:35:45 2015 + ;; ;; + ;; (setq i (+ i 1)) + ;; (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.