Show
Ignore:
Timestamp:
05/27/06 10:35:24 (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

    r4085 r4091  
    9797;; (defun ewoc-create (pretty-printer &optional header footer) 
    9898;; (defalias 'ewoc-data 'ewoc--node-data) 
     99;; (defun ewoc-set-data (node data) 
    99100;; (defun ewoc-location (node) 
    100101;; (defun ewoc-enter-first (ewoc data) 
    …… 
    107108;; (defun ewoc-map (map-function ewoc &rest args) 
    108109;; (defun ewoc-filter (ewoc predicate &rest args) 
     110;; (defun ewoc-delete (ewoc &rest nodes) 
    109111;; (defun ewoc-locate (ewoc &optional pos guess) 
    110112;; (defun ewoc-invalidate (ewoc &rest nodes) 
    …… 
    133135;; The doubly linked list is implemented as a circular list 
    134136;; with a dummy node first and last. The dummy node is used as 
    135 ;; "the dll" (or rather is the dll handle passed around). 
     137;; "the dll" (or rather the dynamically bound `ewoc--current-dll'). 
     138 
     139(defvar ewoc--current-dll) 
    136140 
    137141(defstruct (ewoc--node 
    …… 
    145149\(fn NODE CHILD)") 
    146150 
    147 (defun ewoc--node-next (dll node) 
     151(defun ewoc--node-next (node) 
    148152  "Return the node after NODE, or nil if NODE is the last node." 
    149   (unless (eq (ewoc--node-right node) dll) (ewoc--node-right node))) 
    150  
    151 (defun ewoc--node-prev (dll node) 
     153  (let ((R (ewoc--node-right node))) 
     154    (unless (eq ewoc--current-dll R) R))) 
     155 
     156(defun ewoc--node-prev (node) 
    152157  "Return the node before NODE, or nil if NODE is the first node." 
    153   (unless (eq (ewoc--node-left node) dll) (ewoc--node-left node))) 
    154  
    155 (defun ewoc--node-nth (dll n) 
    156   "Return the Nth node from the doubly linked list DLL. 
    157 N counts from zero. If DLL is not that long, nil is returned. 
    158 If N is negative, return the -(N+1)th last element. 
    159 Thus, (ewoc--node-nth dll 0) returns the first node, 
    160 and (ewoc--node-nth dll -1) returns the last node." 
     158  (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'. 
     163N counts from zero.  If N is negative, return the -(N+1)th last element. 
     164If N is out of range, return nil. 
     165Thus, (ewoc--node-nth 0) returns the first node, 
     166and (ewoc--node-nth -1) returns the last node." 
    161167  ;; Branch 0 ("follow left pointer") is used when n is negative. 
    162168  ;; Branch 1 ("follow right pointer") is used otherwise. 
    163169  (let* ((branch (if (< n 0) 0 1)) 
    164          (node   (ewoc--node-branch dll branch))) 
     170         (node   (ewoc--node-branch ewoc--current-dll branch))) 
    165171    (if (< n 0) (setq n (- -1 n))) 
    166     (while (and (not (eq dll node)) (> n 0)) 
     172    (while (and (not (eq ewoc--current-dll node)) (> n 0)) 
    167173      (setq node (ewoc--node-branch node branch)) 
    168174      (setq n (1- n))) 
    169     (unless (eq dll node) node))) 
     175    (unless (eq ewoc--current-dll node) node))) 
    170176 
    171177(defun ewoc-location (node) 
    …… 
    185191(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms) 
    186192  "Execute FORMS with ewoc--buffer selected as current buffer, 
    187 dll bound to ewoc--dll, and VARLIST bound as in a let*. 
    188 dll will be bound when VARLIST is initialized, but the current 
    189 buffer will *not* have been changed. 
     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 
     195the current buffer will *not* have been changed. 
    190196Return value of last form in FORMS." 
    191197  (let ((hnd (make-symbol "ewoc"))) 
    192198    `(let* ((,hnd ,ewoc) 
    193             (dll (ewoc--dll ,hnd)) 
     199            (ewoc--current-dll (ewoc--dll ,hnd)) 
    194200            ,@varlist) 
    195201       (with-current-buffer (ewoc--buffer ,hnd) 
    …… 
    205211              (eq node (ewoc--footer ewoc))) 
    206212    node)) 
     213 
     214(defun ewoc--adjust (beg end node) 
     215  ;; "Manually reseat" markers for NODE and its successors (including footer 
     216  ;; and dll), in the case where they originally shared start position with 
     217  ;; BEG, to END.  BEG and END are buffer positions describing NODE's left 
     218  ;; neighbor.  This operation is functionally equivalent to temporarily 
     219  ;; setting these nodes' markers' insertion type to t around the pretty-print 
     220  ;; call that precedes the call to `ewoc--adjust', and then changing them back 
     221  ;; to nil. 
     222  (when (< beg end) 
     223    (let (m) 
     224      (while (and (= beg (setq m (ewoc--node-start-marker node))) 
     225                  (progn 
     226                    (set-marker m end) 
     227                    (not (eq ewoc--current-dll node)))) 
     228        (setq node (ewoc--node-right node)))))) 
    207229 
    208230(defun ewoc--insert-new-node (node data pretty-printer) 
    …… 
    216238           (elemnode (ewoc--node-create m data))) 
    217239      (goto-char pos) 
    218       ;; Insert the trailing newline using insert-before-markers 
    219       ;; so that the start position for the next element is updated. 
    220       (insert-before-markers ?\n) 
    221       ;; Move back, and call the pretty-printer. 
    222       (backward-char 1) 
    223240      (funcall pretty-printer data) 
    224241      (setf (marker-position m) pos 
    …… 
    227244            (ewoc--node-right (ewoc--node-left node)) elemnode 
    228245            (ewoc--node-left                   node)  elemnode) 
     246      (ewoc--adjust pos (point) node) 
    229247      elemnode))) 
    230248 
    231249(defun ewoc--refresh-node (pp node) 
    232250  "Redisplay the element represented by NODE using the pretty-printer PP." 
    233   (let ((inhibit-read-only t)) 
     251  (let ((inhibit-read-only t) 
     252        (m (ewoc--node-start-marker node)) 
     253        (R (ewoc--node-right node))) 
    234254    ;; First, remove the string from the buffer: 
    235     (delete-region (ewoc--node-start-marker node) 
    236                    (1- (marker-position 
    237                         (ewoc--node-start-marker (ewoc--node-right node))))) 
     255    (delete-region m (ewoc--node-start-marker R)) 
    238256    ;; Calculate and insert the string. 
    239     (goto-char (ewoc--node-start-marker node)) 
    240     (funcall pp (ewoc--node-data node)))) 
     257    (goto-char m) 
     258    (funcall pp (ewoc--node-data node)) 
     259    (ewoc--adjust m (point) R))) 
    241260  
    242261;;; =========================================================================== 
    243262;;;                  Public members of the Ewoc package 
    244263 
    245  
     264;;;###autoload 
    246265(defun ewoc-create (pretty-printer &optional header footer) 
    247266  "Create an empty ewoc. 
    …… 
    252271element, and inserts a string representing it in the buffer (at 
    253272point).  The string PRETTY-PRINTER inserts may be empty or span 
    254 several lines.  A trailing newline will always be inserted 
    255 automatically.  The PRETTY-PRINTER should use `insert', and not 
     273several lines.  The PRETTY-PRINTER should use `insert', and not 
    256274`insert-before-markers'. 
    257275 
    258 Optional second argument HEADER is a string that will always be 
    259 present at the top of the ewoc.  HEADER should end with a 
    260 newline.  Optional third argument FOOTER is similar, and will 
    261 be inserted at the bottom of the ewoc." 
     276Optional second and third arguments HEADER and FOOTER are strings, 
     277possibly empty, that will always be present at the top and bottom, 
     278respectively, of the ewoc." 
    262279  (let* ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)) 
    263280         (dll (progn (setf (ewoc--node-right dummy-node) dummy-node) 
    …… 
    286303\(fn NODE)") 
    287304 
     305(defun ewoc-set-data (node data) 
     306  "Set NODE to encapsulate DATA." 
     307  (setf (ewoc--node-data node) data)) 
     308 
    288309(defun ewoc-enter-first (ewoc data) 
    289310  "Enter DATA first in EWOC. 
    290311Return the new node." 
    291312  (ewoc--set-buffer-bind-dll ewoc 
    292     (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data))) 
     313    (ewoc-enter-after ewoc (ewoc--node-nth 0) data))) 
    293314 
    294315(defun ewoc-enter-last (ewoc data) 
    …… 
    296317Return the new node." 
    297318  (ewoc--set-buffer-bind-dll ewoc 
    298     (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) 
     319    (ewoc-enter-before ewoc (ewoc--node-nth -1) data))) 
    299320 
    300321 
    …… 
    303324Return the new node." 
    304325  (ewoc--set-buffer-bind-dll ewoc 
    305     (ewoc-enter-before ewoc (ewoc--node-next dll node) data))) 
     326    (ewoc-enter-before ewoc (ewoc--node-next node) data))) 
    306327 
    307328(defun ewoc-enter-before (ewoc node data) 
    …… 
    316337  (when node 
    317338    (ewoc--filter-hf-nodes 
    318      ewoc (ewoc--node-next (ewoc--dll ewoc) node)))) 
     339     ewoc (let ((ewoc--current-dll (ewoc--dll ewoc))) 
     340            (ewoc--node-next node))))) 
    319341 
    320342(defun ewoc-prev (ewoc node) 
    …… 
    323345  (when node 
    324346    (ewoc--filter-hf-nodes 
    325      ewoc 
    326      (ewoc--node-prev (ewoc--dll ewoc) node)))) 
     347     ewoc (let ((ewoc--current-dll (ewoc--dll ewoc))) 
     348            (ewoc--node-prev node))))) 
    327349 
    328350 
    …… 
    331353N counts from zero.  Return nil if there is less than N elements. 
    332354If N is negative, return the -(N+1)th last element. 
    333 Thus, (ewoc-nth dll 0) returns the first node, 
    334 and (ewoc-nth dll -1) returns the last node. 
     355Thus, (ewoc-nth ewoc 0) returns the first node, 
     356and (ewoc-nth ewoc -1) returns the last node. 
    335357Use `ewoc-data' to extract the data from the node." 
    336358  ;; Skip the header (or footer, if n is negative). 
    337359  (setq n (if (< n 0) (1- n) (1+ n))) 
    338360  (ewoc--filter-hf-nodes ewoc 
    339                   (ewoc--node-nth (ewoc--dll ewoc) n))) 
     361                         (let ((ewoc--current-dll (ewoc--dll ewoc))) 
     362                           (ewoc--node-nth n)))) 
    340363 
    341364(defun ewoc-map (map-function ewoc &rest args) 
    …… 
    354377      ((footer (ewoc--footer ewoc)) 
    355378       (pp (ewoc--pretty-printer ewoc)) 
    356        (node (ewoc--node-nth dll 1))) 
     379       (node (ewoc--node-nth 1))) 
    357380    (save-excursion 
    358381      (while (not (eq node footer)) 
    359382        (if (apply map-function (ewoc--node-data node) args) 
    360383            (ewoc--refresh-node pp node)) 
    361         (setq node (ewoc--node-next dll node)))))) 
     384        (setq node (ewoc--node-next node)))))) 
     385 
     386(defun ewoc-delete (ewoc &rest nodes) 
     387  "Delete NODES from EWOC." 
     388  (ewoc--set-buffer-bind-dll-let* ewoc 
     389      ((L nil) (R nil)) 
     390    (dolist (node nodes) 
     391      ;; If we are about to delete the node pointed at by last-node, 
     392      ;; set last-node to nil. 
     393      (if (eq (ewoc--last-node ewoc) node) 
     394          (setf (ewoc--last-node ewoc) nil)) 
     395      (delete-region (ewoc--node-start-marker node) 
     396                     (ewoc--node-start-marker (ewoc--node-next node))) 
     397      (set-marker (ewoc--node-start-marker node) nil) 
     398      (setf L (ewoc--node-left  node) 
     399            R (ewoc--node-right node) 
     400            ;; Link neighbors to each other. 
     401            (ewoc--node-right L) R 
     402            (ewoc--node-left  R) L 
     403            ;; Forget neighbors. 
     404            (ewoc--node-left  node) nil 
     405            (ewoc--node-right node) nil)))) 
    362406 
    363407(defun ewoc-filter (ewoc predicate &rest args) 
    …… 
    369413ARGS are given they will be passed to the PREDICATE." 
    370414  (ewoc--set-buffer-bind-dll-let* ewoc 
    371       ((node (ewoc--node-nth dll 1)) 
     415      ((node (ewoc--node-nth 1)) 
    372416       (footer (ewoc--footer ewoc)) 
    373        (next nil) 
    374        (L nil) (R nil) 
     417       (goodbye nil) 
    375418       (inhibit-read-only t)) 
    376419    (while (not (eq node footer)) 
    377       (setq next (ewoc--node-next dll node)) 
    378420      (unless (apply predicate (ewoc--node-data node) args) 
    379         ;; If we are about to delete the node pointed at by last-node, 
    380         ;; set last-node to nil. 
    381         (if (eq (ewoc--last-node ewoc) node) 
    382             (setf (ewoc--last-node ewoc) nil)) 
    383         (delete-region (ewoc--node-start-marker node) 
    384                        (ewoc--node-start-marker (ewoc--node-next dll node))) 
    385         (set-marker (ewoc--node-start-marker node) nil) 
    386         (setf L (ewoc--node-left  node) 
    387               R (ewoc--node-right node) 
    388               ;; Link neighbors to each other. 
    389               (ewoc--node-right L) R 
    390               (ewoc--node-left  R) L 
    391               ;; Forget neighbors. 
    392               (ewoc--node-left  node) nil 
    393               (ewoc--node-right node) nil)) 
    394       (setq node next)))) 
     421        (push node goodbye)) 
     422      (setq node (ewoc--node-next node))) 
     423    (apply 'ewoc-delete ewoc goodbye))) 
    395424 
    396425(defun ewoc-locate (ewoc &optional pos guess) 
    …… 
    408437    (cond 
    409438     ;; Nothing present? 
    410      ((eq (ewoc--node-nth dll 1) (ewoc--node-nth dll -1)) 
     439     ((eq (ewoc--node-nth 1) (ewoc--node-nth -1)) 
    411440      nil) 
    412441 
    413442     ;; Before second elem? 
    414      ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2))) 
    415       (ewoc--node-nth dll 1)) 
     443     ((< pos (ewoc--node-start-marker (ewoc--node-nth 2))) 
     444      (ewoc--node-nth 1)) 
    416445 
    417446     ;; After one-before-last elem? 
    418      ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2))) 
    419       (ewoc--node-nth dll -2)) 
     447     ((>= pos (ewoc--node-start-marker (ewoc--node-nth -2))) 
     448      (ewoc--node-nth -2)) 
    420449 
    421450     ;; We now know that pos is within a elem. 
    …… 
    423452      ;; Make an educated guess about which of the three known 
    424453      ;; node'es (the first, the last, or GUESS) is nearest. 
    425       (let* ((best-guess (ewoc--node-nth dll 1)) 
     454      (let* ((best-guess (ewoc--node-nth 1)) 
    426455             (distance (abs (- pos (ewoc--node-start-marker best-guess))))) 
    427456        (when guess 
    …… 
    431460              (setq best-guess guess)))) 
    432461 
    433         (let* ((g (ewoc--node-nth dll -1))    ;Check the last elem 
     462        (let* ((g (ewoc--node-nth -1))        ;Check the last elem 
    434463               (d (abs (- pos (ewoc--node-start-marker g))))) 
    435464          (when (< d distance) 
    …… 
    437466            (setq best-guess g))) 
    438467 
    439         (when (ewoc--last-node ewoc) ;Check "previous". 
     468        (when (ewoc--last-node ewoc)    ;Check "previous". 
    440469          (let* ((g (ewoc--last-node ewoc)) 
    441470                 (d (abs (- pos (ewoc--node-start-marker g))))) 
    …… 
    454483          ;; Loop until we are exactly one node too far down... 
    455484          (while (>= pos (ewoc--node-start-marker best-guess)) 
    456             (setq best-guess (ewoc--node-next dll best-guess))) 
     485            (setq best-guess (ewoc--node-next best-guess))) 
    457486          ;; ...and return the previous node. 
    458           (ewoc--node-prev dll best-guess)) 
     487          (ewoc--node-prev best-guess)) 
    459488 
    460489         ;; Pos is before best-guess 
    461490         (t 
    462491          (while (< pos (ewoc--node-start-marker best-guess)) 
    463             (setq best-guess (ewoc--node-prev dll best-guess))) 
     492            (setq best-guess (ewoc--node-prev best-guess))) 
    464493          best-guess))))))) 
    465494 
    …… 
    485514      (while (and node (> arg 0)) 
    486515        (setq arg (1- arg)) 
    487         (setq node (ewoc--node-prev dll node))) 
     516        (setq node (ewoc--node-prev node))) 
    488517      ;; Never step above the first element. 
    489518      (unless (ewoc--filter-hf-nodes ewoc node) 
    490         (setq node (ewoc--node-nth dll 1))) 
     519        (setq node (ewoc--node-nth 1))) 
    491520      (ewoc-goto-node ewoc node)))) 
    492521 
    …… 
    498527    (while (and node (> arg 0)) 
    499528      (setq arg (1- arg)) 
    500       (setq node (ewoc--node-next dll node))) 
     529      (setq node (ewoc--node-next node))) 
    501530    ;; Never step below the first element. 
    502531    ;; (unless (ewoc--filter-hf-nodes ewoc node) 
    503     ;;   (setq node (ewoc--node-nth dll -2))) 
     532    ;;   (setq node (ewoc--node-nth -2))) 
    504533    (ewoc-goto-node ewoc node))) 
    505534 
    …… 
    520549      ((footer (ewoc--footer ewoc))) 
    521550    (let ((inhibit-read-only t)) 
    522       (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1)) 
     551      (delete-region (ewoc--node-start-marker (ewoc--node-nth 1)) 
    523552                     (ewoc--node-start-marker footer)) 
    524553      (goto-char (ewoc--node-start-marker footer)) 
    525554      (let ((pp (ewoc--pretty-printer ewoc)) 
    526             (node (ewoc--node-nth dll 1))) 
     555            (node (ewoc--node-nth 1))) 
    527556        (while (not (eq node footer)) 
    528557          (set-marker (ewoc--node-start-marker node) (point)) 
    529558          (funcall pp (ewoc--node-data node)) 
    530           (insert "\n") 
    531           (setq node (ewoc--node-next dll node))))) 
     559          (setq node (ewoc--node-next node))))) 
    532560    (set-marker (ewoc--node-start-marker footer) (point)))) 
    533561 
    …… 
    546574  (ewoc--set-buffer-bind-dll-let* ewoc 
    547575      ((header (ewoc--header ewoc)) 
    548        (node (ewoc--node-nth dll -2)) 
     576       (node (ewoc--node-nth -2)) 
    549577       result) 
    550578    (while (not (eq node header)) 
    551579      (if (apply predicate (ewoc--node-data node) args) 
    552580          (push (ewoc--node-data node) result)) 
    553       (setq node (ewoc--node-prev dll node))) 
     581      (setq node (ewoc--node-prev node))) 
    554582    (nreverse result))) 
    555583 
    …… 
    567595(defun ewoc-set-hf (ewoc header footer) 
    568596  "Set the HEADER and FOOTER of EWOC." 
    569   (setf (ewoc--node-data (ewoc--header ewoc)) header) 
    570   (setf (ewoc--node-data (ewoc--footer ewoc)) footer) 
    571   (save-excursion 
    572     (ewoc--refresh-node 'insert (ewoc--header ewoc)) 
    573     (ewoc--refresh-node 'insert (ewoc--footer ewoc)))) 
     597  (ewoc--set-buffer-bind-dll-let* ewoc 
     598      ((head (ewoc--header ewoc)) 
     599       (foot (ewoc--footer ewoc))) 
     600    (setf (ewoc--node-data head) header 
     601          (ewoc--node-data foot) footer) 
     602    (save-excursion 
     603      (ewoc--refresh-node 'insert head) 
     604      (ewoc--refresh-node 'insert foot)))) 
    574605 
    575606