all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* patch: [UP] and [DOWN] buttons for `editable-list' widgets
@ 2006-05-29 18:57 Daniel Brockman
  2006-05-30  3:47 ` Richard Stallman
  0 siblings, 1 reply; 6+ messages in thread
From: Daniel Brockman @ 2006-05-29 18:57 UTC (permalink / raw)


[-- Attachment #1: Type: text/plain, Size: 3648 bytes --]

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  <daniel@brockman.se>

	* 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').


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 9286 bytes --]

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

[-- Attachment #3: Type: text/plain, Size: 206 bytes --]


-- 
Daniel Brockman <daniel@brockman.se>

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

[-- Attachment #4: Type: text/plain, Size: 142 bytes --]

_______________________________________________
Emacs-devel mailing list
Emacs-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-devel

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2006-05-31 22:30 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2006-05-29 18:57 patch: [UP] and [DOWN] buttons for `editable-list' widgets Daniel Brockman
2006-05-30  3:47 ` Richard Stallman
2006-05-30  8:39   ` Kim F. Storm
2006-05-31  0:40     ` Richard Stallman
2006-05-31  4:43       ` Daniel Brockman
2006-05-31 22:30         ` Richard Stallman

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.