From 19a2a8cadf52149229f0883155b8fcb562b676b8 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sun, 17 Apr 2016 10:56:05 -0700
Subject: Move up/down/top/bottom functionality.

---
 alias-list-form.txr | 20 +++++++++++++++++---
 aliases.txr         | 32 ++++++++++++++++++++++++++++----
 main.txr            |  1 +
 util.tl             | 23 +++++++++++++++++++++++
 4 files changed, 69 insertions(+), 7 deletions(-)
 create mode 100644 util.tl

diff --git a/alias-list-form.txr b/alias-list-form.txr
index 11adaa9..023e3ad 100644
--- a/alias-list-form.txr
+++ b/alias-list-form.txr
@@ -23,9 +23,7 @@
   <div>
     <table cellspacing="10">
       <tr>
-        <th align="right">
-          <input type="button" name="delete" value="Del" onclick="submit();"
-                 title="Permantently delete the checkboxed aliases."></th>
+        <th align="right">Select</th>
         <th align="left">Alias</th>
         <th align="left">Date Created</th>
         <th align="left">Memo</th>
@@ -57,6 +55,22 @@
   </div>
   <div>
   </div>
+  <div>
+    <table cellspacing="10">
+      <tr>
+        <td><input type="submit" name="move-up" value="Move up"
+                   title="Move checkboxed aliases up one row."></td>
+        <td><input type="submit" name="move-down" value="Move down"
+                   title="Move the checkboxed aliases down one row."></td>
+        <td><input type="submit" name="move-top" value="Move to top"
+                   title="Move checkboxed aliases to top of list."></td>
+        <td><input type="submit" name="move-bot" value="Move to bottom"
+                   title="Move checkboxed aliases to bottom of list."></td>
+        <td><input type="submit" name="delete" value="Delete Selected"
+                   title="Permantently delete the checkboxed aliases."></td>
+      </tr>
+    <table>
+  </div>
 @    (end)
 @  (else)
 @    (output)
diff --git a/aliases.txr b/aliases.txr
index f6fff50..2f25997 100644
--- a/aliases.txr
+++ b/aliases.txr
@@ -97,11 +97,11 @@
 @(end)
 @;
 @(define update-aliases (userid postdata))
-@  (local memo aliases delaliases)
+@  (local memo aliases selected)
 @  (bind url-args @(split-str postdata "&"))
 @  (next :list url-args)
-@  (collect :vars (delaliases))
-chkbox-@delaliases=on
+@  (collect :vars (selected))
+chkbox-@selected=on
 @  (end)
 @  (next :list url-args)
 @  (gather)
@@ -115,8 +115,32 @@ create=@(skip)
 @    (do (push (new (alias :random memo (time))) aliases))
 @    (store-aliases userid aliases)
 @  (or)
+@    (skip)
+move-up=@(skip)
+@    (load-aliases userid aliases)
+@    (store-aliases userid @[move-up aliases selected])
+@  (or)
+@    (skip)
+move-down=@(skip)
+@    (load-aliases userid aliases)
+@    (store-aliases userid @[move-down aliases selected])
+@  (or)
+@    (skip)
+move-top=@(skip)
 @    (load-aliases userid aliases)
-@    (store-aliases userid @[set-diff aliases delaliases equal])
+@    (store-aliases userid @[move-front aliases selected])
+@  (or)
+@    (skip)
+move-bot=@(skip)
+@    (load-aliases userid aliases)
+@    (store-aliases userid @[move-tail aliases selected])
+@  (or)
+@    (skip)
+delete=@(skip)
+@    (load-aliases userid aliases)
+@    (store-aliases userid @[set-diff aliases selected equal])
+@  (or)
+@    (accept)
 @  (end)
 @(end)
 @;
diff --git a/main.txr b/main.txr
index cb58078..1e900ee 100755
--- a/main.txr
+++ b/main.txr
@@ -7,6 +7,7 @@
 @(load "session")
 @(load "lockdir")
 @(load "random")
+@(load "util")
 @(load "aliases")
 @(load "login-form")
 @(load "error-form")
diff --git a/util.tl b/util.tl
new file mode 100644
index 0000000..71fc985
--- /dev/null
+++ b/util.tl
@@ -0,0 +1,23 @@
+(defun move-impl (items keys ins-pos)
+  (let ((key-items (mapcar (op find @1 items) keys))
+        (rm-items [set-diff items keys equal]))
+    (append [rm-items 0..ins-pos]
+            key-items
+            [rm-items ins-pos..:])))
+
+(defun minpos (items keys)
+  [reduce-left min (mapcar (op posqual @1 items) keys) (length items)])
+
+(defun move-up (items keys)
+  (move-impl items keys
+             (max 0 (pred (minpos items keys)))))
+
+(defun move-down (items keys)
+  (move-impl items keys
+             (succ (minpos items keys))))
+
+(defun move-front (items keys)
+  (move-impl items keys 0))
+
+(defun move-tail (items keys)
+  (move-impl items keys (length items)))
-- 
cgit v1.2.3