Nicer editing of labels associated to environments

Author: vdhoeven

TeXmacs/progs/generic/generic-edit.scm

@@ -1045,6 +1045,33 @@
         (insert `(video ,(url->delta-unix u) ,w ,h ,len ,rep)))
     "Width" "Height" "Length" "Repeat?"))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Labels attached to markup
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(tm-define (focus-label t) #f)
+
+(tm-define (focus-get-label t)
+  (and-with l (focus-label t)
+    (tm->string (tm-ref l 0))))
+
+(tm-define (focus-set-label t val)
+  (and-with l (focus-label t)
+    (tree-set l 0 val)))
+
+(tm-define (focus-list-search-label l)
+  (and (nnull? l)
+       (or (focus-search-label (car l))
+           (focus-list-search-label (cdr l)))))
+
+(tm-define (focus-search-label t)
+  (cond ((tm-func? t 'label 1) t)
+        ((tm-in? t '(document concat table row cell))
+         (focus-list-search-label (tm-children t)))
+        ((tm-in? t '(tformat with surround))
+         (focus-search-label (cAr (tm-children t))))
+        (else #f)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Special keyboard behaviour when entering hybrid commands
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

TeXmacs/progs/generic/generic-menu.scm

@@ -583,6 +583,14 @@
 (tm-menu (focus-hidden-menu t)
   (:require (pure-alternate-context? t)))
 
+(tm-menu (focus-label-menu t)
+  (assuming (focus-label t)
+    ---
+    (with s (focus-get-label t)
+      ((eval (string-append "#" s))
+       (interactive (lambda (l) (focus-set-label t l))
+         (list "Label" "string" s))))))  
+
 (tm-menu (standard-focus-menu t)
   (dynamic (focus-ancestor-menu t))
   (dynamic (focus-tag-menu t))
@@ -593,7 +601,8 @@
     ---
     (dynamic (focus-insert-menu t)))
   (dynamic (focus-extra-menu t))
-  (dynamic (focus-hidden-menu t)))
+  (dynamic (focus-hidden-menu t))
+  (dynamic (focus-label-menu t)))
 
 (tm-menu (focus-menu)
   (dynamic (standard-focus-menu (focus-tree))))
@@ -718,6 +727,14 @@
 (tm-menu (focus-hidden-icons t)
   (:require (pure-alternate-context? t)))
 
+(tm-menu (focus-label-icons t)
+  (assuming (focus-label t)
+    (with s (focus-get-label t)
+      (glue #f #f 3 0)
+      (mini #t (group "Label:"))
+      (mini #t (input (focus-set-label (focus-tree) answer) "string"
+                      (list s) "12em")))))
+
 (tm-menu (standard-focus-icons t)
   (dynamic (focus-ancestor-icons t))
   (assuming (focus-can-move? t)
@@ -727,8 +744,9 @@
     (minibar (dynamic (focus-insert-icons t)))
     //)
   (minibar (dynamic (focus-tag-icons t)))
-  (dynamic (focus-extra-icons t))
   (dynamic (focus-hidden-icons t))
+  (dynamic (focus-extra-icons t))
+  (dynamic (focus-label-icons t))
   //)
 
 (tm-menu (texmacs-focus-icons)

TeXmacs/progs/link/ref-edit.scm

@@ -176,6 +176,18 @@
   (:applicable (broken-citations))
   (list-go-to (broken-citations) dir))
 
+(tm-define (special-extremal t forwards?)
+  (:require (focus-label t))
+  (with lab (focus-label t)
+    (tree-go-to lab :end)
+    (special-extremal lab forwards?)))
+
+(tm-define (special-incremental t forwards?)
+  (:require (focus-label t))
+  (with lab (focus-label t)
+    (tree-go-to lab :end)
+    (special-incremental lab forwards?)))
+
 (tm-define (special-extremal t forwards?)
   (:require (tie-context? t))
   (go-to-same-tie (if forwards? :last :first)))

TeXmacs/progs/table/table-menu.scm

@@ -369,7 +369,8 @@
   (if (== (get-cell-mode) "table") (group "Cells"))
   (link cell-menu)
   (dynamic (focus-extra-menu t))
-  (dynamic (focus-hidden-menu t)))
+  (dynamic (focus-hidden-menu t))
+  (dynamic (focus-label-menu t)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Icons for manipulation of tables

TeXmacs/progs/text/text-edit.scm

@@ -318,6 +318,12 @@
   (tree-go-to t :end)
   (make 'label))
 
+(tm-define (focus-label t)
+  (:require (section-context? t))
+  (and-with p (tree-up t)
+    (and (tm-func? p 'concat)
+         (focus-search-label p))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Routines for lists, enumerations and description
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -358,6 +364,13 @@
   (:require (tree-is? t 'item*))
   (go-end-of 'item*))
 
+(tm-define (focus-label t)
+  (:require (or (list-context? t) (tree-is? t 'bib-list)))
+  (and-with doc (tree-down t)
+    (and (tree-is? doc 'document)
+         (and-with par (tree-down doc)
+           (focus-search-label par)))))
+
 (tm-define (numbered-context? t)
   (:require (or (itemize-context? t) (enumerate-context? t)))
   #t)
@@ -399,7 +412,7 @@
     (insert ins)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Inserting formulas
+;; Formulas
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (tm-define (make-equation)
@@ -417,6 +430,21 @@
   (make 'eqnarray*)
   (temp-proof-fix))
 
+(tm-define (focus-label t)
+  (:require (tree-is? t 'equation))
+  (focus-list-search-label (tree-children t)))
+
+(define (down-to-row t)
+  (cond ((not (tree? t)) #f)
+        ((tree-is? t 'row) t)
+        ((tree-in? t '(document tformat table)) (down-to-row (tree-down t)))
+        (else #f)))
+
+(tm-define (focus-label t)
+  (:require (tree-in? t '(eqnarray eqnarray*)))
+  (and-with row (down-to-row (tree-down t))
+    (focus-search-label row)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Routines for inserting miscellaneous content
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -505,6 +533,11 @@
   (tree-go-to t :last :start)
   (make 'dueto))
 
+(tm-define (focus-label t)
+  (:require (tree-in? t (enunciation-tag-list)))
+  (and (== (tree-arity t) 1)
+       (focus-search-label (tree-ref t 0))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Editing algorithms
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -584,6 +617,10 @@
 	  (tree-insert! t (- (tree-arity t) 1) '((document "")))
 	  (tree-go-to t (- (tree-arity t) 2) :start)))))
 
+(tm-define (focus-label t)
+  (:require (algorithm-context? t))
+  (focus-list-search-label (tree-children t)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Possible to use a custom note symbol
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -797,6 +834,9 @@
 (tm-define (footnote-context? t)
   (tree-in? t '(footnote wide-footnote)))
 
+(tm-define (figure-context? t)
+  (tree-in? t (figure-tag-list)))
+
 (tm-define (float-or-footnote-context? t)
   (tree-in? t '(float wide-float footnote wide-footnote)))
 
@@ -911,3 +951,7 @@
   (if (cursor-at-anchor?)
       (go-to-float)
       (go-to-anchor)))
+
+(tm-define (focus-label t)
+  (:require (or (footnote-context? t) (figure-context? t)))
+  (focus-list-search-label (tree-children t)))