patch: [UP] and [DOWN] buttons for `editable-list' widgets

[Daniel Brockman]

I've often been annoyed that there is no easy way to reorder
lists in Customize.  You cannot kill and yank items, nor can
you move them up or down.

For an example, see M-x customize-variable RET exec-path RET.

The attached patch adds [UP] and [DOWN] buttons to enable
reordering of all `editable-list' widgets.

exec-path: [Hide Value]
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /home/drlion/bin
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /usr/local/bin
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /usr/local/sbin
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /usr/bin
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /bin
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /usr/bin/X11
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /usr/games
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /usr/sbin
[INS] [DEL] [UP] [DOWN] Choice: [Value Menu] /sbin
[INS]

If this takes up too much horizontal space, we could use
shorter labels:

exec-path: [Hide Value]
[INS] [DEL] [<] [>] Choice: [Value Menu] /home/drlion/bin
[INS] [DEL] [<] [>] Choice: [Value Menu] /usr/local/bin
[INS] [DEL] [<] [>] Choice: [Value Menu] /usr/local/sbin
[INS] [DEL] [<] [>] Choice: [Value Menu] /usr/bin
[INS] [DEL] [<] [>] Choice: [Value Menu] /bin
[INS] [DEL] [<] [>] Choice: [Value Menu] /usr/bin/X11
[INS] [DEL] [<] [>] Choice: [Value Menu] /usr/games
[INS] [DEL] [<] [>] Choice: [Value Menu] /usr/sbin
[INS] [DEL] [<] [>] Choice: [Value Menu] /sbin
[INS]

Note also that the `[' and `]' characters are not necessary
and do not show up in X frames, saving 8 characters.

We could even do this:

exec-path: [Hide Value]
[+] [-] [<] [>] Choice: [Value Menu] /home/drlion/bin
[+] [-] [<] [>] Choice: [Value Menu] /usr/local/bin
[+] [-] [<] [>] Choice: [Value Menu] /usr/local/sbin
[+] [-] [<] [>] Choice: [Value Menu] /usr/bin
[+] [-] [<] [>] Choice: [Value Menu] /bin
[+] [-] [<] [>] Choice: [Value Menu] /usr/bin/X11
[+] [-] [<] [>] Choice: [Value Menu] /usr/games
[+] [-] [<] [>] Choice: [Value Menu] /usr/sbin
[+] [-] [<] [>] Choice: [Value Menu] /sbin
[+]

I think this feature has been a long time coming, and the
patch is not very intrusive.  I'm afraid I haven't been
reading this list lately, so I don't know how close we are
to release and what the attitude towards new features is.
(If needed, I can make patch as non-intrusive as possible.)

I'm kind of expecting ``WE ARE IN FEATURE FREEZE, GO AWAY'',
but I thought I'd at least try.  If it can't go in Emacs 22,
let me know and I'll bring this up again after the release.

Much kudos go to Alex `kensanata' Schröder for a brave
manual implementation of this feature.  By manual I mean
that his `widget-editable-list-move-up' manipulated the
buffer directly, manually moving the entry.  This might have
been faster, but it was definitely a lot more complicated.

I reimplemented it by building upon the already-existing
insert and delete functionality.  I think this is what Alex
would have wanted, too. :-)

In any case, both he and I have signed papers for past and
future changes to Emacs.

2006-05-29  Daniel Brockman  <address@hidden>

        * wid-edit.el (widget-editable-list-insert-before): New optional
        arguments VALUE and CONV specify the value of the new entry.
        (widget-editable-list-move-up, widget-editable-list-move-down):
        New functions.
        (up-button, down-button): New widgets.
        (editable-list): Add `%U' and `%D' to :entry-format option to
        specify adding an `up-button' and a `down-button'.  In addition,
        add :move-up and :move-down methods.
        (widget-editable-list-entry-create): Create up and down buttons.
        Refactor code related to the buttons (including `insert-button'
        and `delete-button').

*** 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 ----

-- 
Daniel Brockman <address@hidden>

   ``For any given feature, I don't care much about the
     people who find it useless --- I care more about
     the people who find it useful.'' --- Larry Wall