1 files changed, 66 insertions, 18 deletions

diff --git a/pinentry-rofi.scm b/pinentry-rofi.scm
index 8490bb9..0c4a355 100755
--- a/pinentry-rofi.scm
+++ b/pinentry-rofi.scm
@@ -59,10 +59,26 @@
   "Evaluates to #t if string is empty."
   (string=? str ""))
 
+(define (pinentry-remove-underline str)
+  "Replace _ followed by a character with just the character."
+  (regexp-substitute/global #f "(^|[[:blank:]])_([[:alpha:]])" str
+                            'pre 1 2 'post))
+
+(define (pinentry-escape-underscore str)
+  "Replace __ followed by a character with _ and said character.
+Always call this after `pinentry-remove-underline' or
+`html-underline'."
+  (regexp-substitute/global #f "(^|[[:blank:]])__([[:alpha:]])" str
+                            'pre 1 "_" 2 'post))
+
 (define (html-newline str)
   "Replace %0A with 
"
   (regexp-substitute/global #f "%0A" str 'pre "
" 'post))
 
+(define (html-underline str)
+  "Underscore followed by a character, underlines that character."
+  (regexp-substitute/global #f "(^|[[:blank:]])_([[:alpha:]])" str
+                            'pre 1"<u>"2"</u>" 'post))
 (define (html-< str)
   "Replace < with &lt;"
   (regexp-substitute/global #f "<" str 'pre "&lt;" 'post))
@@ -77,7 +93,32 @@
 
 (define (pango-markup str)
   "Transform string to pango."
-  (hex->char (html-< (html-newline str))))
+  (hex->char
+   (pinentry-escape-underscore
+    (html-underline
+     (html-<
+      (html-newline str))))))
+
+(define (input-string str)
+  "Transform string to input for rofi.
+Input strings does not support pango markup"
+  (pinentry-escape-underscore
+   (pinentry-remove-underline str)))
+
+(define* (pinentry-set set-func pinentry label)
+  "Using SET-FUNC, set the entry in PINENTRY to LABEL."
+  (set-func pinentry label)
+  (set-pinentry-ok! pinentry #t))
+
+(define (pinentry-set-button set-func pinentry label)
+  "Using SET-BUTTON-FUNC, set the entry in PINENTRY to LABEL.
+LABEL will be transformed using `input-string'"
+  (pinentry-set set-func pinentry (input-string label)))
+
+(define (pinentry-set-mesg set-func pinentry label)
+  "Using SET-FUNC, set the entry in PINENTRY to LABEL.
+LABEL will be transformed using `pango-markup'"
+  (pinentry-set set-func pinentry (pango-markup label)))
 
 (define (pinentry-option pinentry line)
   "Process line if it starts with OPTION.
@@ -152,9 +193,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
   (let ((setok-button-re (make-regexp "^SETOK (.+)$"))
         (regex-match #f))
     (when (set-and-return! regex-match (regexp-exec setok-button-re line))
-      (let ((label (pango-markup (match:substring regex-match 1))))
-        (set-pinentry-ok-button! pinentry label)
-        (set-pinentry-ok! pinentry #t)))
+      (pinentry-set-button
+       set-pinentry-ok-button!
+       pinentry
+       (match:substring regex-match 1)))
     regex-match))
 
 (define (pinentry-setcancel pinentry line)
@@ -162,9 +204,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
   (let ((setcancel-button-re (make-regexp "^SETCANCEL (.+)$"))
         (regex-match #f))
     (when (set-and-return! regex-match (regexp-exec setcancel-button-re line))
-      (let ((label (pango-markup (match:substring regex-match 1))))
-        (set-pinentry-cancel-button! pinentry label)
-        (set-pinentry-ok! pinentry #t)))
+      (pinentry-set-button
+       set-pinentry-cancel-button!
+       pinentry
+       (match:substring regex-match 1)))
     regex-match))
 
 (define (pinentry-setnotok pinentry line)
@@ -172,9 +215,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
   (let ((setnotok-button-re (make-regexp "^SETNOTOK (.+)$"))
         (regex-match #f))
     (when (set-and-return! regex-match (regexp-exec setnotok-button-re line))
-      (let ((label (pango-markup (match:substring regex-match 1))))
-        (set-pinentry-notok-button! pinentry label)
-        (set-pinentry-ok! pinentry #t)))
+      (pinentry-set-button
+       set-pinentry-notok-button!
+       pinentry
+       (match:substring regex-match 1)))
     regex-match))
 
 (define (pinentry-setdesc pinentry line)
@@ -182,9 +226,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
   (let ((setdesc-re (make-regexp "^SETDESC (.+)$"))
         (regex-match #f))
     (when (set-and-return! regex-match (regexp-exec setdesc-re line))
-      (let ((mesg (pango-markup (match:substring regex-match 1))))
-        (set-pinentry-desc! pinentry mesg))
-      (set-pinentry-ok! pinentry #t))
+      (pinentry-set-mesg
+       set-pinentry-desc!
+       pinentry
+       (match:substring regex-match 1)))
     regex-match))
 
 (define (pinentry-seterror pinentry line)
@@ -192,9 +237,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
   (let ((seterror-re (make-regexp "^SETERROR (.+)$"))
         (regex-match #f))
     (when (set-and-return! regex-match (regexp-exec seterror-re line))
-      (let ((mesg (pango-markup (match:substring regex-match 1))))
-        (set-pinentry-error! pinentry mesg)
-        (set-pinentry-ok! pinentry #t)))
+      (pinentry-set-mesg
+       set-pinentry-error!
+       pinentry
+       (match:substring regex-match 1)))
     regex-match))
 
 (define (pinentry-setprompt pinentry line)
@@ -202,8 +248,10 @@ touch-file=/run/user/1000/gnupg/S.gpg-agent"
   (let ((setprompt-re (make-regexp "^SETPROMPT (.+)$"))
         (regex-match #f))
     (when (set-and-return! regex-match (regexp-exec setprompt-re line))
-      (set-pinentry-prompt! pinentry (match:substring regex-match 1))
-      (set-pinentry-ok! pinentry #t))
+      (pinentry-set-mesg
+       set-pinentry-prompt!
+       pinentry
+       (match:substring regex-match 1)))
     regex-match))
 
 (define (pinentry-getpin pinentry line)