commit 0482455e2b346fb83cd6886bdff134cbb8a03677
parent 28ad1847f0d6580f21ff55bfa990352ae2649d46
Author: Natasha Kerensikova <natgh@instinctive.eu>
Date: Fri, 12 Jun 2026 19:12:58 +0000
Selectors have a name
Diffstat:
3 files changed, 53 insertions(+), 35 deletions(-)
diff --git a/src/cgi.scm b/src/cgi.scm
@@ -279,7 +279,7 @@ END-OF-CSS
(include "common.scm")
-(unless (= 5 (db-version))
+(unless (= 6 (db-version))
(die "Unexpectad database version"))
@@ -753,13 +753,13 @@ END-OF-CSS
old-v
id))
-(define (db-sel-count id text)
- (list id text
+(define (db-sel-count id text name)
+ (list id text name
(query fetch-value
(sql db (string-append "SELECT COUNT(id) FROM entry " text ";")))))
(define (db-sel-counts)
(query (map-rows* db-sel-count)
- (sql db "SELECT id,text FROM selector ORDER BY id DESC;")))
+ (sql db "SELECT id,text,name FROM selector ORDER BY id DESC;")))
(define (diff-sel-counts before after)
(let loop ((rest-before before) (rest-after after) (acc '()))
(cond
@@ -790,26 +790,37 @@ END-OF-CSS
(cadar rest-before) " / " (cadar rest-after))
0 0)
acc)))
- (else
+ ((not (string=? (caddar rest-before) (caddar rest-after)))
(loop (cdr rest-before)
(cdr rest-after)
- (if (= (caddar rest-before) (caddar rest-after))
- acc
- (cons (list (caar rest-before)
- (cadar rest-before)
- (caddar rest-after)
- (- (caddar rest-after) (caddar rest-before)))
- acc)))))))
+ (cons (list 0
+ (conc "name mismatch: "
+ (caddar rest-before) " / " (caddar rest-after))
+ 0 0)
+ acc)))
+ (else
+ (let ((n-before (car (cdddar rest-before)))
+ (n-after (car (cdddar rest-after))))
+ (loop (cdr rest-before)
+ (cdr rest-after)
+ (if (= n-before n-after)
+ acc
+ (cons (list (caar rest-before)
+ (cadar rest-before)
+ (caddar rest-before)
+ n-after
+ (- n-after n-before))
+ acc))))))))
(define (fragment-diff-sel-counts before after)
(let ((diff (diff-sel-counts before after)))
(if (null? diff) '()
`((table
,@(map (lambda (line)
`(tr (td ,(conc "Selection #" (car line)))
- (td ,(cadr line))
- (td ,(->string (caddr line)))
- (td ,(conc (if (positive? (cadddr line)) "(+" "(")
- (cadddr line) ")"))))
+ (td (@ (title ,(list-ref line 1))) ,(list-ref line 2))
+ (td ,(->string (list-ref line 3)))
+ (td ,(conc (if (positive? (list-ref line 4)) "(+" "(")
+ (list-ref line 4) ")"))))
diff))))))
(define (feed-sig-base)
diff --git a/src/common.scm b/src/common.scm
@@ -182,6 +182,13 @@
"UPDATE gruik SET mark=-10 WHERE mark=-1;"
"PRAGMA user_version = 5;")))
+(when (= 5 (db-version))
+ (for-each
+ (lambda (s) (exec (sql/transient db s)))
+ (list "ALTER TABLE selector ADD COLUMN name TEXT;"
+ "UPDATE selector SET name = text;"
+ "PRAGMA user_version = 6;")))
+
;;;;;;;;;;;;;;;;;;;;;;;;;
;; Database Utilitities
diff --git a/src/iens.scm b/src/iens.scm
@@ -100,7 +100,7 @@
(include "common.scm")
-(assert (= 5 (db-version)))
+(assert (= 6 (db-version)))
;;;;;;;;;;;;;;;;;;
;; Configuration
@@ -174,37 +174,37 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Configurable Query Selectors
-(defcmd (add-selector text)
- "\"WHERE …\"" "Creates a pre-defined query selector"
+(defcmd (add-selector name text)
+ "\"Name\" \"WHERE …\"" "Creates a pre-defined query selector"
(trace `(add-select ,text))
- (exec (sql db "INSERT INTO selector(text) VALUES (?);") text)
+ (exec (sql db "INSERT INTO selector(text, name) VALUES (?,?);") text name)
(write-line (conc " -> " (last-insert-rowid db))))
(define (call-with-selector arg proc)
- (cond ((string? arg) (proc arg #f))
+ (cond ((string? arg) (proc #f arg arg))
((number? arg) (let ((selector (get-selector arg)))
(if selector
- (proc selector arg)
+ (proc arg (car selector) (cadr selector))
(write-line
(conc "No selector #" arg " found")))))
(else (write-line (conc "Invalid selection argument " arg)))))
(define (get-selector id)
- (query fetch-value (sql db "SELECT text FROM selector WHERE id=?;") id))
+ (query fetch-row (sql db "SELECT name,text FROM selector WHERE id=?;") id))
(defcmd (list-selectors)
"" "List pre-defined query selectors"
(query
(for-each-row
(lambda (row)
- (write-line (conc "#" (car row) ": \"" (cadr row) "\""))))
- (sql db "SELECT id,text FROM selector;")))
+ (write-line (conc "#" (car row) " " (cadr row) ": \"" (caddr row) "\""))))
+ (sql db "SELECT id,name,text FROM selector;")))
-(defcmd (set-selector id text)
- "id \"WHERE …\"" "Sets a pre-defined query selector"
- (trace `(set-selector ,id ,text))
- (exec (sql db "INSERT OR REPLACE INTO selector(id,text) VALUES (?,?);")
- id text))
+(defcmd (set-selector id name text)
+ "id \"Name\" \"WHERE …\"" "Sets a pre-defined query selector"
+ (trace `(set-selector ,id ,name ,text))
+ (exec (sql db "INSERT OR REPLACE INTO selector(id,name,text) VALUES (?,?,?);")
+ id name text))
;;;;;;;;;;;;;;;;;;;;;
;; Database Updates
@@ -619,9 +619,9 @@
vt100-reset))
(write-string notes))
-(define (count-selection* text id)
+(define (count-selection* id name text)
(write-line (string-append (if id (conc "#" id ": ") "")
- "\"" text "\""))
+ "\"" name "\""))
(write-line (conc " -> " (query fetch-value
((if id sql sql/transient)
db
@@ -633,7 +633,7 @@
"\"WHERE ...\"|selector-id ..." "Count results of a custom queries"
(if (null? args)
(query (for-each-row* count-selection*)
- (sql db "SELECT text,id FROM selector;"))
+ (sql db "SELECT id,name,text FROM selector;"))
(let loop ((todo args))
(unless (null? todo)
(call-with-selector (car todo) count-selection*)
@@ -642,7 +642,7 @@
(defcmd (list-selection arg)
"\"WHERE ...\"|selector-id" "Display a custom query as an entry list"
(call-with-selector arg
- (lambda (selector id)
+ (lambda (id title selector)
(query (for-each-row* print-listed-entry-row)
((if id sql sql/transient) db
(string-append "SELECT id,url,notes,protected FROM entry "
@@ -703,7 +703,7 @@
(defcmd (print-selection arg)
"\"WHERE ...\"|selector-id" "Display entries from a custom query"
(call-with-selector arg
- (lambda (selector id)
+ (lambda (id title selector)
(query
(for-each-row* print-entry-row)
((if id sql sql/transient) db
