[201_76] 自定义的快捷键使用json保存

TeXmacs/progs/source/shortcut-edit.scm

@@ -13,13 +13,85 @@
 
 (texmacs-module (source shortcut-edit)
   (:use (source macro-edit)))
+(import (liii json))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Management of the list of user keyboard shortcuts
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define user-shortcuts-file "$TEXMACS_HOME_PATH/system/shortcuts.scm")
-(define current-user-shortcuts (list))
+(define user-shortcuts-file "$TEXMACS_HOME_PATH/system/shortcuts.json")
+(define user-shortcuts-version 1)
+
+(define (make-shortcut-entry sh cmd)
+  `(("shortcut" . ,sh)
+    ("command" . ,cmd)))
+
+(define (shortcut-entry-shortcut entry)
+  (json-ref entry "shortcut"))
+
+(define (shortcut-entry-command entry)
+  (json-ref entry "command"))
+
+(define (shortcut-entry-valid? entry)
+  (and (json-object? entry)
+       (string? (shortcut-entry-shortcut entry))
+       (string? (shortcut-entry-command entry))))
+
+(define (shortcut-entries-valid? entries)
+  (or (null? entries)
+      (and (shortcut-entry-valid? (car entries))
+           (shortcut-entries-valid? (cdr entries)))))
+
+(define (user-shortcuts-json-valid? json)
+  (and (json-object? json)
+       (let* ((meta (json-ref json "meta"))
+              (shortcuts (json-ref json "shortcuts"))
+              (version (and (json-object? meta) (json-ref meta "version")))
+              (total (and (json-object? meta) (json-ref meta "total"))))
+         (and (json-object? meta)
+              (integer? version)
+              (integer? total)
+              (>= total 0)
+              (vector? shortcuts)
+              (== total (vector-length shortcuts))
+              (shortcut-entries-valid? (vector->list shortcuts))))))
+
+(define (make-user-shortcuts-json shortcuts)
+  `(("meta" . (("version" . ,user-shortcuts-version)
+               ("total" . ,(vector-length shortcuts))))
+    ("shortcuts" . ,shortcuts)))
+
+(define (make-empty-user-shortcuts-json)
+  (make-user-shortcuts-json #()))
+
+(define current-user-shortcuts (make-empty-user-shortcuts-json))
+
+(define (current-user-shortcuts-vector)
+  (with shortcuts (json-ref current-user-shortcuts "shortcuts")
+    (if (vector? shortcuts) shortcuts #())))
+
+(define (current-user-shortcuts-list)
+  (vector->list (current-user-shortcuts-vector)))
+
+(define (normalize-user-shortcuts-json json)
+  (let* ((shortcuts (if (and (json-object? json) (vector? (json-ref json "shortcuts")))
+                        (json-ref json "shortcuts")
+                        #()))
+         (entries (vector->list shortcuts))
+         (valid (list-filter entries shortcut-entry-valid?)))
+    (make-user-shortcuts-json (list->vector valid))))
+
+(define (set-current-user-shortcuts-list entries)
+  (set! current-user-shortcuts
+        (make-user-shortcuts-json (list->vector entries))))
+
+(define (find-user-shortcut-entry sh)
+  (let loop ((entries (current-user-shortcuts-list)))
+    (and (nnull? entries)
+         (let ((entry (car entries)))
+           (if (== (shortcut-entry-shortcut entry) sh)
+               entry
+               (loop (cdr entries)))))))
 
 (define (apply-user-shortcut sh cmd)
   (and-with val (string->object cmd)
@@ -28,17 +100,29 @@
 (define (unapply-user-shortcut sh)
   (eval `(kbd-unmap ,sh)))
 
+(define (reset-user-shortcuts)
+  (set! current-user-shortcuts (make-empty-user-shortcuts-json))
+  (save-user-shortcuts))
+
 (define (load-user-shortcuts)
+  (set! current-user-shortcuts (make-empty-user-shortcuts-json))
   (when (url-exists? user-shortcuts-file)
-    (set! current-user-shortcuts (load-object user-shortcuts-file))
-    (for (entry current-user-shortcuts)
-      (with (sh cmd) entry
-        (apply-user-shortcut sh cmd)))))
+    (let ((loaded
+           (catch #t
+             (lambda ()
+               (string->json (string-load user-shortcuts-file)))
+             (lambda args #f))))
+      (if (user-shortcuts-json-valid? loaded)
+          (set! current-user-shortcuts
+                (normalize-user-shortcuts-json loaded))
+          (reset-user-shortcuts))))
+  (for (entry (current-user-shortcuts-list))
+    (apply-user-shortcut (shortcut-entry-shortcut entry)
+                         (shortcut-entry-command entry))))
 
 (define (save-user-shortcuts)
-  (if (null? current-user-shortcuts)
-      (url-remove user-shortcuts-file)
-      (save-object user-shortcuts-file current-user-shortcuts)))
+  (string-save (json->string current-user-shortcuts)
+               user-shortcuts-file))
 
 (tm-define (init-user-shortcuts)
   (load-user-shortcuts))
@@ -54,35 +138,53 @@
   (string<=? (shortcut-rewrite s1) (shortcut-rewrite s2)))
 
 (tm-define (user-shortcuts-list)
-  (list-sort (map car current-user-shortcuts) shortcut<=?))
+  (list-sort (map shortcut-entry-shortcut (current-user-shortcuts-list))
+             shortcut<=?))
 
 (tm-define (set-user-shortcut sh cmd)
-  (set! current-user-shortcuts
-        (assoc-set! current-user-shortcuts sh (list cmd)))
+  (let* ((entries (current-user-shortcuts-list))
+         (others (list-filter entries
+                              (lambda (entry)
+                                (!= (shortcut-entry-shortcut entry) sh))))
+         (next (append others (list (make-shortcut-entry sh cmd)))))
+    (set-current-user-shortcuts-list next))
   (save-user-shortcuts)
   (apply-user-shortcut sh cmd))
 
 (tm-define (get-user-shortcut sh)
-  (and-with val (assoc-ref current-user-shortcuts sh)
-    (car val)))
+  (and-with entry (find-user-shortcut-entry sh)
+    (shortcut-entry-command entry)))
 
 (tm-define (remove-user-shortcut sh)
-  (set! current-user-shortcuts
-        (assoc-remove! current-user-shortcuts sh))
+  (set-current-user-shortcuts-list
+    (list-filter (current-user-shortcuts-list)
+                 (lambda (entry)
+                   (!= (shortcut-entry-shortcut entry) sh))))
   (save-user-shortcuts)
   (unapply-user-shortcut sh))
 
 (tm-define (has-user-shortcut? cmd)
-  (in? cmd (map cadr current-user-shortcuts)))
+  (in? cmd (map shortcut-entry-command (current-user-shortcuts-list))))
 
 (tm-define (encode-shortcut sh)
   (translate (kbd-system-rewrite sh)))
 
-(tm-define (decode-shortcut sh)
-  (with all (map (lambda (x) (cons (encode-shortcut x) x))
-                 (map car current-user-shortcuts))
-    (or (assoc-ref all sh) sh)))
+(define (normalize-shortcut-string sh)
+  (if (not (string? sh)) sh
+      (let* ((s1 (string-replace sh "<less>" "<"))
+             (s2 (string-replace s1 "<gtr>" ">"))
+             (l (list-filter (string-tokenize-by-char s2 #\space)
+                             (lambda (x) (!= x "")))))
+        (string-join l " "))))
 
+(tm-define (decode-shortcut sh)
+  (let* ((sh* (normalize-shortcut-string sh))
+         (all (map (lambda (x) (cons (encode-shortcut x) x))
+                   (map shortcut-entry-shortcut (current-user-shortcuts-list)))))
+    (or (assoc-ref all sh)
+        (assoc-ref all sh*)
+        sh*)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Editing keyboard shortcuts
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

TeXmacs/progs/source/shortcut-widgets.scm

@@ -65,8 +65,11 @@
           (explicit-buttons
             ("Remove" (and-with sh (get-shortcut u)
                         (global-set u :sh "")
+                        (global-set u :cmd "")
+                        (set-shortcut u "")
                         (remove-user-shortcut sh)
-                        (refresh-now "shortcuts-list")))
+                        (refresh-now "shortcuts-list")
+                        (refresh-now "current-shortcut")))
             // //
             ("Clear" (set-shortcut u ""))
             // //
@@ -98,8 +101,11 @@
         (hlist >>
           ("Remove" (and-with sh (get-shortcut u)
                       (global-set u :sh "")
+                      (global-set u :cmd "")
+                      (set-shortcut u "")
                       (remove-user-shortcut sh)
-                      (refresh-now* win "shortcuts-list")))
+                      (refresh-now* win "shortcuts-list")
+                      (refresh-now* win "current-shortcut")))
           // //
           ("Clear" (set-shortcut u ""))
           // //

devel/201_76.md

@@ -0,0 +1,21 @@
+# [201_76]
+
+## 如何测试
+1. 点击`工具->键盘->编辑键盘快捷键`.
+2. 快捷键设置`< < 1` ，命令为`“test”`
+3. 保存后在文档中输入`<<1`，字符串test被自动输入进去
+4. 重新打开软件，再打开快捷键编辑器，之前设置的快捷键还在
+5. 删除快捷键，重新打开软件，对应的快捷键被清除
+6. 快捷键设置`< < 1` ，命令为`“test”`
+7. 关掉软件，编辑`~/.local/share/moganlab/system/shortcuts.json`
+```
+{"meta":{"version":1,"total":0},"shortcuts":[]}
+```
+打开程序，点击`工具->键盘->编辑键盘快捷键`.，由于json结构不准确，快捷键设置被清空
+8. 快捷键设置`< < 1` ，命令为`“test”`，关掉软件，编辑`~/.local/share/moganlab/system/shortcuts.json`
+```
+{"meta":{"version":1,"total":0},"shortcuts":
+```
+打开程序，点击`工具->键盘->编辑键盘快捷键`.，由于json结构非法，快捷键设置被清空
+
+## 2026/02/06 自定义的快捷键使用json保存