From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Wed, 30 Jun 2021 12:20:06 +0000 (+0200)
Subject: Fixed some bugs, added POC context highlighting.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=196c35ccc896c9c166619ef6baee88dcbb02727d;p=lurk.git

Fixed some bugs, added POC context highlighting.
---

diff --git a/lurk.el b/lurk.el
index 82a43f2..e519f46 100644
--- a/lurk.el
+++ b/lurk.el
@@ -391,7 +391,9 @@ portion of the source component of the message, as LURK doesn't use this.")
 ;;
 
 (defun lurk-display-message (from to text)
-  (let ((context (if (equal from lirc-nick) to from)))
+  (let ((context (if (eq 'channel (lurk-get-context-type to))
+                     to
+                   (if (equal to lurk-nick) from to))))
     (lurk-display-string
      (propertize
       (pcase (lurk-get-context-type to)
@@ -400,13 +402,15 @@ portion of the source component of the message, as LURK doesn't use this.")
         (_
          (error "Unsupported context type")))
       'face 'lurk-text
-      'help-echo (concat "Context: " to)))))
+      'help-echo (concat "Context: " context)
+      'context context))))
 
 (defun lurk-display-notice (context &rest notices)
   (lurk-display-string
    (propertize
     (concat lurk-notice-prefix " " (apply #'concat notices))
-    'help-echo (concat "Context: " (or context "none")))))
+    'help-echo (concat "Context: " (or context "none"))
+    'context context)))
 
 (defun lurk-display-error (&rest messages)
   (lurk-display-string
@@ -414,6 +418,25 @@ portion of the source component of the message, as LURK doesn't use this.")
            (propertize (apply #'concat messages)
                        'face 'lurk-error))))
 
+(defun lurk-highlight-context (context)
+  (with-current-buffer "*lurk*"
+    (let* ((pos lurk-prompt-marker)
+           (nextpos (previous-single-property-change pos 'context))
+           (inhibit-read-only t))
+      (while (> pos nextpos)
+        (let ((thiscontext (get-text-property nextpos 'context)))
+          (if thiscontext
+              (if (equal context thiscontext)
+                  (add-text-properties nextpos pos
+                                       '(face (foreground-color . "green")))
+                (add-text-properties nextpos pos
+                                     '(face (foreground-color . "blue"))))
+            (add-text-properties nextpos pos
+                                 '(face lurk-text)))
+          thiscontext
+          (setq pos nextpos)
+          (setq nextpos (previous-single-property-change pos 'context nil 1)))))))
+
 ;;; Message evaluation
 ;;
 
@@ -436,9 +459,12 @@ portion of the source component of the message, as LURK doesn't use this.")
          (lurk-add-context-users channel names)))
 
       ("366" ; ENDOFNAMES
-       (lurk-display-notice nil
-        (lurk--as-string (length (lurk-get-context-users lurk-current-context)))
-        " users in " lurk-current-context))
+       (let* ((params (lurk-msg-params msg))
+              (channel (elt params 1)))
+         (lurk-display-notice
+          channel
+          (lurk--as-string (length (lurk-get-context-users channel)))
+          " users in " channel)))
 
       ((rx (= 3 (any digit)))
        (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " ")))
@@ -448,7 +474,7 @@ portion of the source component of the message, as LURK doesn't use this.")
        (let ((channel (car (lurk-msg-params msg))))
          (lurk-add-context channel)
          (setq lurk-current-context channel)
-         (lurk-display-notice nil "Joining channel " channel)
+         (lurk-display-notice channel "Joining channel " channel)
          (lurk-render-prompt)))
 
       ("JOIN"