--- lisp/emacs-lisp/ewoc.el 2010-08-21 12:39:33.000000000 +0200 +++ ../trunk/lisp/emacs-lisp/ewoc.el 2010-08-21 12:49:41.000000000 +0200 @@ -139,7 +139,8 @@ (defstruct (ewoc (:constructor nil) - (:constructor ewoc--create (buffer pretty-printer dll separator)) + (:constructor ewoc--create (buffer pretty-printer dll + &optional separator)) (:conc-name ewoc--)) buffer pretty-printer header footer dll last-node hf-pp separator) @@ -167,12 +168,12 @@ node)) (defun ewoc--link-node-before (new-node node) - "Physically insert NEW-NODE before NODE." - (setf - (ewoc--node-left new-node) (ewoc--node-left node) - (ewoc--node-right new-node) node - (ewoc--node-right (ewoc--node-left node)) new-node - (ewoc--node-left node) new-node)) + "Physically insert NEW-NODE before NODE." + (setf + (ewoc--node-left new-node) (ewoc--node-left node) + (ewoc--node-right new-node) node + (ewoc--node-right (ewoc--node-left node)) new-node + (ewoc--node-left node) new-node)) (defun ewoc--insert-new-node (ewoc node data pretty-printer) "Insert before NODE a new node for DATA, displayed by PRETTY-PRINTER. @@ -181,112 +182,99 @@ NODE and leaving the new node's start there. Return the new node." (save-excursion (let ((elemnode (ewoc--node-create nil data))) - (ewoc--link-node-before elemnode node) - (goto-char (ewoc-location-safe node)) - (ewoc--print-node ewoc elemnode pretty-printer) + (ewoc--link-node-before elemnode node) + (goto-char (ewoc-location-safe node)) + (ewoc--print-node ewoc elemnode pretty-printer) elemnode))) (defun ewoc--refresh-node (pp node ewoc) "Redisplay the element represented by NODE using the pretty-printer PP." - (save-excursion - (goto-char (ewoc-location-safe node)) - (ewoc--delete-node-text node) - (ewoc--print-anew ewoc node pp))) + (save-excursion + (goto-char (ewoc-location-safe node)) + (ewoc--delete-node-text node) + (ewoc--print-anew ewoc node pp))) ;;; =========================================================================== ;;; Node location (defun ewoc--next-printed-node (node) - "Return the next non-empty node after NODE." - ;;This loop will terminate because we set at least one - ;;start-marker in the ewoc when creating it. - (do - ((node-after - (ewoc--node-right node) - (ewoc--node-right node-after))) - ( - (ewoc--node-start-marker node-after) - node-after))) - + "Return the next non-empty node after NODE." + ;; This loop will terminate because we set at least one + ;; start-marker in the ewoc when creating it. + (do ((node-after + (ewoc--node-right node) + (ewoc--node-right node-after))) + ((ewoc--node-start-marker node-after) + node-after))) + (defun ewoc--next-start-marker (node) - "Return the first start marker after NODE." - (ewoc--node-start-marker - (ewoc--next-printed-node node))) + "Return the first start marker after NODE." + (ewoc--node-start-marker + (ewoc--next-printed-node node))) (defun ewoc-location (node) - "Return the start location of NODE. + "Return the start location of NODE. If NODE is empty, return the start marker of the next non-empty node." - (or - (ewoc--node-start-marker node) + (or (ewoc--node-start-marker node) (ewoc--next-start-marker node))) -;;A start-marker's insertion-type should already be `t', but some -;;callers want to be 100% sure it is, so this function exists. +;; A start-marker's insertion-type should already be `t', but some +;; callers want to be 100% sure it is, so this function exists. (defun ewoc-location-safe (node) - "Get NODE's start location. + "Get NODE's start location. Also set the start-marker's insertion type to `t' so that it will stay after any text inserted at that point." - - (let - ((next-start-marker (ewoc-location node))) - (set-marker-insertion-type next-start-marker t) - next-start-marker)) + (let ((next-start-marker (ewoc-location node))) + (set-marker-insertion-type next-start-marker t) + next-start-marker)) ;;; =========================================================================== ;;; Printing and unprinting (defun ewoc--mark-node-empty (node) - "Mark NODE empty (but don't empty it, assume it was emptied) + "Mark NODE empty (but don't empty it, assume it was emptied) INTERNAL USE ONLY." - (let - ((start-marker (ewoc--node-start-marker node))) - (when start-marker - (set-marker start-marker nil) - (setf (ewoc--node-start-marker node) nil)))) + (let ((start-marker (ewoc--node-start-marker node))) + (when start-marker + (set-marker start-marker nil) + (setf (ewoc--node-start-marker node) nil)))) (defun ewoc--delete-node-text (node) - "Delete a node's text and mark it empty." - (let - ((inhibit-read-only t) - (m (ewoc--node-start-marker node))) - (when m - (delete-region m (ewoc--next-start-marker node)) - (ewoc--mark-node-empty node)))) + "Delete a node's text and mark it empty." + (let ((inhibit-read-only t) + (m (ewoc--node-start-marker node))) + (when m + (delete-region m (ewoc--next-start-marker node)) + (ewoc--mark-node-empty node)))) (defun ewoc--print-anew (ewoc node pp) - "Print a node that was erased but not marked empty." - (ewoc--mark-node-empty node) - (ewoc--print-node ewoc node pp)) + "Print a node that was erased but not marked empty." + (ewoc--mark-node-empty node) + (ewoc--print-node ewoc node pp)) + - (defun ewoc--print-node (ewoc node printer) - "Print NODE at point using PRINTER. + "Print NODE at point using PRINTER. Set NODE's start-marker accordingly." - ;;Only print if node is currently empty - (when (ewoc--node-start-marker node) - (error "ewoc--print-node called with a node that's already printed")) - - (let - ( - (start-pos (point)) - (inhibit-read-only t)) - - (funcall printer (ewoc-data node)) - (let - ((separator (ewoc--separator ewoc))) - (when separator (insert separator))) - - ;;Only set up this node as non-empty if it actually is - ;;non-empty. - (unless - (= start-pos (point)) - ;;Set its start-marker to the position we started - ;;printing from. - (setf - (ewoc--node-start-marker node) - (copy-marker start-pos t))))) + ;; Only print if node is currently empty. + (when (ewoc--node-start-marker node) + (error "ewoc--print-node called with a node that's already printed")) + + (let ((start-pos (point)) + (inhibit-read-only t)) + + (funcall printer (ewoc-data node)) + (let ((separator (ewoc--separator ewoc))) + (when separator (insert separator))) + + ;; Only set up this node as non-empty if it actually is non-empty. + (unless (= start-pos (point)) + ;; Set its start-marker to the position we started printing from. + (setf + (ewoc--node-start-marker node) + (copy-marker start-pos t))))) ;;; =========================================================================== @@ -316,12 +304,12 @@ (setf (ewoc--node-left dummy-node) dummy-node) dummy-node)) (separator - (cond - ((null separator) "\n") - ((stringp separator) - (if (string= separator "") nil separator)) - ;;Non-nil, non-string argument means empty separator - (t nil))) + (cond + ((null separator) "\n") + ((stringp separator) + (if (string= separator "") nil separator)) + ;;Non-nil, non-string argument means empty separator + (t nil))) (new-ewoc (ewoc--create (current-buffer) pretty-printer dll @@ -426,15 +414,15 @@ (defalias 'ewoc-foreach 'ewoc-map) (defmacro ewoc-do (spec &rest body) - "Evaluate BODY repeatedly, with NAME bound successively to the data + "Evaluate BODY repeatedly, with NAME bound successively to the data of each element. The element will be refreshed if BODY returns non-nil." - (destructuring-bind (name ewoc-form) spec - `(progn - (ewoc-foreach - #'(lambda (,name) - ,@body) - ,ewoc-form)))) + (destructuring-bind (name ewoc-form) spec + `(progn + (ewoc-foreach + #'(lambda (,name) + ,@body) + ,ewoc-form)))) (defun ewoc-delete (ewoc &rest nodes) @@ -490,11 +478,11 @@ nil) ;; Before second elem? - ((< pos (ewoc-location (ewoc--node-nth dll 2))) + ((< pos (ewoc-location (ewoc--node-nth dll 2))) (ewoc--node-nth dll 1)) ;; After one-before-last elem? - ((>= pos (ewoc-location (ewoc--node-nth dll -2))) + ((>= pos (ewoc-location (ewoc--node-nth dll -2))) (ewoc--node-nth dll -2)) ;; We now know that pos is within a elem. @@ -529,16 +517,16 @@ (cond ;; Is pos after the guess? ((>= pos - (ewoc-location best-guess)) + (ewoc-location best-guess)) ;; Loop until we are exactly one node too far down... - (while (>= pos (ewoc-location best-guess)) + (while (>= pos (ewoc-location best-guess)) (setq best-guess (ewoc--node-next dll best-guess))) ;; ...and return the previous node. (ewoc--node-prev dll best-guess)) ;; Pos is before best-guess (t - (while (< pos (ewoc-location best-guess)) + (while (< pos (ewoc-location best-guess)) (setq best-guess (ewoc--node-prev dll best-guess))) best-guess))))))) @@ -559,7 +547,7 @@ ((node (ewoc-locate ewoc (point)))) (when node ;; If we were past the last element, first jump to it. - (when (>= (point) (ewoc-location (ewoc--node-right node))) + (when (>= (point) (ewoc-location (ewoc--node-right node))) (setq arg (1- arg))) (while (and node (> arg 0)) (setq arg (1- arg)) @@ -585,7 +573,7 @@ (defun ewoc-goto-node (ewoc node) "Move point to NODE in EWOC." (ewoc--set-buffer-bind-dll ewoc - (goto-char (ewoc-location node)) + (goto-char (ewoc-location node)) (if goal-column (move-to-column goal-column)) (setf (ewoc--last-node ewoc) node))) @@ -598,14 +586,14 @@ (ewoc--set-buffer-bind-dll-let* ewoc ((footer (ewoc--footer ewoc))) (let ((inhibit-read-only t) - (first-node (ewoc--node-nth dll 1))) + (first-node (ewoc--node-nth dll 1))) (delete-region (ewoc-location first-node) (ewoc-location footer)) (goto-char (ewoc-location footer)) (let ((pp (ewoc--pretty-printer ewoc)) (node first-node)) (while (not (eq node footer)) - (ewoc--print-anew ewoc node pp) + (ewoc--print-anew ewoc node pp) (setq node (ewoc--node-next dll node))))) (set-marker (ewoc-location footer) (point)))) @@ -655,8 +643,7 @@ (ewoc--refresh-node hf-pp foot ewoc)))) -(defconst ewoc-provides-variable-separator t) -(provide 'ewoc) +(provide 'ewoc '(separator)) ;; Local Variables: ;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1)