[main]Notes on TeXmacs

Implementing comments in TeXmacs

We discuss the implementation of comments in TeXmacs documents. This is a new feature introduced by Joris in r13254 with some additions in subsequent revisions, the current description is based on revision r13256.

The specification

The basic idea is to have a markup element to insert comments in documents. There should be facilities to hide/show all comments and remove all comments. Hidden comments do not affect the typesetting of the document and are shown via a flag, but can still be read via balloons which opens as the cursor is nearby a comment.

Here's an example of a document with two comments:

and here the same document with both comments hidden, showing the balloon the user sees when the cursor is nearby an hidden comment (indicated by a flag, here shown in the “detailed” mode).

The implementation

We discuss the implementation of the basic functionality: comment tags and commands to operate on them. The first thing is to create a new package which the user has to include in the document in order to activate this feature. The package can be found in TeXmacs/packages/utilities/comment.ts. First we make sure that the appropriate menu is loaded as soon as the package become active. Menus are created and managed via Scheme code, so we load the scheme module (various comment-menu) which is found in the file TeXmacs/progs/various/comment-menu.scm:

<use-module|(various comment-menu)>

The module contains several macros, but the main interface is provided by the show-comment and hide-comment macros:

<assign|show-comment|

<macro|unique-id|mirror-id|type|by|time|body|<with|old-color|color|old-locus-color|locus-color|locus-color|preserve|

<\locus|

<id|mirror-id>

|

<observer|unique-id|mirror-notify>

|

<\with|locus-color|old-color|color|<comment-color|by>|

<\surround|<extern|mirror-initialize|<quote-arg|body>>[<condensed|<name|<abbreviate-name|by>>>: |<if|<equal|<get-label|<quote-arg|body>>|document>|<right-flush>>]|

<with|color|old-color|body>

>

>

>

>>

>

<assign|hide-comment|

<macro|unique-id|mirror-id|type|by|time|body|<with|old-locus-color|locus-color|locus-color|preserve|

<\locus|

<id|mirror-id>

|

<observer|unique-id|mirror-notify>

|

<expand-as|body|<extern|mirror-initialize|<quote-arg|body>><flag|<abbreviate-name|by>|<comment-color|by>><hidden|body>>

>

>>

>

We will enter later into the specific details of the implementation. Both macros collect various arguments unique-id, mirror-id, type, by, time, body. While show-comment renders the comment body as part of the document, with an indication of the author, as provided by the argument by, the hide-comment markup does not show up in the document directly since the evaluation of the associated macro results in a flag element together with the body of the comment inside an hidden element. We will discuss later on the role of the focus which wraps the content in both cases.

The hide-comment and show-comment elements provide the functional, descriptive side of the comment functionality. They are the “data structure” which encodes the comments. The scheme module (various comment-drd) give some classification of these two new elements: 

;; General groups

(define-group variant-tag
  (comment-tag))

(define-group similar-tag
  (comment-tag))

;; Comments

(define-group hidden-comment-tag
  hide-comment)

(define-group comment-tag
  hide-comment show-comment)

A new group of tags comment-tag is defined which contains both markup elements and they are declared as variants, and also as similar tags [We need to cover the variant and similar concepts in another article].

On the procedural side, the available actions on comments, is made available to the user at the level of the editor via a set of scheme procedure in the (various comment-edit) module. The procedure make-comment creates a new comment in the current-buffer and at the current position 

(tm-define (make-comment)
  (let* ((id (create-unique-id))
         (mirror-id (create-unique-id))
         (by (buffer-get-metadata (current-buffer) "author"))
         (date (number->string (current-time))))
    (insert-go-to ‘(show-comment ,id ,mirror-id
                                 "comment" ,by ,date "")
                   (list 5 0))))

Note the insert-go-to procedure, which insert a given markup and also move the cursor at the position (5 0), meaning the 6th child of the inserted subtree, i.e. the body of the comment (which is an empty string), and there in position , ready for the user to fill in the comment.

Basic operations on all the comments in a given document are provided by the following code 

(define (comment-list)
  (with-cache (change-time) :comment-list
    (if (selection-active-any?)
        (append-map search-comments (selection-trees))
        (search-comments (buffer-tree)))))

