Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add a markup directive for hyperlinks #72

Open
dbuenzli opened this issue Feb 1, 2017 · 2 comments
Open

Add a markup directive for hyperlinks #72

dbuenzli opened this issue Feb 1, 2017 · 2 comments

Comments

@dbuenzli
Copy link
Owner

dbuenzli commented Feb 1, 2017

For groff output .ue/.ur can be used to render them.

@dbuenzli
Copy link
Owner Author

dbuenzli commented Feb 2, 2017

It's seems osx doesn't have these macros. www.tmac could be used but I'm unsure about portability.

@dbuenzli
Copy link
Owner Author

dbuenzli commented Mar 9, 2025

For reference here is an older attempt. That no longer applies cleanly.

From 0f28be29e8b1f1b4979bc9c15184ba3982a964db Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20B=C3=BCnzli?= <daniel.buenzli@erratique.ch>
Date: Thu, 2 Feb 2017 13:22:53 +0100
Subject: [PATCH] man doc: support for hyperlinks (#72).

---
 src/cmdliner.mli        |  2 ++
 src/cmdliner_manpage.ml | 53 +++++++++++++++++++++++++++++++----------
 test/man_test.ml        |  3 +++
 3 files changed, 45 insertions(+), 13 deletions(-)

diff --git a/src/cmdliner.mli b/src/cmdliner.mli
index af0a9de..b558f43 100644
--- a/src/cmdliner.mli
+++ b/src/cmdliner.mli
@@ -812,6 +812,8 @@ markup language.
 {ul
 {- Markup directives [$(i,text)] and [$(b,text)], where [text] is raw
    text respectively rendered in italics and bold.}
+{- Markup directive [$(h, uri text)] for hyperlinks, where [uri] is an URI
+   and [text] raw linked text. Whitespace surrounding [uri] is ignored.}
 {- Outside markup directives, context dependent variables of the form
    [$(var)] are substituted by marked up data. For example in a term's
    manpage [$(tname)] is substituted by the term name in bold.}
diff --git a/src/cmdliner_manpage.ml b/src/cmdliner_manpage.ml
index a72805c..88a03b3 100644
--- a/src/cmdliner_manpage.ml
+++ b/src/cmdliner_manpage.ml
@@ -175,8 +175,9 @@ let err_illegal_esc c s = invalid_arg (strf "Illegal escape char %C in %S" c s)
 let err_markup dir s =
   invalid_arg (strf "Unknown cmdliner markup $(%c,...) in %S" dir s)
 
-let is_markup_dir = function 'i' | 'b' -> true | _ -> false
+let is_markup_dir = function 'i' | 'b' | 'h' -> true | _ -> false
 let is_markup_esc = function '$' | '\\' | '(' | ')' -> true | _ -> false
+let is_markup_white = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false
 let markup_need_esc = function '\\' | '$' -> true | _ -> false
 let markup_text_need_esc = function '\\' | '$' | ')' -> true | _ -> false
 
@@ -256,7 +257,12 @@ let add_markup_esc k b s start next target_need_escape target_escape =
       (if target_need_escape c then target_escape b c else Buffer.add_char b c);
       k (next + 1) (next + 1)
 
-let add_markup_text k b s start target_need_escape target_escape =
+let rec skip_markup_white s i =
+  if i >= String.length s || not (is_markup_white s.[i]) then i else
+  skip_markup_white s (i + 1)
+
+let add_markup_text
+    ?(until = fun _ -> false) k b s start target_need_escape target_escape =
   let max_i = String.length s - 1 in
   let flush start stop = match start > max_i with
   | true -> ()
@@ -269,6 +275,7 @@ let add_markup_text k b s start target_need_escape target_escape =
     | '\\' -> (* unescape *)
         flush start (i - 1);
         add_markup_esc loop b s start next target_need_escape target_escape
+    | c when until c -> flush start (i - 1); k i i
     | ')' -> flush start (i - 1); k next next
     | c when markup_text_need_esc c -> err_unescaped c s
     | c when target_need_escape c ->
@@ -367,7 +374,23 @@ let markup_to_groff b s =
   in
   let need_escape = function '.' | '\'' | '-' | '\\' -> true | _ -> false in
   let escape b c = Printf.bprintf b "\\N'%d'" (Char.code c) in
-  let rec end_text start i = Buffer.add_string b "\\fR"; loop start i
+  let add_uri start =
+    let until c = is_markup_white c || c = ')' in
+    let start_uri = skip_markup_white s start in
+    let need_escape c = false in
+    let find_start_data i _ =
+      Buffer.add_string b " \""; skip_markup_white s i in
+    Buffer.add_string b "\n.URL ";
+    add_markup_text find_start_data ~until b s start_uri
+      need_escape escape
+  in
+  let rec end_text markup start i =
+    begin match markup with
+    | 'i' | 'b' -> Buffer.add_string b "\\fR"
+    | 'h' -> Buffer.add_string b "\"\n"
+    | _ -> assert false
+    end;
+    loop start i
   and loop start i =
     if i > max_i then flush start max_i else
     let next = i + 1 in
@@ -384,13 +407,16 @@ let markup_to_groff b s =
             begin match s.[min] with
             | ','  ->
                 let start_data = min + 1 in
+                let markup = s.[min - 1] in
                 flush start (i - 1);
-                begin match s.[min - 1] with
-                | 'i' -> Buffer.add_string b "\\fI"
-                | 'b' -> Buffer.add_string b "\\fB"
+                let start_data =  match markup with
+                | 'i' -> Buffer.add_string b "\\fI"; start_data
+                | 'b' -> Buffer.add_string b "\\fB"; start_data
+                | 'h' -> add_uri start_data
                 | markup -> err_markup markup s
-                end;
-                add_markup_text end_text b s start_data need_escape escape
+                in
+                add_markup_text (end_text markup)
+                  b s start_data need_escape escape
             | _ -> err_malformed s
             end
         | _ -> err_unescaped '$' s
@@ -406,22 +432,23 @@ let doc_to_groff b ~subst s = markup_to_groff b (subst_vars b subst s)
 
 let pp_groff_blocks subst ppf text =
   let buf = Buffer.create 1024 in
-  let markup t = doc_to_groff ~subst buf t in
-  let pp_tokens ppf t = pp_tokens ~spaces:false ppf t in
+  let tokens t = Format.asprintf "%a" (pp_tokens ~spaces:false) t in
+  let markup t = doc_to_groff ~subst buf (tokens t) in
   let rec pp_block = function
   | `Blocks bs -> List.iter pp_block bs (* not T.R. *)
-  | `P s -> pf ppf "@\n.P@\n%a" pp_tokens (markup s)
+  | `P s -> pf ppf "@\n.P@\n%a" pp_lines (markup s)
   | `Pre s -> pf ppf "@\n.P@\n.nf@\n%a@\n.fi" pp_lines (markup s)
-  | `S s -> pf ppf "@\n.SH %a" pp_tokens (markup s)
+  | `S s -> pf ppf "@\n.SH %a" pp_lines (markup s)
   | `Noblank -> pf ppf "@\n.sp -1"
   | `I (l, s) ->
-      pf ppf "@\n.TP 4@\n%a@\n%a" pp_tokens (markup l) pp_tokens (markup s)
+      pf ppf "@\n.TP 4@\n%a@\n%a" pp_lines (markup l) pp_lines (markup s)
   in
   List.iter pp_block text
 
 let pp_groff_page subst ppf ((n, s, a1, a2, a3), t) =
   pf ppf ".\\\" Pipe this output to groff -man -Tutf8 | less@\n\
           .\\\"@\n\
+          .mso www.tmac@\n\
           .TH \"%s\" %d \"%s\" \"%s\" \"%s\"@\n\
           .\\\" Disable hyphenation and ragged-right@\n\
           .nh@\n\
diff --git a/test/man_test.ml b/test/man_test.ml
index c48844b..dfceb0c 100644
--- a/test/man_test.ml
+++ b/test/man_test.ml
@@ -73,6 +73,9 @@ let info =
           +---+";
     `P "These are escapes escaped \\$ \\( \\) \\\\";
     `P "() does not need to be escaped outside directives.";
+    `P "This $(h,http://example.org) is an URI, this is
+        $(h, http://example.org linked
+        text).";
     `Blocks [
       `P "The following to paragraphs are spliced in.";
       `P "This dollar needs escape \\$(var) this one aswell $(b,\\$(bla\\))";
-- 
2.39.5 (Apple Git-154)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant