Here is the last version of the widget and balloon. I found the definition of the tree-search function and modified it not to look inside the focus. I don’t have a grasp of what data structure is a tree, so I could not cut the “focus branch” from the tree to search (I omit details).
Also, in the widget repeated labels are indexed (it is good by itself I think, and also necessary because the “enum” widget filters its list to keep only one copy of each element); when inserting, the index is omitted.
It could also be good to insert only the “rest of the matching label” at the end of the text in the current focus, but I have to think how to do it. Also in this case I/we would have to think on what to do with non-matching labels.
At the moment I am showing all labels in the widget, and only matching labels (without indexing) in the balloon.
;;=============================
;;Label list widget and balloon
;;=============================
;;; Tree search
(define (biblio-context? t)
(or (tree-func? t 'bibliography 4)
(tree-func? t 'bibliography* 5)))
(tm-define (in-biblio-context? t) (tree-search-upwards t biblio-context?))
;; definition of tree-search
;; in progs/kernel/library/tree.scm
;; (define-public (tree-search t pred?)
;; (with me (if (pred? t) (list t) '())
;; (if (tree-atomic? t) me
;; (append me (append-map (cut tree-search <> pred?)
;; (tree-children t))))))
;; Starting from the standard tree-search, a tree-search function that does not
;; look inside the current focus.
;; If I find the path of (focus-tree) I exit from the function
;; I could write a single search function that does not look inside the current
;; focus and apply it to every case (since we are looking for labels, excluding
;; the current focus in a reference will find all labels)
(define (tree-search-elsewhere t pred?)
(with me (if (and (pred? t) ) (list t) '())
(cond
((tree-atomic? t) me)
((equal? (tree->path (focus-tree)) (tree->path t)) '())
(else (append me (append-map (cut tree-search-elsewhere <> pred?)
(tree-children t)))))))
(tm-define (search-doc-all-labels t)
(:synopsis "A function that finds all labels that are not part of the bibliography.")
(tree-search t
(lambda (s) (and (label-context? s) (not (in-biblio-context? s)))
)))
(tm-define (search-doc-elsewhere-labels t)
(:synopsis "A function that finds all labels outside the current focus that are not part of the
bibliography.")
(tree-search-elsewhere t
(lambda (s) (and (label-context? s) (not (in-biblio-context? s)))
)))
(tm-define (search-doc-labels t)
(if (label-context? (focus-tree))
(search-doc-elsewhere-labels t)
(search-doc-all-labels t)))
;;; Filter labels that start as the text typed in the label or reference in focus
(tm-define (filter-labels labels str)
(:synopsis "Keeps the labels whose start is equal to str")
(filter (lambda (s)
(and (>= (string-length s) (string-length str))
(string-contains s str 0 (string-length str))))
labels))
;; first we check if the string is at least as long as the text in the ref or
;; label (arguments of and are evaluated only up to the first that is false)
;; then we check that the label contains the already-typed text (which is now
;; at most as long as the label).
;; The two indices 0 and (string-length str) cause the comparison to be made
;; only to the beginning substring of s of length equal to the length of str.
;; I think that the indices of string-contains behave like the indices of
;; substring (first included, last excluded), I tested this in one case only:
;; (string-contains "test " "test" 0 4) $0
;; (string-contains "test " "test" 0 3) $#f
;;; Index repeated labels to distinguish them
;; The "enum" widget provided by TeXmacs filters the list to keep only unique
;; entries. We want to see all labels, so we add an index to repeated entries
;; applying the function index-repeated-entries
;; The following functions work well together because in the input list of
;; labels found by search-doc-labels there are no spaces, so I can apply the
;; index-equal-elements to the cdr of the list after I have already modified it
;; with index-equal-elements applied to the whole list (using as a comparison
;; the car of the list)---the modifications neither cause new matches, nor
;; exclude already-existing matches
(define (index-equal-elements element lst n)
(cond ((null? lst) lst)
((equal? (car lst) element)
(cons (string-join `(,(car lst) " (" ,(number->string n) ")") "")
(index-equal-elements element (cdr lst) (+ n 1))))
(else (cons (car lst) (index-equal-elements element (cdr lst) n)))))
(define (index-repeated-entries lst)
(cond ((null? lst) lst)
(else (cons (car lst)
(index-repeated-entries
(index-equal-elements (car lst) (cdr lst) 2))))))
;;; Build label list
;; use search-doc-labels function instead of the standard search-labels, that
;; finds the labels defined in the bibliography as well.
;; The search-doc-labels function behaves differently if in a label (excludes
;; the current focus)
(define (label-list)
(let ((ls (search-doc-labels (buffer-tree))))
(map (lambda (l) (tree->string (tm-ref l 0))) ls)))
;;; Widget
;; An insert function that inserts a string only up to before the last blank
(define (keep-till-first-blank str)
;; (display "keep-till-first-blank\n")
(let* ((ind-first-blank (string-index str #\space)))
;; if we did not find a blank,
;; ind-first-blank is false: keep the
;; whole string
(if ind-first-blank
(substring str 0 ind-first-blank)
str)))
(tm-widget (enum-labels)
(enum (insert (keep-till-first-blank answer))
(index-repeated-entries (label-list)) "Choose label ..."
"24em"))
;;; Balloon
(tm-define (label-balloon)
(let* ((focus-string (cadr (tree->stree (focus-tree))))
(ll (filter-labels ; keep only labels that start with the text in focus tree
(label-list)
focus-string)))
(display-balloon (cursor-tree) `(document ,@ll) "auto" "auto" "keyboard")))
;;; Tie widget and balloon to context and actions
(define (inactive-reference-focus)
(and (inside? 'inactive)
(or
(reference-context? (focus-tree))
(label-context? (focus-tree)))))
;; Widget in context menu
(tm-menu (texmacs-popup-menu)
(:require (inactive-reference-focus))
(former)
---
("Show labels" (top-window enum-labels "Insert labels")))
;; Balloon to keyboard shortcut
(kbd-map
(:require (inactive-reference-focus))
("C-l C-l" (label-balloon)))
. Thank you once more.