*** wid-edit.el	13 May 2006 14:36:30 +0200	1.166
--- wid-edit.el	29 May 2006 20:12:10 +0200	
***************
*** 2548,2553 ****
--- 2548,2579 ----
    (widget-apply (widget-get widget :parent)
  		:delete-at (widget-get widget :widget)))
  
+ ;;; The `up-button' Widget.
+ 
+ (define-widget 'up-button 'push-button
+   "An up button for the `editable-list' widget."
+   :tag "UP"
+   :help-echo "Move this item up in the list."
+   :action 'widget-up-button-action)
+ 
+ (defun widget-up-button-action (widget &optional event)
+   ;; Ask the parent to move the item up in the list.
+   (widget-apply (widget-get widget :parent)
+ 		:move-up (widget-get widget :widget)))
+ 
+ ;;; The `down-button' Widget.
+ 
+ (define-widget 'down-button 'push-button
+   "An down button for the `editable-list' widget."
+   :tag "DOWN"
+   :help-echo "Move this item down in the list."
+   :action 'widget-down-button-action)
+ 
+ (defun widget-down-button-action (widget &optional event)
+   ;; Ask the parent to move the item down in the list.
+   (widget-apply (widget-get widget :parent)
+ 		:move-down (widget-get widget :widget)))
+ 
  ;;; The `editable-list' Widget.
  
  ;; (defcustom widget-editable-list-gui nil
***************
*** 2562,2575 ****
    :offset 12
    :format "%v%i\n"
    :format-handler 'widget-editable-list-format-handler
!   :entry-format "%i %d %v"
    :value-create 'widget-editable-list-value-create
    :value-get 'widget-editable-list-value-get
    :validate 'widget-children-validate
    :match 'widget-editable-list-match
    :match-inline 'widget-editable-list-match-inline
    :insert-before 'widget-editable-list-insert-before
!   :delete-at 'widget-editable-list-delete-at)
  
  (defun widget-editable-list-format-handler (widget escape)
    ;; We recognize the insert button.
--- 2588,2603 ----
    :offset 12
    :format "%v%i\n"
    :format-handler 'widget-editable-list-format-handler
!   :entry-format "%i %d %U %D %v"
    :value-create 'widget-editable-list-value-create
    :value-get 'widget-editable-list-value-get
    :validate 'widget-children-validate
    :match 'widget-editable-list-match
    :match-inline 'widget-editable-list-match-inline
    :insert-before 'widget-editable-list-insert-before
!   :delete-at 'widget-editable-list-delete-at
!   :move-up 'widget-editable-list-move-up
!   :move-down 'widget-editable-list-move-down)
  
  (defun widget-editable-list-format-handler (widget escape)
    ;; We recognize the insert button.
***************
*** 2628,2634 ****
  	  (setq ok nil))))
      (cons found value)))
  
! (defun widget-editable-list-insert-before (widget before)
    ;; Insert a new child in the list of children.
    (save-excursion
      (let ((children (widget-get widget :children))
--- 2656,2662 ----
  	  (setq ok nil))))
      (cons found value)))
  
! (defun widget-editable-list-insert-before (widget before &optional value conv)
    ;; Insert a new child in the list of children.
    (save-excursion
      (let ((children (widget-get widget :children))
***************
*** 2640,2646 ****
  	    (t
  	     (goto-char (widget-get widget :value-pos))))
        (let ((child (widget-editable-list-entry-create
! 		    widget nil nil)))
  	(when (< (widget-get child :entry-from) (widget-get widget :from))
  	  (set-marker (widget-get widget :from)
  		      (widget-get child :entry-from)))
--- 2668,2674 ----
  	    (t
  	     (goto-char (widget-get widget :value-pos))))
        (let ((child (widget-editable-list-entry-create
! 		    widget value conv)))
  	(when (< (widget-get child :entry-from) (widget-get widget :from))
  	  (set-marker (widget-get widget :from)
  		      (widget-get child :entry-from)))
***************
*** 2680,2690 ****
    (widget-setup)
    (widget-apply widget :notify widget))
  
  (defun widget-editable-list-entry-create (widget value conv)
    ;; Create a new entry to the list.
    (let ((type (nth 0 (widget-get widget :args)))
  	;; (widget-push-button-gui widget-editable-list-gui)
! 	child delete insert)
      (widget-specify-insert
       (save-excursion
         (and (widget-get widget :indent)
--- 2708,2752 ----
    (widget-setup)
    (widget-apply widget :notify widget))
  
+ (defun widget-editable-list-move-up (widget child)
+   ;; Move a child backwards in the list of children.
+   (let ((children (widget-get widget :children)))
+     (when (eq child (car children))
+       (error "This item is already at the top of the list"))
+     (let ((value (widget-value child))
+           (previous (cadr (memq child (reverse children)))))
+       (widget-apply widget :delete-at child)
+       (widget-apply widget :insert-before previous value t)
+       (let* ((new-children (widget-get widget :children))
+              (new-child (cadr (memq previous (reverse new-children))))
+              (up-button (widget-get new-child :up-button)))
+         (when up-button
+           (goto-char (widget-get up-button :from)))))))
+ 
+ (defun widget-editable-list-move-down (widget child)
+   ;; Move a child forwards in the list of children.
+   (let* ((children (widget-get widget :children))
+          (value (widget-value child))
+          (tail (cdr (memq child children))))
+       (when (null tail)
+         (error "This item is already at the bottom of the list"))
+       (let ((next-after-next (car-safe (cdr tail))))
+         (widget-apply widget :delete-at child)
+         (widget-apply widget :insert-before next-after-next value t)
+         (let* ((new-children (widget-get widget :children))
+                (new-child (if next-after-next
+                               (cadr (memq next-after-next
+                                           (reverse new-children)))
+                             (car (reverse new-children))))
+                (down-button (widget-get new-child :down-button)))
+           (when down-button
+             (goto-char (widget-get down-button :from)))))))
+ 
  (defun widget-editable-list-entry-create (widget value conv)
    ;; Create a new entry to the list.
    (let ((type (nth 0 (widget-get widget :args)))
  	;; (widget-push-button-gui widget-editable-list-gui)
! 	child new-buttons)
      (widget-specify-insert
       (save-excursion
         (and (widget-get widget :indent)
***************
*** 2697,2709 ****
  	 (cond ((eq escape ?%)
  		(insert ?%))
  	       ((eq escape ?i)
! 		(setq insert (apply 'widget-create-child-and-convert
! 				    widget 'insert-button
! 				    (widget-get widget :insert-button-args))))
  	       ((eq escape ?d)
! 		(setq delete (apply 'widget-create-child-and-convert
! 				    widget 'delete-button
! 				    (widget-get widget :delete-button-args))))
  	       ((eq escape ?v)
  		(if conv
  		    (setq child (widget-create-child-value
--- 2759,2787 ----
  	 (cond ((eq escape ?%)
  		(insert ?%))
  	       ((eq escape ?i)
! 		(push (cons :insert-button
!                             (apply 'widget-create-child-and-convert
!                                    widget 'insert-button
!                                    (widget-get widget :insert-button-args)))
!                       new-buttons))
  	       ((eq escape ?d)
! 		(push (cons :delete-button
!                             (apply 'widget-create-child-and-convert
!                                    widget 'delete-button
!                                    (widget-get widget :delete-button-args)))
!                       new-buttons))
! 	       ((eq escape ?U)
! 		(push (cons :up-button
!                             (apply 'widget-create-child-and-convert
!                                    widget 'up-button
!                                    (widget-get widget :up-button-args)))
!                       new-buttons))
! 	       ((eq escape ?D)
! 		(push (cons :down-button
!                             (apply 'widget-create-child-and-convert
!                                    widget 'down-button
!                                    (widget-get widget :down-button-args)))
!                       new-buttons))
  	       ((eq escape ?v)
  		(if conv
  		    (setq child (widget-create-child-value
***************
*** 2713,2720 ****
  	       (t
  		(error "Unknown escape `%c'" escape)))))
       (let ((buttons (widget-get widget :buttons)))
!        (if insert (push insert buttons))
!        (if delete (push delete buttons))
         (widget-put widget :buttons buttons))
       (let ((entry-from (point-min-marker))
  	   (entry-to (point-max-marker)))
--- 2791,2801 ----
  	       (t
  		(error "Unknown escape `%c'" escape)))))
       (let ((buttons (widget-get widget :buttons)))
!        (dolist (item new-buttons)
!          (let ((name (car item)) (button (cdr item)))
!            (widget-put button :widget child)
!            (widget-put child name button)
!            (push button buttons)))
         (widget-put widget :buttons buttons))
       (let ((entry-from (point-min-marker))
  	   (entry-to (point-max-marker)))
***************
*** 2722,2729 ****
         (set-marker-insertion-type entry-to nil)
         (widget-put child :entry-from entry-from)
         (widget-put child :entry-to entry-to)))
-     (if insert (widget-put insert :widget child))
-     (if delete (widget-put delete :widget child))
      child))
  
  ;;; The `group' Widget.
--- 2803,2808 ----