(tm-define (operate-on-comments op)
  (:applicable (nnull? (comment-list)))
  (for (c (reverse (comment-list)))
    (cond ((== op :show) (tree-assign-node c 'show-comment))
          ((== op :hide) (tree-assign-node c 'hide-comment))
          ((== op :cut) (tree-cut c)))))

In operate-on-comments the for loop cycle over all comments and according to the selected operation, it either convert all the node label to show-comment or to hide-comment, or in case (== op :cut), just remove the associated subtree, i.e. remove the comment and all its data. Note that the enumeration of all the relevant comment elements is operated by the comment-list function, which in turn uses search-comments defined as: 

(tm-define (comment-context? t)
  (and (tm-in? t (comment-tag-list))
       (== (tm-arity t) 6)))

(tm-define (search-comments t)
  (tree-search t comment-context?))

Finally, the functionalities are made available to the user via a menu and a shortcut in (various comment-menu) thanks to the code 

(menu-bind comment-menu
  ("New comment" (make-comment))
  ---
  ("First comment" (go-to-comment :first))
  ("Previous comment" (go-to-comment :previous))
  ("Next comment" (go-to-comment :next))
  ("Last comment" (go-to-comment :last))
  ---
  ("Show comments" (operate-on-comments :show))
  ("Hide comments" (operate-on-comments :hide))
  ("Remove comments" (operate-on-comments :cut))
  (with tl (comment-type-list)
    (assuming (> (length tl) 1)
      ---
      (for (tp tl)
        ((check (eval (upcase-first tp)) "v" (comment-test-type? tp))
         (comment-toggle-type tp)))))
  (with bl (comment-by-list)
    (assuming (> (length bl) 1)
      ---
      (for (by bl)
        ((check (eval by) "v" (comment-test-by? by))
         (comment-toggle-by by)))))
  ---
  ("Edit comments" (open-comments-editor)))

(kbd-map
  (:mode in-comment?)
  ("std :" (make-comment))
  ("std [" (go-to-comment :previous))
  ("std ]" (go-to-comment :next))
  ("std {" (go-to-comment :first))
  ("std }" (go-to-comment :last)))

which is loaded as soon as the package comment is used in the current document, as we have seen at the beginning of this article.

The comment buffer

We want to allow the user to see all the comments together. This is implemented via a “virtual document” which is generated on the fly using TeXmacs file system (tmfs) interface. In (various comment-edit) we find 

(tmfs-permission-handler (comments name type)
  (in? type (list "read")))

(tmfs-title-handler (comments name doc)
  (with u (tmfs-string->url name)
    (string-append (url->system (url-tail u)) " - Comments")))

(define (mirror-comment t)
  (let* ((id (if (tm-atomic? (tm-ref t 0))
                 (string-append (tm-ref t 0) "-edit")
                 (create-unique-id))))
    ‘(mirror-comment ,id ,@(cdr (tm-children t)))))

(tmfs-load-handler (comments name)
  (let* ((u (tmfs-string->url name))
         (doc (tree->stree (buffer-get u))))
    (tm-replace doc (cut tm-func? <> 'body 1)
                (lambda (t)
                  (let* ((l (tm-search t comment-context?))
                         (r (map mirror-comment l)))
                    ‘(body (document ,@r)))))))

(tm-define (open-comments-editor)
  (:applicable (comments-in-buffer))
  (let* ((u (current-buffer))
         (cu (string-append "tmfs://comments/" 
                            (url->tmfs-string u))))
    (load-buffer-in-new-window cu)))

The most important instruction here is the call to tmfs-load-handler which defines an new type of resource within the TeXmacs file system tmfs. This introduces a new URI scheme tmfs://comments/name where name is the name of the specific buffer for which we request the comments. When the user try to access this URI the handler is invoked and it returns a new document containing all the comments of the original document collected and processed via mirror-comment. This procedure replace the comment element with an element of kind mirror-comment managing some additional metainformation in order to retrive the original comment within the document. Note also the user of tmfs-title-handler and tmfs-permission-handler to set up various properties of the new comment URIs. The result is the following UI which appears to the uses as the Comment→Edit comments command is inkoved:

The rendering of the mirror-comment markup is specified in the comment package, of course:

<assign|mirror-comment|<macro|unique-id|mirror-id|type|by|time|body|<with|old-locus-color|locus-color|locus-color|preserve|<locus|<id|mirror-id>|<observer|unique-id|mirror-notify>|<surround|<hidden|<extern|mirror-initialize|<quote-arg|body>>>||<document|<with|locus-color|old-locus-color|<document|<render-box-comment|<comment-color|by>|<copy|by>|<document|body>>>>>>>>>>

Gory details

Ok, now things get serious. The actual implementation of hide-comment require some low-level tinkering in the typesetter. This will be fixed (hopefully) in the future, in such a way that the behaviour of the markup can be controlled via DRD declarations in the stylesheet language. Unfortunately this is not yet the case and we have to modify the C++ code.

The most basic change is to describe the behaviour of the markup with respect to multi-paragraph material. In src/Kernel/Types/tree.cpp we have to modify the is_multi_paragraph function as follows: 

bool
is_multi_paragraph (tree t) {
  switch (L(t)) {
  case DOCUMENT:
    return true;
  case SURROUND:
    return is_multi_paragraph (t[2]);
  case DATOMS:
  case DLINES:
  case DPAGES:
  case WITH:
  case MARK:
  case EXPAND_AS:
  case STYLE_WITH:
  case VAR_STYLE_WITH:
  case STYLE_ONLY:
  case VAR_STYLE_ONLY:
  case ACTIVE:
  case VAR_ACTIVE:
    return is_multi_paragraph (t[N(t)-1]);
  case VAR_INCLUDE:
    return true;
  case WITH_PACKAGE:
    return is_multi_paragraph (t[N(t)-1]);
  case LOCUS:
  case CANVAS:
    return is_multi_paragraph (t[N(t)-1]);
  default:
    {
      static hashset<tree_label> inline_set; // FIXME: use drd
      if (N(inline_set) == 0) {
        inline_set->insert (make_tree_label ("footnote"));
        inline_set->insert (make_tree_label ("footnote-anchor"));
        inline_set->insert (make_tree_label ("note-footnote"));
        inline_set->insert (make_tree_label ("note-footnote*"));
        inline_set->insert (make_tree_label ("hide-comment"));
        inline_set->insert (make_tree_label ("script-input"));
        inline_set->insert (make_tree_label ("converter-input"));
      }
      if (L(t) < START_EXTENSIONS) return false;
      else if (inline_set->contains (L(t))) return false;
      else {
        int i, n= N(t);
        for (i=0; i<n; i++)
          if (is_multi_paragraph (t[i]))
            return true;
        return false;
      }
    }
  }
}

in particular note the line: 

inline_set->insert (make_tree_label ("hide-comment"));

This in order to make hide-comment override the default behaviour for non-primitive markup which is to return true if all the arguments returns true to is_multi_paragraph. [Explain consequences of this predicate]

We have also to modify src/Edit/Replace/edit_select.cpp: 

path
edit_select_rep::focus_get (bool skip_flag) {
  //cout << "Search focus " << focus_p << ", " << skip_flag << "\n";
  if (!is_nil (focus_p))
    return focus_search (focus_p, skip_flag, false);
  if (selection_active_any ())
    return focus_search (selection_get_path (), skip_flag, false);
  else {
    tree st= subtree (et, path_up (tp));
    if (is_compound (st, "draw-over")) skip_flag= false;
    if (is_compound (st, "draw-under")) skip_flag= false;
    if (is_compound (st, "float")) skip_flag= false;
    if (is_compound (st, "wide-float")) skip_flag= false;
    if (is_compound (st, "footnote")) skip_flag= false;
    if (is_compound (st, "footnote-anchor")) skip_flag= false;
    if (is_compound (st, "wide-footnote")) skip_flag= false;
    if (is_compound (st, "note-footnote")) skip_flag= false;
    if (is_compound (st, "note-footnote*")) skip_flag= false;
    if (is_compound (st, "hide-comment")) skip_flag= false;
    if (is_compound (st, "cite-detail")) skip_flag= false;
    return focus_search (path_up (tp), skip_flag, true);
  }
}

and src/Edit/Modify/edit_dynamic.cpp: 

bool
edit_dynamic_rep::is_multi_paragraph_macro (tree t, bool pure) {
  int n= arity (t);
  if (is_document (t) || is_func (t, PARA) || is_func (t, SURROUND))
    return true;
  if (is_func (t, MACRO) || is_func (t, WITH) ||
      is_func (t, LOCUS) ||
      is_func (t, CANVAS) || is_func (t, ORNAMENT) || is_func (t, ART_BOX))
    return is_multi_paragraph_macro (t [n-1], pure);
  if (is_extension (t) &&
      !is_compound (t, "footnote") &&
      !is_compound (t, "footnote-anchor") &&
      !is_compound (t, "note-footnote") &&
      !is_compound (t, "note-footnote*") &&
      !is_compound (t, "hide-comment")) {
    int i;
    for (i=1; i<n; i++)
      if (is_multi_paragraph_macro (t[i], pure))
        return true;
    tree f= get_env_value (as_string (L(t)));
    return is_multi_paragraph_macro (f, pure);
  }
  if (!pure)
    if (is_func (t, ARG))
      return true;
  return false;
}
 
void
edit_dynamic_rep::make_compound (tree_label l, int n= -1) {
  //cout << "Make compound " << as_string (l) << ", " << n << "\n";
  eval ("(use-modules (generic generic-edit))");
  if (n == -1) {
    for (n=0; true; n++) {
      if (drd->correct_arity (l, n) &&
          ((n>0) || (drd->get_arity_mode (l) == ARITY_NORMAL))) break;
      if (n == 100) return;
    }
  }

  tree t (l, n);
  path p (0, 0);
  int  acc=0;
  for (; acc<n; acc++)
    if (drd->is_accessible_child (t, acc))
      break;
  if (acc<n) p->item= acc;
  if (n == 0) insert_tree (t, 1);
  else if (is_with_like (t) && as_bool (call ("with-like-check-insert", t)));
  else {
    string s= as_string (l);
    tree f= get_env_value (s);
    bool block_macro= (N(f) == 2) && is_multi_paragraph_macro (f, true);
    bool large_macro= (N(f) == 2) && is_multi_paragraph_macro (f, false);
    bool table_macro= (N(f) == 2) && contains_table_format (f[1], f[0]);
    // FIXME: why do we take the precaution N(f) == 2 ?
    if (s == "explain") block_macro= true;

    tree sel= "";
    if (selection_active_small () ||
        (large_macro && selection_active_normal ()))
      sel= selection_get_cut ();
    else if (is_with_like (t) && selection_active_normal ()) {
      sel= selection_get_cut ();
      t[n-1]= sel;
      insert_tree (t, p);
      return;
    }
    if ((block_macro && (!table_macro)) ||
        (l == make_tree_label ("footnote")) ||
        (l == make_tree_label ("footnote-anchor")) ||
        (l == make_tree_label ("note-footnote")) ||
        (l == make_tree_label ("note-footnote*")) ||
        (l == make_tree_label ("hide-comment")))
      {
        t[0]= tree (DOCUMENT, "");
        p   = path (0, 0, 0);
      }
    if (!drd->all_accessible (l))
      if (get_init_string (MODE) != "src" && !inside ("show-preamble")) {
        t= tree (INACTIVE, t);
        p= path (0, p);
      }
    insert_tree (t, p);
    if (table_macro) make_table (1, 1);
    if (sel != "") insert_tree (sel, end (sel));
    
    tree mess= concat ();
    if (drd->get_arity_mode (l) != ARITY_NORMAL)
      mess= concat (kbd ("A-right"), ": insert argument");
    if (!drd->all_accessible (l)) {
      if (mess != "") mess << ", ";
      mess << kbd ("return") << ": activate";
    }
    if (mess == concat ()) mess= "Move to the right when finished";
    set_message (mess, drd->get_name (l));
  }
}

And finally src/Edit/Modify/edit_delete.cpp 

void
edit_text_rep::remove_text_sub (bool forward) {
  path p;
  int  last, rix;
  tree t, u;
  get_deletion_point (p, last, rix, t, u, forward);

  // multiparagraph delete
  if (is_document (t)) {
    if ((forward && (last >= rix)) || ((!forward) && (last == 0))) {
      if (rp < p) {
        tree u= subtree (et, path_up (p));
        if (is_func (u, _FLOAT) || is_func (u, WITH) ||
            is_func (u, STYLE_WITH) || is_func (u, VAR_STYLE_WITH) ||
            is_func (u, LOCUS) || is_func (u, INCLUDE) ||
            is_extension (u))
          {
            if (is_extension (u) && (N(u) > 1)) {
              int i, n= N(u);
              bool empty= true;
              for (i=0; i<n; i++)
                empty= empty && ((u[i]=="") || (u[i]==tree (DOCUMENT, "")));
              if (!empty) {
                if (forward) go_to (next_valid (et, tp));
                else go_to (previous_valid (et, tp));
                return;
              }
            }
            if (t == tree (DOCUMENT, "")) {
              if (is_func (u, _FLOAT) ||
                  is_compound (u, "footnote", 1) ||
                  is_compound (u, "footnote-anchor", 2) ||
                  is_compound (u, "note-footnote") ||
                  is_compound (u, "note-footnote*") ||
                  is_compound (u, "hide-comment")) {
                assign (path_up (p), "");
                correct (path_up (p, 2));
              }
              else if (is_document (subtree (et, path_up (p, 2))))
                assign (path_up (p), "");
              else assign (path_up (p), tree (DOCUMENT, ""));
              if (is_func (subtree (et, path_up (p, 2)), INACTIVE))
                remove_structure (forward);
            }
            else go_to_border (path_up (p), !forward);
          }
        else if (is_func (u, TABLE) || is_func (u, SUBTABLE) ||
                 is_func (u, CELL) || is_func (u, ROW) ||
                 is_func (u, TFORMAT)) {
          if (t == tree (DOCUMENT, ""))
            back_in_table (u, p, forward);
        }
        else if (is_func (u, DOCUMENT_AT))
          back_in_text_at (u, p, forward);
      }
      return;
    }
    else {
      int l1= forward? last: last-1;
      int l2= forward? last+1: last;
      if (is_multi_paragraph_or_sectional (subtree (et, p * l1)) ||
          is_multi_paragraph_or_sectional (subtree (et, p * l2)))
        {
          if (subtree (et, p * l1) == "") remove (p * l1, 1);
          else {
            if (subtree (et, p * l2) == "") remove (p * l2, 1);
            if (!forward) go_to_end (p * l1);
            else if (last < N (subtree (et, p)) - 1) go_to_start (p * l2);
          }
        }
      else remove_return (p * l1);
    }
    return;
  }

  // deleting text
  if (forward && is_atomic (t) && (last != rix)) {
    language lan= get_env_language ();
    int end= last;
    tm_char_forwards (t->label, end);
    remove (p * last, end-last);
    correct (path_up (p));
    return;
  }

  if ((!forward) && is_atomic (t) && (last != 0)) {
    language lan= get_env_language ();
    int start= last;
    tm_char_backwards (t->label, start);
    remove (p * start, last-start);
    correct (path_up (p));
    return;
  }

  // deletion governed by parent t
  if (last == (forward? 0: 1))
    switch (L(t)) {
    case RAW_DATA:
    case HSPACE:
    case VAR_VSPACE:
    case VSPACE:
    case SPACE:
    case HTAB:
      back_monolithic (p);
      return;
    case AROUND:
    case VAR_AROUND:
    case BIG_AROUND:
      back_around (t, p, forward);
      return;
    case LEFT:
    case MID:
    case RIGHT:
    case BIG:
      back_monolithic (p);
      return;
    case LPRIME:
    case RPRIME:
      back_prime (t, p, forward);
      return;
    case WIDE:
    case VAR_WIDE:
      go_to_border (p * 0, forward);
      return;
    case TFORMAT:
    case TABLE:
    case ROW:
    case CELL:
    case SUBTABLE:
      back_table (p, forward);
      return;
    case WITH:
    case STYLE_WITH:
    case VAR_STYLE_WITH:
    case LOCUS:
      go_to_border (p * (N(t) - 1), forward);
      return;
    case VALUE:
    case QUOTE_VALUE:
    case ARG:
    case QUOTE_ARG:
      if (N(t) == 1) back_monolithic (p);
      else back_general (p, forward);
      return;
    default:
      if (is_compound (t, "separating-space", 1)) back_monolithic (p);
      else if (is_compound (t, "application-space", 1)) back_monolithic (p);
      else back_general (p, forward);
      break;
    }

  // deletion depends on children u
  if (last == (forward? rix: 0)) {
    switch (L (u)) {
    case AROUND:
    case VAR_AROUND:
    case BIG_AROUND:
      back_in_around (u, p, forward);
      return;
    case LONG_ARROW:
      back_in_long_arrow (u, p, forward);
      return;
    case WIDE:
    case VAR_WIDE:
      back_in_wide (u, p, forward);
      return;
    case TREE:
      back_in_tree (u, p, forward);
      return;
    case TFORMAT:
    case TABLE:
    case ROW:
    case CELL:
    case SUBTABLE:
      back_in_table (u, p, forward);
      return;
    case WITH:
    case STYLE_WITH:
    case VAR_STYLE_WITH:
    case LOCUS:
      back_in_with (u, p, forward);
      return;
    default:
      if (is_graphical_text (u))
        back_in_text_at (u, p, forward);
      else if (is_compound (u, "cell-inert") ||
               is_compound (u, "cell-input") ||
               is_compound (u, "cell-output")) {
        tree st= subtree (et, path_up (p, 2));
        back_in_table (u, p, forward);
      }
      else
        back_in_general (u, p, forward);
      break;
    }
  }
}