From: "Tom Breton (Tehom)" <tehom@panix.com>
To: "Tom Breton (Tehom)" <tehom@panix.com>
Cc: emacs-devel@gnu.org
Subject: Re: ewoc patch (Was wrong patch, right one attached)
Date: Tue, 8 Dec 2009 23:19:39 -0500 [thread overview]
Message-ID: <ca0bed137418b50b43dee30426311db4.squirrel@mail.panix.com> (raw)
In-Reply-To: <ed316819349eabc924b737854ab2af3b.squirrel@mail.panix.com>
[-- Attachment #1: Type: text/plain, Size: 114 bytes --]
Oops, the diff I attached has an error. The right one is attached to this
message.
Tom Breton (Tehom)
[-- Attachment #2: ewoc.el.4.diff --]
[-- Type: application/octet-stream, Size: 20337 bytes --]
cd /home/tehom/projects/emtest/lisp/viewers/
diff -c -b /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el /home/tehom/projects/emtest/lisp/viewers/ewoc.el
*** /home/tehom/emacs-21.4/lisp/emacs-lisp/ewoc.el 2001-07-16 08:22:59.000000000 -0400
--- /home/tehom/projects/emtest/lisp/viewers/ewoc.el 2009-12-08 23:15:16.000000000 -0500
***************
*** 129,134 ****
--- 129,136 ----
(eval-when-compile (require 'cl)) ;because of CL compiler macros
+ (defconst ewoc-version "2.0")
+
;; The doubly linked list is implemented as a circular list
;; with a dummy node first and last. The dummy node is used as
;; "the dll" (or rather is the dll handle passed around).
***************
*** 197,215 ****
(setq n (1- n)))
(unless (eq dll node) node)))
- (defun ewoc-location (node)
- "Return the start location of NODE."
- (ewoc--node-start-marker node))
-
\f
;;; The ewoc data type
(defstruct (ewoc
(:constructor nil)
(:constructor ewoc--create
! (buffer pretty-printer header footer dll))
(:conc-name ewoc--))
! buffer pretty-printer header footer dll last-node)
(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
"Execute FORMS with ewoc--buffer selected as current buffer,
--- 199,216 ----
(setq n (1- n)))
(unless (eq dll node) node)))
\f
;;; The ewoc data type
(defstruct (ewoc
(:constructor nil)
(:constructor ewoc--create
! (buffer pretty-printer header footer dll
! separator))
(:conc-name ewoc--))
! buffer pretty-printer header footer dll last-node separator)
!
!
(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
"Execute FORMS with ewoc--buffer selected as current buffer,
***************
*** 238,329 ****
(eq node (ewoc--footer ewoc)))
node))
-
- (defun ewoc--create-node (data pretty-printer pos)
- "Call PRETTY-PRINTER with point set at POS in current buffer.
- Remember the start position. Create a wrapper containing that
- start position and the element DATA."
- (save-excursion
- ;; Remember the position as a number so that it doesn't move
- ;; when we insert the string.
- (when (markerp pos) (setq pos (marker-position pos)))
- (goto-char pos)
- (let ((inhibit-read-only t))
- ;; Insert the trailing newline using insert-before-markers
- ;; so that the start position for the next element is updated.
- (insert-before-markers ?\n)
- ;; Move back, and call the pretty-printer.
- (backward-char 1)
- (funcall pretty-printer data)
- (ewoc--node-create (copy-marker pos) data))))
-
-
(defun ewoc--delete-node-internal (ewoc node)
"Delete a data string from EWOC.
Can not be used on the footer. Returns the wrapper that is deleted.
The start-marker in the wrapper is set to nil, so that it doesn't
consume any more resources."
(let ((dll (ewoc--dll ewoc))
(inhibit-read-only t))
! ;; If we are about to delete the node pointed at by last-node,
! ;; set last-node to nil.
(if (eq (ewoc--last-node ewoc) node)
(setf (ewoc--last-node ewoc) nil))
!
! (delete-region (ewoc--node-start-marker node)
! (ewoc--node-start-marker (ewoc--node-next dll node)))
! (set-marker (ewoc--node-start-marker node) nil)
! ;; Delete the node, and return the wrapper.
! (ewoc--node-delete node)))
!
(defun ewoc--refresh-node (pp node)
"Redisplay the element represented by NODE using the pretty-printer PP."
(let ((inhibit-read-only t))
(save-excursion
! ;; First, remove the string from the buffer:
! (delete-region (ewoc--node-start-marker node)
! (1- (marker-position
! (ewoc--node-start-marker (ewoc--node-right node)))))
! ;; Calculate and insert the string.
! (goto-char (ewoc--node-start-marker node))
! (funcall pp (ewoc--node-data node)))))
\f
;;; ===========================================================================
;;; Public members of the Ewoc package
! (defun ewoc-create (pretty-printer &optional header footer)
"Create an empty ewoc.
The ewoc will be inserted in the current buffer at the current position.
PRETTY-PRINTER should be a function that takes one argument, an
element, and inserts a string representing it in the buffer (at
! point). The string PRETTY-PRINTER inserts may be empty or span
! several linse. A trailing newline will always be inserted
! automatically. The PRETTY-PRINTER should use insert, and not
! insert-before-markers.
! Optional third argument HEADER is a string that will always be
present at the top of the ewoc. HEADER should end with a
! newline. Optionaly fourth argument FOOTER is similar, and will
! be inserted at the bottom of the ewoc."
! (let ((new-ewoc
! (ewoc--create (current-buffer)
! pretty-printer nil nil (ewoc--dll-create)))
(pos (point)))
(ewoc--set-buffer-bind-dll new-ewoc
;; Set default values
(unless header (setq header ""))
(unless footer (setq footer ""))
(setf (ewoc--node-start-marker dll) (copy-marker pos))
! (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos))
! (head (ewoc--create-node header (lambda (x) (insert header)) pos)))
! (ewoc--node-enter-first dll head)
! (ewoc--node-enter-last dll foot)
(setf (ewoc--header new-ewoc) head)
(setf (ewoc--footer new-ewoc) foot)))
;; Return the ewoc
new-ewoc))
--- 239,430 ----
(eq node (ewoc--footer ewoc)))
node))
(defun ewoc--delete-node-internal (ewoc node)
"Delete a data string from EWOC.
Can not be used on the footer. Returns the wrapper that is deleted.
The start-marker in the wrapper is set to nil, so that it doesn't
consume any more resources."
+ (when (ewoc--node-start-marker node)
(let ((dll (ewoc--dll ewoc))
(inhibit-read-only t))
! ;; If we are about to delete the node pointed at by
! ;; last-node, set last-node to nil.
(if (eq (ewoc--last-node ewoc) node)
(setf (ewoc--last-node ewoc) nil))
! (ewoc--delete-node-text node)
! ;; Delete the node from the dll and return the wrapper.
! (ewoc--node-delete node))))
(defun ewoc--refresh-node (pp node)
"Redisplay the element represented by NODE using the pretty-printer PP."
+ (assert node)
(let ((inhibit-read-only t))
(save-excursion
! (goto-char (ewoc-location-safe node))
! (ewoc--delete-node-text node)
! (ewoc--print-anew node pp))))
!
! \f
! ;;; ===========================================================================
! ;;; Node location
!
! (defun ewoc--raw-location (node)
! "Return the start location of NODE.
! If NODE is empty, return nil."
! (ewoc--node-start-marker node))
!
! (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)))
!
! (defun ewoc--next-start-marker (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.
! If NODE is empty, return the start marker of the next non-empty node."
! (or
! (ewoc--raw-location 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.
! (defun ewoc-location-safe (node)
! "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))
!
! \f
! ;;; ===========================================================================
! ;;; Printing and unprinting
!
! (defun ewoc--mark-node-empty (node)
! "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))))
!
! (defun ewoc--delete-node-text (node)
! "Delete a node's text."
! (when
! (ewoc--node-start-marker node)
! (delete-region
! (ewoc--node-start-marker node)
! (ewoc--next-start-marker node))
! (ewoc--mark-node-empty node)))
!
! (defun ewoc--print-anew (node pp)
! "Print a node that was erased."
! (ewoc--mark-node-empty node)
! (ewoc--print-node node pp))
!
!
! (defun ewoc--print-node (node 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)))))
!
\f
;;; ===========================================================================
;;; Public members of the Ewoc package
! (defun ewoc-create (pretty-printer &optional header footer separator)
!
"Create an empty ewoc.
The ewoc will be inserted in the current buffer at the current position.
PRETTY-PRINTER should be a function that takes one argument, an
element, and inserts a string representing it in the buffer (at
! point). The string PRETTY-PRINTER inserts may be empty or span several
! linse. SEPARATOR will be inserted automatically. The PRETTY-PRINTER
! should use insert, and not insert-before-markers.
! Optional second argument HEADER is a string that will always be
present at the top of the ewoc. HEADER should end with a
! newline. Optional third argument FOOTER is similar, and will
! be inserted at the bottom of the ewoc.
!
! Optional fourth argument SEPARATOR is a string. It will be inserted
! after each entry and after header and footer. It defaults to one
! newline."
!
! (let* (
! (separator
! (cond
! ((null separator) "\n")
! ((stringp separator)
! (if (string= separator "") nil separator))
! (t (error "ewoc-create: separator %s is not a string"
! separator))))
! (new-ewoc
! (ewoc--create
! (current-buffer)
! pretty-printer
! nil nil (ewoc--dll-create)
! separator))
(pos (point)))
(ewoc--set-buffer-bind-dll new-ewoc
;; Set default values
(unless header (setq header ""))
(unless footer (setq footer ""))
(setf (ewoc--node-start-marker dll) (copy-marker pos))
!
! (let*
! ((foot
! (ewoc-enter-before
! new-ewoc dll footer #'insert))
!
! (head
! (ewoc-enter-before
! new-ewoc foot header #'insert)))
!
(setf (ewoc--header new-ewoc) head)
(setf (ewoc--footer new-ewoc) foot)))
+
;; Return the ewoc
new-ewoc))
***************
*** 346,361 ****
(ewoc--set-buffer-bind-dll ewoc
(ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
! (defun ewoc-enter-before (ewoc node data)
! "Enter a new element DATA before NODE in EWOC.
Returns the new NODE."
(ewoc--set-buffer-bind-dll ewoc
! (ewoc--node-enter-before
! node
! (ewoc--create-node
! data
! (ewoc--pretty-printer ewoc)
! (ewoc--node-start-marker node)))))
(defun ewoc-next (ewoc node)
"Get the next node.
--- 447,469 ----
(ewoc--set-buffer-bind-dll ewoc
(ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
! (defun ewoc-enter-before (ewoc node data &optional printer)
! "Create a new element DATA before NODE in EWOC.
Returns the new NODE."
(ewoc--set-buffer-bind-dll ewoc
! (let
! ((new-node
! (ewoc--node-create
! nil
! data)))
! (ewoc--node-enter-before node new-node)
! ;;Print the node only after it has been inserted.
! (save-excursion
! (goto-char (ewoc-location-safe node))
! (ewoc--print-node
! new-node
! (or printer (ewoc--pretty-printer ewoc))))
! new-node)))
(defun ewoc-next (ewoc node)
"Get the next node.
***************
*** 404,409 ****
--- 512,518 ----
(if (apply map-function (ewoc--node-data node) args)
(ewoc--refresh-node (ewoc--pretty-printer ewoc) node))
(setq node (ewoc--node-next dll node)))))
+ (defalias 'ewoc-foreach 'ewoc-map)
(defun ewoc-filter (ewoc predicate &rest args)
"Remove all elements in EWOC for which PREDICATE returns nil.
***************
*** 440,450 ****
nil)
;; Before second elem?
! ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2)))
(ewoc--node-nth dll 1))
;; After one-before-last elem?
! ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2)))
(ewoc--node-nth dll -2))
;; We now know that pos is within a elem.
--- 549,559 ----
nil)
;; Before second elem?
! ((< 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)))
(ewoc--node-nth dll -2))
;; We now know that pos is within a elem.
***************
*** 452,473 ****
;; Make an educated guess about which of the three known
;; node'es (the first, the last, or GUESS) is nearest.
(let* ((best-guess (ewoc--node-nth dll 1))
! (distance (abs (- pos (ewoc--node-start-marker best-guess)))))
(when guess
! (let ((d (abs (- pos (ewoc--node-start-marker guess)))))
(when (< d distance)
(setq distance d)
(setq best-guess guess))))
(let* ((g (ewoc--node-nth dll -1)) ;Check the last elem
! (d (abs (- pos (ewoc--node-start-marker g)))))
(when (< d distance)
(setq distance d)
(setq best-guess g)))
(when (ewoc--last-node ewoc) ;Check "previous".
(let* ((g (ewoc--last-node ewoc))
! (d (abs (- pos (ewoc--node-start-marker g)))))
(when (< d distance)
(setq distance d)
(setq best-guess g))))
--- 561,582 ----
;; Make an educated guess about which of the three known
;; node'es (the first, the last, or GUESS) is nearest.
(let* ((best-guess (ewoc--node-nth dll 1))
! (distance (abs (- pos (ewoc-location best-guess)))))
(when guess
! (let ((d (abs (- pos (ewoc-location guess)))))
(when (< d distance)
(setq distance d)
(setq best-guess guess))))
(let* ((g (ewoc--node-nth dll -1)) ;Check the last elem
! (d (abs (- pos (ewoc-location g)))))
(when (< d distance)
(setq distance d)
(setq best-guess g)))
(when (ewoc--last-node ewoc) ;Check "previous".
(let* ((g (ewoc--last-node ewoc))
! (d (abs (- pos (ewoc-location g)))))
(when (< d distance)
(setq distance d)
(setq best-guess g))))
***************
*** 479,494 ****
(cond
;; Is pos after the guess?
((>= pos
! (ewoc--node-start-marker best-guess))
;; Loop until we are exactly one node too far down...
! (while (>= pos (ewoc--node-start-marker 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--node-start-marker best-guess))
(setq best-guess (ewoc--node-prev dll best-guess)))
best-guess)))))))
--- 588,603 ----
(cond
;; Is pos after the guess?
((>= pos
! (ewoc-location best-guess))
;; Loop until we are exactly one node too far down...
! (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))
(setq best-guess (ewoc--node-prev dll best-guess)))
best-guess)))))))
***************
*** 507,513 ****
((node (ewoc-locate ewoc (point))))
(when node
;; If we were past the last element, first jump to it.
! (when (>= (point) (ewoc--node-start-marker (ewoc--node-right node)))
(setq arg (1- arg)))
(while (and node (> arg 0))
(setq arg (1- arg))
--- 616,622 ----
((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)))
(setq arg (1- arg)))
(while (and node (> arg 0))
(setq arg (1- arg))
***************
*** 533,539 ****
(defun ewoc-goto-node (ewoc node)
"Move point to NODE."
(ewoc--set-buffer-bind-dll ewoc
! (goto-char (ewoc--node-start-marker node))
(if goal-column (move-to-column goal-column))
(setf (ewoc--last-node ewoc) node)))
--- 642,648 ----
(defun ewoc-goto-node (ewoc node)
"Move point to NODE."
(ewoc--set-buffer-bind-dll ewoc
! (goto-char (ewoc-location node))
(if goal-column (move-to-column goal-column))
(setf (ewoc--last-node ewoc) node)))
***************
*** 545,562 ****
number of elements needs to be refreshed."
(ewoc--set-buffer-bind-dll-let* ewoc
((footer (ewoc--footer ewoc)))
! (let ((inhibit-read-only t))
! (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
! (ewoc--node-start-marker footer))
! (goto-char (ewoc--node-start-marker footer))
! (let ((node (ewoc--node-nth dll 1)))
(while (not (eq node footer))
! (set-marker (ewoc--node-start-marker node) (point))
! (funcall (ewoc--pretty-printer ewoc)
! (ewoc--node-data node))
! (insert "\n")
(setq node (ewoc--node-next dll node)))))
! (set-marker (ewoc--node-start-marker footer) (point))))
(defun ewoc-collect (ewoc predicate &rest args)
"Select elements from EWOC using PREDICATE.
--- 654,674 ----
number of elements needs to be refreshed."
(ewoc--set-buffer-bind-dll-let* ewoc
((footer (ewoc--footer ewoc)))
! (let ((inhibit-read-only t)
! (first-node (ewoc--node-nth dll 1)))
! (delete-region
! (ewoc-location first-node)
! (ewoc-location footer))
! (goto-char (ewoc-location footer))
! (let ((node first-node)
! (pp (ewoc--pretty-printer ewoc)))
(while (not (eq node footer))
! (ewoc--print-anew node pp)
(setq node (ewoc--node-next dll node)))))
!
! ;;Finally, set the last marker. It is not neccessarily
! ;;footer's own marker because footer may be blank.
! (set-marker (ewoc-location footer) (point))))
(defun ewoc-collect (ewoc predicate &rest args)
"Select elements from EWOC using PREDICATE.
***************
*** 595,602 ****
"Set the HEADER and FOOTER of EWOC."
(setf (ewoc--node-data (ewoc--header ewoc)) header)
(setf (ewoc--node-data (ewoc--footer ewoc)) footer)
! (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc))
! (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc)))
\f
(provide 'ewoc)
--- 707,714 ----
"Set the HEADER and FOOTER of EWOC."
(setf (ewoc--node-data (ewoc--header ewoc)) header)
(setf (ewoc--node-data (ewoc--footer ewoc)) footer)
! (ewoc--refresh-node #'insert (ewoc--header ewoc))
! (ewoc--refresh-node #'insert (ewoc--footer ewoc)))
\f
(provide 'ewoc)
Diff finished at Tue Dec 8 23:15:42
next prev parent reply other threads:[~2009-12-09 4:19 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2009-12-09 4:03 ewoc patch Tom Breton (Tehom)
2009-12-09 4:19 ` Tom Breton (Tehom) [this message]
2009-12-09 4:40 ` Stefan Monnier
2009-12-09 20:57 ` Tom Breton (Tehom)
2009-12-09 21:25 ` Stefan Monnier
2009-12-10 4:52 ` Tom Breton (Tehom)
2009-12-10 7:28 ` Stefan Monnier
2009-12-11 1:23 ` Tom Breton (Tehom)
2009-12-11 5:09 ` Stefan Monnier
2010-08-21 10:52 ` Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=ca0bed137418b50b43dee30426311db4.squirrel@mail.panix.com \
--to=tehom@panix.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).