Show
Ignore:
Timestamp:
07/01/06 08:27:06 (2 years ago)
Author:
miyoshi
Message:

Sync up with Emacs CVS HEAD.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/lisp/emacs-lisp/ewoc.el

    r4091 r4098  
    8989;; element.  In that way some kind of tree hierarchy can be created. 
    9090;; 
    91 ;; Full documentation will, God willing, soon be available in a 
    92 ;; Texinfo manual. 
    93  
    94 ;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help 
    95 ;; you find all the exported functions: 
    96 ;; 
    97 ;; (defun ewoc-create (pretty-printer &optional header footer) 
    98 ;; (defalias 'ewoc-data 'ewoc--node-data) 
    99 ;; (defun ewoc-set-data (node data) 
    100 ;; (defun ewoc-location (node) 
    101 ;; (defun ewoc-enter-first (ewoc data) 
    102 ;; (defun ewoc-enter-last (ewoc data) 
    103 ;; (defun ewoc-enter-after (ewoc node data) 
    104 ;; (defun ewoc-enter-before (ewoc node data) 
    105 ;; (defun ewoc-next (ewoc node) 
    106 ;; (defun ewoc-prev (ewoc node) 
    107 ;; (defun ewoc-nth (ewoc n) 
    108 ;; (defun ewoc-map (map-function ewoc &rest args) 
    109 ;; (defun ewoc-filter (ewoc predicate &rest args) 
    110 ;; (defun ewoc-delete (ewoc &rest nodes) 
    111 ;; (defun ewoc-locate (ewoc &optional pos guess) 
    112 ;; (defun ewoc-invalidate (ewoc &rest nodes) 
    113 ;; (defun ewoc-goto-prev (ewoc arg) 
    114 ;; (defun ewoc-goto-next (ewoc arg) 
    115 ;; (defun ewoc-goto-node (ewoc node) 
    116 ;; (defun ewoc-refresh (ewoc) 
    117 ;; (defun ewoc-collect (ewoc predicate &rest args) 
    118 ;; (defun ewoc-buffer (ewoc) 
    119 ;; (defun ewoc-get-hf (ewoc) 
    120 ;; (defun ewoc-set-hf (ewoc header footer) 
     91;; The Emacs Lisp Reference Manual documents ewoc.el's "public interface". 
    12192 
    12293;;     Coding conventions 
    …… 
    12697;; starting with the prefix `ewoc--' are meant for internal use, 
    12798;; while those starting with `ewoc-' are exported for public use. 
    128 ;; There are currently no global or buffer-local variables used. 
    129  
    13099 
    131100;;; Code: 
    132101 
    133 (eval-when-compile (require 'cl))       ;because of CL compiler macros 
    134  
    135 ;; The doubly linked list is implemented as a circular list 
    136 ;; with a dummy node first and last. The dummy node is used as 
    137 ;; "the dll" (or rather the dynamically bound `ewoc--current-dll'). 
    138  
    139 (defvar ewoc--current-dll) 
    140  
     102(eval-when-compile (require 'cl)) 
     103 
     104;; The doubly linked list is implemented as a circular list with a dummy 
     105;; node first and last. The dummy node is used as "the dll". 
    141106(defstruct (ewoc--node 
    142             (:type vector)              ;required for ewoc--node-branch hack 
     107            (:type vector)              ;ewoc--node-nth needs this 
     108            (:constructor nil) 
    143109            (:constructor ewoc--node-create (start-marker data))) 
    144110  left right data start-marker) 
    145111 
    146 (defalias 'ewoc--node-branch 'aref 
    147   "Get the left (CHILD=0) or right (CHILD=1) child of the NODE. 
    148  
    149 \(fn NODE CHILD)") 
    150  
    151 (defun ewoc--node-next (node) 
     112(defun ewoc--node-next (dll node) 
    152113  "Return the node after NODE, or nil if NODE is the last node." 
    153114  (let ((R (ewoc--node-right node))) 
    154     (unless (eq ewoc--current-dll R) R))) 
    155  
    156 (defun ewoc--node-prev (node) 
     115    (unless (eq dll R) R))) 
     116 
     117(defun ewoc--node-prev (dll node) 
    157118  "Return the node before NODE, or nil if NODE is the first node." 
    158119  (let ((L (ewoc--node-left node))) 
    159     (unless (eq ewoc--current-dll L) L))) 
    160  
    161 (defun ewoc--node-nth (n) 
    162   "Return the Nth node from the doubly linked list `ewoc--current-dll'. 
     120    (unless (eq dll L) L))) 
     121 
     122(defun ewoc--node-nth (dll n) 
     123  "Return the Nth node from the doubly linked list `dll'. 
    163124N counts from zero.  If N is negative, return the -(N+1)th last element. 
    164125If N is out of range, return nil. 
    165 Thus, (ewoc--node-nth 0) returns the first node, 
    166 and (ewoc--node-nth -1) returns the last node." 
     126Thus, (ewoc--node-nth dll 0) returns the first node, 
     127and (ewoc--node-nth dll -1) returns the last node." 
     128  ;; Presuming a node is ":type vector", starting with `left' and `right': 
    167129  ;; Branch 0 ("follow left pointer") is used when n is negative. 
    168130  ;; Branch 1 ("follow right pointer") is used otherwise. 
    169131  (let* ((branch (if (< n 0) 0 1)) 
    170          (node   (ewoc--node-branch ewoc--current-dll branch))) 
     132         (node   (aref dll branch))) 
    171133    (if (< n 0) (setq n (- -1 n))) 
    172     (while (and (not (eq ewoc--current-dll node)) (> n 0)) 
    173       (setq node (ewoc--node-branch node branch)) 
     134    (while (and (not (eq dll node)) (> n 0)) 
     135      (setq node (aref node branch)) 
    174136      (setq n (1- n))) 
    175     (unless (eq ewoc--current-dll node) node))) 
     137    (unless (eq dll node) node))) 
    176138 
    177139(defun ewoc-location (node) 
    …… 
    184146(defstruct (ewoc 
    185147            (:constructor nil) 
    186             (:constructor ewoc--create 
    187                           (buffer pretty-printer header footer dll)) 
     148            (:constructor ewoc--create (buffer pretty-printer dll)) 
    188149            (:conc-name ewoc--)) 
    189   buffer pretty-printer header footer dll last-node) 
     150  buffer pretty-printer header footer dll last-node hf-pp) 
    190151 
    191152(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms) 
    192153  "Execute FORMS with ewoc--buffer selected as current buffer, 
    193 `ewoc--current-dll' bound to the dll, and VARLIST bound as in a let*. 
    194 `ewoc--current-dll' will be bound when VARLIST is initialized, but 
     154`dll' bound to the dll, and VARLIST bound as in a let*. 
     155`dll' will be bound when VARLIST is initialized, but 
    195156the current buffer will *not* have been changed. 
    196157Return value of last form in FORMS." 
    197158  (let ((hnd (make-symbol "ewoc"))) 
    198159    `(let* ((,hnd ,ewoc) 
    199             (ewoc--current-dll (ewoc--dll ,hnd)) 
     160            (dll (ewoc--dll ,hnd)) 
    200161            ,@varlist) 
    201162       (with-current-buffer (ewoc--buffer ,hnd) 
    …… 
    212173    node)) 
    213174 
    214 (defun ewoc--adjust (beg end node) 
     175(defun ewoc--adjust (beg end node dll) 
    215176  ;; "Manually reseat" markers for NODE and its successors (including footer 
    216177  ;; and dll), in the case where they originally shared start position with 
    …… 
    223184    (let (m) 
    224185      (while (and (= beg (setq m (ewoc--node-start-marker node))) 
     186                  ;; The "dummy" node `dll' actually holds the marker that 
     187                  ;; points to the end of the footer, so we check `dll' 
     188                  ;; *after* reseating the marker. 
    225189                  (progn 
    226190                    (set-marker m end) 
    227                     (not (eq ewoc--current-dll node)))) 
     191                    (not (eq dll node)))) 
    228192        (setq node (ewoc--node-right node)))))) 
    229193 
    …… 
    233197NODE and leaving the new node's start there.  Return the new node." 
    234198  (save-excursion 
    235     (let* ((inhibit-read-only t) 
    236            (m (copy-marker (ewoc--node-start-marker node))) 
    237            (pos (marker-position m)) 
    238            (elemnode (ewoc--node-create m data))) 
    239       (goto-char pos) 
    240       (funcall pretty-printer data) 
    241       (setf (marker-position m) pos 
    242             (ewoc--node-left  elemnode) (ewoc--node-left node) 
     199    (let ((elemnode (ewoc--node-create 
     200                     (copy-marker (ewoc--node-start-marker node)) data))) 
     201      (setf (ewoc--node-left  elemnode) (ewoc--node-left node) 
    243202            (ewoc--node-right elemnode)                  node 
    244203            (ewoc--node-right (ewoc--node-left node)) elemnode 
    245204            (ewoc--node-left                   node)  elemnode) 
    246       (ewoc--adjust pos (point) node) 
     205      (ewoc--refresh-node pretty-printer elemnode dll) 
    247206      elemnode))) 
    248207 
    249 (defun ewoc--refresh-node (pp node) 
     208(defun ewoc--refresh-node (pp node dll) 
    250209  "Redisplay the element represented by NODE using the pretty-printer PP." 
    251210  (let ((inhibit-read-only t) 
    …… 
    257216    (goto-char m) 
    258217    (funcall pp (ewoc--node-data node)) 
    259     (ewoc--adjust m (point) R))) 
     218    (ewoc--adjust m (point) R dll))) 
     219 
     220(defun ewoc--wrap (func) 
     221  (lexical-let ((ewoc--user-pp func)) 
     222    (lambda (data) 
     223      (funcall ewoc--user-pp data) 
     224      (insert "\n")))) 
     225 
    260226  
    261227;;; =========================================================================== 
    …… 
    263229 
    264230;;;###autoload 
    265 (defun ewoc-create (pretty-printer &optional header footer) 
     231(defun ewoc-create (pretty-printer &optional header footer nosep) 
    266232  "Create an empty ewoc. 
    267233 
    …… 
    276242Optional second and third arguments HEADER and FOOTER are strings, 
    277243possibly empty, that will always be present at the top and bottom, 
    278 respectively, of the ewoc." 
     244respectively, of the ewoc. 
     245 
     246Normally, a newline is automatically inserted after the header, 
     247the footer and every node's printed representation.  Optional 
     248fourth arg NOSEP non-nil inhibits this." 
    279249  (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) 
    280250         (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) 
    281251                     (setf (ewoc--node-left dummy-node) dummy-node) 
    282252                     dummy-node)) 
    283          (new-ewoc 
    284           (ewoc--create (current-buffer) 
    285                         pretty-printer nil nil dll)) 
     253         (wrap (if nosep 'identity 'ewoc--wrap)) 
     254         (new-ewoc (ewoc--create (current-buffer) 
     255                                 (funcall wrap pretty-printer) 
     256                                 dll)) 
     257         (hf-pp (funcall wrap 'insert)) 
    286258         (pos (point)) 
    287259         head foot) 
    …… 
    291263      (unless footer (setq footer "")) 
    292264      (setf (ewoc--node-start-marker dll) (copy-marker pos) 
    293             foot (ewoc--insert-new-node  dll footer 'insert) 
    294             head (ewoc--insert-new-node foot header 'insert) 
     265            foot (ewoc--insert-new-node  dll footer hf-pp) 
     266            head (ewoc--insert-new-node foot header hf-pp) 
     267            (ewoc--hf-pp new-ewoc) hf-pp 
    295268            (ewoc--footer new-ewoc) foot 
    296269            (ewoc--header new-ewoc) head)) 
    …… 
    311284Return the new node." 
    312285  (ewoc--set-buffer-bind-dll ewoc 
    313     (ewoc-enter-after ewoc (ewoc--node-nth 0) data))) 
     286    (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data))) 
    314287 
    315288(defun ewoc-enter-last (ewoc data) 
    …… 
    317290Return the new node." 
    318291  (ewoc--set-buffer-bind-dll ewoc 
    319     (ewoc-enter-before ewoc (ewoc--node-nth -1) data))) 
    320  
     292    (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) 
    321293 
    322294(defun ewoc-enter-after (ewoc node data) 
    …… 
    324296Return the new node." 
    325297  (ewoc--set-buffer-bind-dll ewoc 
    326     (ewoc-enter-before ewoc (ewoc--node-next node) data))) 
     298    (ewoc-enter-before ewoc (ewoc--node-next dll node) data))) 
    327299 
    328300(defun ewoc-enter-before (ewoc node data) 
    …… 
    337309  (when node 
    338310    (ewoc--filter-hf-nodes 
    339      ewoc (let ((ewoc--current-dll (ewoc--dll ewoc))) 
    340             (ewoc--node-next node))))) 
     311     ewoc (ewoc--node-next (ewoc--dll ewoc) node)))) 
    341312 
    342313(defun ewoc-prev (ewoc node) 
    …… 
    345316  (when node 
    346317    (ewoc--filter-hf-nodes 
    347      ewoc (let ((ewoc--current-dll (ewoc--dll ewoc))) 
    348             (ewoc--node-prev node))))) 
    349  
     318     ewoc (ewoc--node-prev (ewoc--dll ewoc) node)))) 
    350319 
    351320(defun ewoc-nth (ewoc n) 
    …… 
    359328  (setq n (if (< n 0) (1- n) (1+ n))) 
    360329  (ewoc--filter-hf-nodes ewoc 
    361                          (let ((ewoc--current-dll (ewoc--dll ewoc))) 
    362                            (ewoc--node-nth n)))) 
     330                         (ewoc--node-nth (ewoc--dll ewoc) n))) 
    363331 
    364332(defun ewoc-map (map-function ewoc &rest args) 
    …… 
    377345      ((footer (ewoc--footer ewoc)) 
    378346       (pp (ewoc--pretty-printer ewoc)) 
    379        (node (ewoc--node-nth 1))) 
     347       (node (ewoc--node-nth dll 1))) 
    380348    (save-excursion 
    381349      (while (not (eq node footer)) 
    382350        (if (apply map-function (ewoc--node-data node) args) 
    383             (ewoc--refresh-node pp node)) 
    384         (setq node (ewoc--node-next node)))))) 
     351            (ewoc--refresh-node pp node dll)) 
     352        (setq node (ewoc--node-next dll node)))))) 
    385353 
    386354(defun ewoc-delete (ewoc &rest nodes) 
    387355  "Delete NODES from EWOC." 
    388356  (ewoc--set-buffer-bind-dll-let* ewoc 
    389       ((L nil) (R nil)) 
     357      ((L nil) (R nil) (last (ewoc--last-node ewoc))) 
    390358    (dolist (node nodes) 
    391359      ;; If we are about to delete the node pointed at by last-node, 
    392360      ;; set last-node to nil. 
    393       (if (eq (ewoc--last-node ewoc) node) 
    394           (setf (ewoc--last-node ewoc) nil)) 
     361      (when (eq last node) 
     362        (setf last nil (ewoc--last-node ewoc) nil)) 
    395363      (delete-region (ewoc--node-start-marker node) 
    396                      (ewoc--node-start-marker (ewoc--node-next node))) 
     364                     (ewoc--node-start-marker (ewoc--node-next dll node))) 
    397365      (set-marker (ewoc--node-start-marker node) nil) 
    398366      (setf L (ewoc--node-left  node) 
    …… 
    413381ARGS are given they will be passed to the PREDICATE." 
    414382  (ewoc--set-buffer-bind-dll-let* ewoc 
    415       ((node (ewoc--node-nth 1)) 
     383      ((node (ewoc--node-nth dll 1)) 
    416384       (footer (ewoc--footer ewoc)) 
    417385       (goodbye nil) 
    …… 
    420388      (unless (apply predicate (ewoc--node-data node) args) 
    421389        (push node goodbye)) 
    422       (setq node (ewoc--node-next node))) 
     390      (setq node (ewoc--node-next dll node))) 
    423391    (apply 'ewoc-delete ewoc goodbye))) 
    424392 
    …… 
    432400If the EWOC is empty, nil is returned." 
    433401  (unless pos (setq pos (point))) 
    434   (ewoc--set-buffer-bind-dll-let* ewoc 
    435       ((footer (ewoc--footer ewoc))) 
     402  (ewoc--set-buffer-bind-dll ewoc 
    436403 
    437404    (cond 
    438405     ;; Nothing present? 
    439      ((eq (ewoc--node-nth 1) (ewoc--node-nth -1)) 
     406     ((eq (ewoc--node-nth dll 1) (ewoc--node-nth dll -1)) 
    440407      nil) 
    441408 
    442409     ;; Before second elem? 
    443      ((< pos (ewoc--node-start-marker (ewoc--node-nth 2))) 
    444       (ewoc--node-nth 1)) 
     410     ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2))) 
     411      (ewoc--node-nth dll 1)) 
    445412 
    446413     ;; After one-before-last elem? 
    447      ((>= pos (ewoc--node-start-marker (ewoc--node-nth -2))) 
    448       (ewoc--node-nth -2)) 
     414     ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2))) 
     415      (ewoc--node-nth dll -2)) 
    449416 
    450417     ;; We now know that pos is within a elem. 
    …… 
    452419      ;; Make an educated guess about which of the three known 
    453420      ;; node'es (the first, the last, or GUESS) is nearest. 
    454       (let* ((best-guess (ewoc--node-nth 1)) 
     421      (let* ((best-guess (ewoc--node-nth dll 1)) 
    455422             (distance (abs (- pos (ewoc--node-start-marker best-guess))))) 
    456423        (when guess 
    …… 
    460427              (setq best-guess guess)))) 
    461428 
    462         (let* ((g (ewoc--node-nth -1))        ;Check the last elem 
     429        (let* ((g (ewoc--node-nth dll -1))    ;Check the last elem 
    463430               (d (abs (- pos (ewoc--node-start-marker g))))) 
    464431          (when (< d distance) 
    …… 
    483450          ;; Loop until we are exactly one node too far down... 
    484451          (while (>= pos (ewoc--node-start-marker best-guess)) 
    485             (setq best-guess (ewoc--node-next best-guess))) 
     452            (setq best-guess (ewoc--node-next dll best-guess))) 
    486453          ;; ...and return the previous node. 
    487           (ewoc--node-prev best-guess)) 
     454          (ewoc--node-prev dll best-guess)) 
    488455 
    489456         ;; Pos is before best-guess 
    490457         (t 
    491458          (while (< pos (ewoc--node-start-marker best-guess)) 
    492             (setq best-guess (ewoc--node-prev best-guess))) 
     459            (setq best-guess (ewoc--node-prev dll best-guess))) 
    493460          best-guess))))))) 
    494461 
    …… 
    500467    (save-excursion 
    501468      (dolist (node nodes) 
    502         (ewoc--refresh-node pp node))))) 
     469        (ewoc--refresh-node pp node dll))))) 
    503470 
    504471(defun ewoc-goto-prev (ewoc arg) 
    …… 
    514481      (while (and node (> arg 0)) 
    515482        (setq arg (1- arg)) 
    516         (setq node (ewoc--node-prev node))) 
     483        (setq node (ewoc--node-prev dll node))) 
    517484      ;; Never step above the first element. 
    518485      (unless (ewoc--filter-hf-nodes ewoc node) 
    519         (setq node (ewoc--node-nth 1))) 
     486        (setq node (ewoc--node-nth dll 1))) 
    520487      (ewoc-goto-node ewoc node)))) 
    521488 
    …… 
    527494    (while (and node (> arg 0)) 
    528495      (setq arg (1- arg)) 
    529       (setq node (ewoc--node-next node))) 
     496      (setq node (ewoc--node-next dll node))) 
    530497    ;; Never step below the first element. 
    531498    ;; (unless (ewoc--filter-hf-nodes ewoc node) 
    532     ;;   (setq node (ewoc--node-nth -2))) 
     499    ;;   (setq node (ewoc--node-nth dll -2))) 
    533500    (ewoc-goto-node ewoc node))) 
    534501 
    …… 
    549516      ((footer (ewoc--footer ewoc))) 
    550517    (let ((inhibit-read-only t)) 
    551       (delete-region (ewoc--node-start-marker (ewoc--node-nth 1)) 
     518      (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1)) 
    552519                     (ewoc--node-start-marker footer)) 
    553520      (goto-char (ewoc--node-start-marker footer)) 
    554521      (let ((pp (ewoc--pretty-printer ewoc)) 
    555             (node (ewoc--node-nth 1))) 
     522            (node (ewoc--node-nth dll 1))) 
    556523        (while (not (eq node footer)) 
    557524          (set-marker (ewoc--node-start-marker node) (point)) 
    558525          (funcall pp (ewoc--node-data node)) 
    559           (setq node (ewoc--node-next node))))) 
     526          (setq node (ewoc--node-next dll node))))) 
    560527    (set-marker (ewoc--node-start-marker footer) (point)))) 
    561528 
    …… 
    574541  (ewoc--set-buffer-bind-dll-let* ewoc 
    575542      ((header (ewoc--header ewoc)) 
    576        (node (ewoc--node-nth -2)) 
     543       (node (ewoc--node-nth dll -2)) 
    577544       result) 
    578545    (while (not (eq node header)) 
    579546      (if (apply predicate (ewoc--node-data node) args) 
    580547          (push (ewoc--node-data node) result)) 
    581       (setq node (ewoc--node-prev node))) 
     548      (setq node (ewoc--node-prev dll node))) 
    582549    (nreverse result))) 
    583550 
    …… 
    597564  (ewoc--set-buffer-bind-dll-let* ewoc 
    598565      ((head (ewoc--header ewoc)) 
    599        (foot (ewoc--footer ewoc))) 
     566       (foot (ewoc--footer ewoc)) 
     567       (hf-pp (ewoc--hf-pp ewoc))) 
    600568    (setf (ewoc--node-data head) header 
    601569          (ewoc--node-data foot) footer) 
    602570    (save-excursion 
    603       (ewoc--refresh-node 'insert head) 
    604       (ewoc--refresh-node 'insert foot)))) 
     571      (ewoc--refresh-node hf-pp head dll) 
     572      (ewoc--refresh-node hf-pp foot dll)))) 
    605573 
    606574  
    607575(provide 'ewoc) 
    608576 
    609 ;;; Local Variables: 
    610 ;;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1) 
    611 ;;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2) 
    612 ;;; End: 
    613  
    614 ;;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4 
     577;; Local Variables: 
     578;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1) 
     579;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2) 
     580;; End: 
     581 
     582;; arch-tag: d78915b9-9a07-44bf-aac6-04a1fc1bd6d4 
    615583;;; ewoc.el ends here