'(("variable" assistant-variable-reader)
("validate" assistant-sexp-reader)
("result" assistant-list-reader)
- ("next" assistant-list-reader)))
+ ("next" assistant-list-reader)
+ ("text" assistant-text-reader)))
+
+(defface assistant-field-face '((t (:bold t)))
+ "Face used for editable fields."
+ :group 'gnus-article-emphasis)
;;; Internal variables
(defvar assistant-data nil)
(defvar assistant-current-node nil)
+(defvar assistant-previous-node nil)
+(defvar assistant-widgets nil)
(defun assistant-parse-buffer ()
(let (results command value)
results))
(assistant-segment (nreverse results))))
+(defun assistant-text-reader (text)
+ (with-temp-buffer
+ (insert text)
+ (goto-char (point-min))
+ (let ((start (point))
+ (sections nil))
+ (while (re-search-forward "@\\([^{]+\\){\\([^}]+\\)}" nil t)
+ (push (buffer-substring start (match-beginning 0))
+ sections)
+ (push (list (match-string 1) (match-string 2))
+ sections)
+ (setq start (point)))
+ (push (buffer-substring start (point-max))
+ sections)
+ (nreverse sections))))
+
;; Segment the raw assistant data into a list of nodes.
(defun assistant-segment (list)
(let ((ast nil)
(dolist (elem list)
(when (and (equal (car elem) "node")
node)
+ (push (list "save" nil) node)
(push (nreverse node) ast)
(setq node nil))
(push elem node))
(when node
+ (push (list "save" nil) node)
(push (nreverse node) ast))
(cons title (nreverse ast))))
(defun assistant-variable-reader (value)
(let ((section (car (read-from-string (concat "(" value ")")))))
- (append section (list (nth 2 section)))))
+ (append section (list 'default))))
(defun assistant-sexp-reader (value)
(if (zerop (length value))
(defun assistant-get (ast command)
(cadr (assoc command ast)))
+(defun assistant-set (ast command value)
+ (let ((elem (assoc command ast)))
+ (when elem
+ (setcar (cdr elem) value))))
+
(defun assistant-get-list (ast command)
(let ((result nil))
(dolist (elem ast)
(push elem result)))
(nreverse result)))
+;;;###autoload
(defun assistant (file)
"Assist setting up Emacs based on FILE."
(interactive "fAssistant file name: ")
(pop ast))
(car ast)))
-(defun assistant-insert-previous-node (node)
- (insert (format "[ << Go back to %s ] " node)))
+(defun assistant-previous-node-text (node)
+ (format "[ << Go back to %s ] " node))
-(defun assistant-insert-next-node (node)
+(defun assistant-next-node-text (node)
(if node
- (insert (format "[ Proceed to %s >> ]" node))
- (insert "[ Finish ]")))
+ (format "[ Proceed to %s >> ]" node)
+ "[ Finish ]"))
+
+(defun assistant-set-defaults (node)
+ (dolist (variable (assistant-get-list node "variable"))
+ (setq variable (cadr variable))
+ (when (eq (nth 3 variable) 'default)
+ (setcar (nthcdr 3 variable)
+ (eval (nth 2 variable))))))
+
+(defun assistant-get-variable (node variable)
+ (let ((variables (assistant-get-list node "variable"))
+ (result nil))
+ (while (and (setq elem (pop variables))
+ (not result))
+ (setq elem (cadr elem))
+ (when (eq (intern variable) (car elem))
+ (setq result (format "%s" (nth 3 elem)))))
+ result))
+
+(defun assistant-set-variable (node variable value)
+ (let ((variables (assistant-get-list node "variable")))
+ (while (setq elem (pop variables))
+ (setq elem (cadr elem))
+ (when (eq (intern variable) (car elem))
+ (setcar (nthcdr 3 elem) value)))))
+
+(defun assistant-render-text (text node)
+ (dolist (elem text)
+ (if (stringp elem)
+ (insert elem)
+ (push
+ (widget-create
+ 'editable-field
+ :value-face 'assistant-field-face
+ :assistant-variable (cadr elem)
+ (assistant-get-variable node (cadr elem)))
+ assistant-widgets))))
(defun assistant-render-node (node-name)
(let ((node (assistant-find-node node-name)))
+ (set (make-local-variable 'assistant-widgets) nil)
+ (assistant-set-defaults node)
(setq assistant-current-node node-name)
(erase-buffer)
(insert (cadar assistant-data) "\n\n")
(insert node-name "\n\n")
- (insert (assistant-get node "text") "\n\n")
+ (assistant-render-text (assistant-get node "text") node)
+ (insert "\n\n")
(when assistant-previous-node
- (assistant-insert-previous-node assistant-previous-node))
- (assistant-insert-next-node (assistant-find-next-node))
+ (assistant-node-button 'previous assistant-previous-node))
+ (assistant-node-button 'next (assistant-find-next-node))
(insert "\n")))
+(defun assistant-node-button (type node)
+ (let ((text (if (eq type 'next)
+ (assistant-next-node-text node)
+ (assistant-previous-node-text node))))
+ (widget-create
+ 'push-button
+ :assistant-node node
+ :assistant-type type
+ :notify (lambda (widget &rest ignore)
+ (let* ((node (widget-get widget :assistant-node))
+ (type (widget-get widget :assistant-type)))
+ (when (eq type 'next)
+ (assistant-get-widget-values)
+ (assistant-validate))
+ (if (null node)
+ (assistant-finish)
+ (assistant-render-node node))))
+ text)
+ (use-local-map widget-keymap)))
+
+(defun assistant-validate-types (node)
+ (dolist (variable (assistant-get-list node "variable"))
+ (setq variable (cadr variable))
+ (let ((type (nth 1 variable))
+ (value (nth 3 variable)))
+ (when
+ (cond
+ ((eq type :number)
+ (string-match "[^0-9]" value))
+ (t
+ nil))
+ (error "%s is not of type %s: %s"
+ (car variable) type value)))))
+
+(defun assistant-get-widget-values ()
+ (let ((node (assistant-find-node assistant-current-node)))
+ (dolist (widget assistant-widgets)
+ (assistant-set-variable
+ node (widget-get widget :assistant-variable)
+ (widget-value widget)))))
+
+(defun assistant-validate ()
+ (let* ((node (assistant-find-node assistant-current-node))
+ (validation (assistant-get node "validate"))
+ result)
+ (assistant-validate-types node)
+ (when validation
+ (when (setq result (assistant-eval validation node))
+ (unless (y-or-n-p (format "Error: %s. Continue? " result))
+ (error "%s" result))))
+ (assistant-set node "save" t)))
+
(defun assistant-find-next-node ()
- (let* ((node (assistant-find-node node-name))
+ (let* ((node (assistant-find-node assistant-current-node))
(nexts (assistant-get-list node "next"))
- next)
+ next elem)
(while (and (setq elem (pop nexts))
(not next))
(when (assistant-eval (car elem) node)
(defun assistant-eval (form node)
(let ((bindings nil))
(dolist (variable (assistant-get-list node "variable"))
+ (setq variable (cadr variable))
(push (list (car variable) (nth 3 variable))
- bingdings))
+ bindings))
(eval
`(let ,bindings
- ,@form))))
+ ,form))))
+
+(defun assistant-finish ()
+ (let ((results nil)
+ result)
+ (dolist (node (cdr assistant-data))
+ (when (assistant-get node "save")
+ (setq result (assistant-get node "result"))
+ (push (list (car result)
+ (assistant-eval (cadr result) node))
+ results)))
+ (message "Results: %s"
+ (nreverse results))))
(provide 'assistant)
+
+;;; arch-tag: 0404bfa2-9226-4611-8d3f-335c2416175b
+;;; assistant.el ends here