ELPA: new package svg-tag-mode

ELPA: new package svg-tag-mode

[Nicolas P. Rougier (inria)]

Dear all,

I would like to submit a new package to ELPA which is a minor mode 
for replacing user-defined keywords with SVG generated tags 
(static or dynamics) that can be activated with mouse. Tags can be 
generated using the svg-lib package (a helper function is provided 
to ease the generation) but any valid svg-image can be used.

The sources are hosted at https://github.com/rougier/svg-tag-mode 
and
the README displays what it looks like.

Best,
Nicolas.

Re: ELPA: new package svg-tag-mode

[Stefan Monnier]

> I would like to submit a new package to ELPA which is a minor mode for
> replacing user-defined keywords with SVG generated tags (static or dynamics)
> that can be activated with mouse. Tags can be generated using the svg-lib
> package (a helper function is provided to ease the generation) but any valid
> svg-image can be used.
>
> The sources are hosted at https://github.com/rougier/svg-tag-mode and
> the README displays what it looks like.

Added, thanks.

The `svg-tag-tags` structure (and the provided examples) encourages the
use of code-hidden-inside-data, i.e. code that will never be exposed
to things like flymake or the byte-compiler :-(

See also patch below,


        Stefan


diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..5c7e55e2bf
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+*.elc
+/svg-tag-mode-autoloads.el
+/svg-tag-mode-pkg.el
diff --git a/svg-tag-mode.el b/svg-tag-mode.el
index bc0c84da96..690cad80eb 100644
--- a/svg-tag-mode.el
+++ b/svg-tag-mode.el
@@ -128,8 +128,7 @@
   "Action to be executed when the cursor enter a tag area"
   :type '(radio (const :tag "Edit tag"  edit)
                 (const :tag "Echo tag"  echo)
-                (const :tag "No action" nil))
-  :group 'svg-tag)
+                (const :tag "No action" nil)))
 
 
 (defcustom svg-tag-tags
@@ -141,7 +140,6 @@ of a regular expression and tag can be either a svg tag
 previously created by `svg-tag-make' or a function that takes a
 string as argument and returns a tag.  When tag is a function, this
 allows to create dynamic tags."
-  :group 'svg-tag
   :type '(repeat (cons (string :tag "Keyword")
                        (list (sexp     :tag "Tag")
                              (sexp     :tag "Command")
@@ -175,6 +173,8 @@ allows to create dynamic tags."
          (tag (string-trim tag))
          (beg (or (plist-get args :beg) 0))
          (end (or (plist-get args :end) nil))
+         ;; FIXME: What guarantees that `org-plist-delete' is defined at
+         ;; this point?
          (args (org-plist-delete args 'stroke))
          (args (org-plist-delete args 'foreground))
          (args (org-plist-delete args 'background))
@@ -193,7 +193,7 @@ allows to create dynamic tags."
                    :background (face-background face nil 'default)
                    args))))
 
-(defun svg-tag--cursor-function (win position direction)
+(defun svg-tag--cursor-function (_win position direction)
   "This function hides the tag when cursor is over it, allowing
  to edit it."
   (let ((beg (if (eq direction 'entered)
@@ -230,9 +230,11 @@ allows to create dynamic tags."
       (setq tag `(,tag (match-string 1))))
     (setq tag ``(face nil
                  display ,,tag
-                 cursor-sensor-functions ,'(svg-tag--cursor-function)
+                 cursor-sensor-functions (svg-tag--cursor-function)
                  ,@(if ,callback '(pointer hand))
                  ,@(if ,help `(help-echo ,,help))
+                 ;; FIXME: Don't hard-code the internal representation
+                 ;; of keymaps.
                  ,@(if ,callback `(keymap (keymap (mouse-1  . ,,callback))))))
     `(,pattern 1 ,tag)))
 
@@ -240,12 +242,12 @@ allows to create dynamic tags."
   "This applies remove-text-properties with 'display removed from props"
   (apply oldfun start end (org-plist-delete props 'display) args))
 
-(defun svg-tag--remove-text-properties-on (args)
+(defun svg-tag--remove-text-properties-on (_args)
   "This installs an advice around remove-text-properties"
   (advice-add 'remove-text-properties
               :around #'svg-tag--remove-text-properties))
 
-(defun svg-tag--remove-text-properties-off (args)
+(defun svg-tag--remove-text-properties-off (_args)
   "This removes the advice around remove-text-properties"
   (advice-remove 'remove-text-properties
                  #'svg-tag--remove-text-properties))
@@ -270,6 +272,8 @@ allows to create dynamic tags."
   ;; Install advices on remove-text-properties (before & after). This
   ;; is a hack to prevent org mode from removing SVG tags that use the
   ;; 'display property
+  ;; FIXME: Use an `:around' advice, so you can use `unwind-protect'
+  ;; to make sure we don't end up with the advice still applied.
   (advice-add 'org-fontify-meta-lines-and-blocks
             :before #'svg-tag--remove-text-properties-on)
   (advice-add 'org-fontify-meta-lines-and-blocks
@@ -298,6 +302,7 @@ allows to create dynamic tags."
                  #'svg-tag--remove-text-properties-on)
   (advice-remove 'org-fontify-meta-lines-and-blocks
                  #'svg-tag--remove-text-properties-off)
+  ;; FIXME: Why?
   (remove-hook 'org-babel-after-execute-hook 'org-redisplay-inline-images)
   
   ;; Redisplay everything to hide tags

Re: ELPA: new package svg-tag-mode

[Nicolas P. Rougier (inria)]

Hi Stefan,

Thanks for the code review. I applied most of your patches and 
fixme comments but I've a few questions:

Stefan Monnier <monnier@iro.umontreal.ca> writes:
> The `svg-tag-tags` structure (and the provided examples) 
> encourages the
> use of code-hidden-inside-data, i.e. code that will never be 
> exposed
> to things like flymake or the byte-compiler :-(

You mean there might be a better structure or is the whole concept 
"flawed"?

> (defun svg-tag--build-keywords (item)
>   "Process an item in order to install it as a new keyword."
>     
>   (let* ((pattern  (if (string-match "\\\\(.+\\\\)" (car item))
>                        (car item)
>                      (format "\\(%s\\)" (car item))))
>          (tag      (nth 0 (cdr item)))
>          (callback (nth 1 (cdr item)))
>          (help     (nth 2 (cdr item))))
>     (when (or (functionp tag) (and (symbolp tag) (fboundp tag)))
>         (setq tag `(,tag (match-string 1))))
>      (setq tag ``(face nil
>                   display ,,tag
>                   cursor-sensor-functions 
>                   (svg-tag--cursor-function)
>                   ,@(if ,callback '(pointer hand))
>                   ,@(if ,help `(help-echo ,,help))
> +                 ;; FIXME: Don't hard-code the internal 
> representation
> +                 ;; of keymaps.
>                   ,@(if ,callback `(keymap (keymap (mouse-1 
>                   . ,,callback))))))
>      `(,pattern 1 ,tag)))

I had a hard time to make this to work and I did not find a proper 
solution with the use of a local sparse keymap (maybe there's an 
obvious solution but I get lost with `` and ,,). What would be a 
clean solution?

Nicolas

Re: ELPA: new package svg-tag-mode

[Stefan Monnier]

>> The `svg-tag-tags` structure (and the provided examples) encourages the
>> use of code-hidden-inside-data, i.e. code that will never be exposed
>> to things like flymake or the byte-compiler :-(
>
> You mean there might be a better structure or is the whole concept "flawed"?

Not sure if there's a much better option, but I'd suggest you use
backquote+unquotes in your examples as in

;; (setq svg-tag-tags
;;       `(("\\(:[A-Z]+:\\)" . (,(lambda (tag)
;;                                (svg-tag-make tag :beg 1 :end -1))))))

and avoid "expressions", i.e. prefer

;; (setq svg-tag-tags
;;       `((":HELLO:" ,(lambda (_tag) (svg-tag-make "HELLO"))
;;                    ,(lambda () (interactive) (message "Hello world!"))
;;                    "Print a greeting message"))))

over

;; (setq svg-tag-tags
;;       '((":HELLO:" .  ((svg-tag-make "HELLO")
;;                        (lambda () (interactive) (message "Hello world!"))
;;                        "Print a greeting message"))))

would you could even disallow, as in the patch below.

>>                   ,@(if ,help `(help-echo ,,help))
>> +                 ;; FIXME: Don't hard-code the internal representation
>> +                 ;; of keymaps.
>>                   ,@(if ,callback `(keymap (keymap (mouse-1
>> . ,,callback))))))
>>      `(,pattern 1 ,tag)))
>
> I had a hard time to make this to work and I did not find a proper solution
> with the use of a local sparse keymap (maybe there's an obvious solution but
> I get lost with `` and ,,). What would be a clean solution?

I hate double backquotes so I'd recommend rewriting the code to avoid
them, but the patch below might get you started.


        Stefan


diff --git a/svg-tag-mode.el b/svg-tag-mode.el
index cf2c236bb9..668570dede 100644
--- a/svg-tag-mode.el
+++ b/svg-tag-mode.el
@@ -234,11 +234,13 @@ allows to create dynamic tags."
   (let* ((pattern  (if (string-match "\\\\(.+\\\\)" (car item))
                        (car item)
                      (format "\\(%s\\)" (car item))))
-         (tag      (nth 0 (cdr item)))
+         (tag      `(funcall ',(nth 0 (cdr item)) (match-string 1)))
          (callback (nth 1 (cdr item)))
+         (map (when callback
+                (let ((map (make-sparse-keymap)))
+                  (define-key map [mouse-1] callback)
+                  map)))
          (help     (nth 2 (cdr item))))
-    (when (or (functionp tag) (and (symbolp tag) (fboundp tag)))
-      (setq tag `(,tag (match-string 1))))
     (setq tag ``(face nil
                  display ,,tag
                  cursor-sensor-functions (svg-tag--cursor-function)
@@ -246,7 +248,7 @@ allows to create dynamic tags."
                  ,@(if ,help `(help-echo ,,help))
                  ;; FIXME: Don't hard-code the internal representation
                  ;; of keymaps.
-                 ,@(if ,callback `(keymap (keymap (mouse-1  . ,,callback))))))
+                 ,@',(if map `(keymap ,map))))
     `(,pattern 1 ,tag)))
 
 (defun svg-tag--remove-text-properties (oldfun start end props &rest args)