Added context buttons.

[lurk.git] / murk.el

diff --git a/murk.el b/murk.el
index 20d8b06..b438aa3 100644 (file)
--- a/murk.el
+++ b/murk.el
@@ -599,6 +599,23 @@ The head of this list is always the current context.")
                        'invisible context-atom)))))))
   (murk-scroll-windows-to-last-line))
 
+(defun murk-click-context (button)
+  (murk-switch-to-context (button-get button 'context))
+  (murk-highlight-current-context)
+  (murk-render-prompt)
+  (if murk-zoomed
+      (murk-zoom-in (murk-current-context))))
+
+(defun murk-make-context-button (context &optional string)
+  (with-temp-buffer
+    (let ((label (or string (murk-context->string context))))
+      (insert-text-button label
+                          'action #'murk-click-context
+                          'context context
+                          'follow-link t
+                          'help-echo "Switch context"))
+    (buffer-string)))
+
 (defun murk-display-message (network from to text)
   (let ((context (if (string-prefix-p "#" to)
                      (murk-get-context network to)
@@ -608,7 +625,9 @@ The head of this list is always the current context.")
      (propertize
       (if (murk-network-context-p context)
           (concat "[" from "->" to "]")
-        (concat (murk-context->string context) " <" from ">"))
+        (concat
+         (murk-make-context-button context)
+         " <" from ">"))
       'face (murk-get-context-facelist context))
      text)))