Fixed initial invisibility status.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 347258e..e76c5d1 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -1,4 +1,4 @@
-;;; lurk.el --- Little Unified iRc Klient -*- lexical-binding:t -*-
+;;; lurk.el --- Little Uni-buffer iRc Klient -*- lexical-binding:t -*-
 
 ;; Copyright (C) 2021 Tim Vaughan
 
@@ -62,25 +62,21 @@
 ;;
 
 (defface lurk-text
-  '((t :inherit font-lock-preprocessor-face))
+  '((t :inherit default))
   "Face used for Lurk text.")
 
 (defface lurk-prompt
-  '((t :inherit org-level-2))
+  '((t :inherit org-priority))
   "Face used for the prompt.")
 
 (defface lurk-context
-  '((t :inherit org-list-dt))
+  '((t :inherit org-tag))
   "Face used for the context name in the prompt.")
 
 (defface lurk-faded
-  '((t :inherit font-lock-preprocessor-face))
+  '((t :inherit org-agenda-dimmed-todo-face))
   "Face used for faded Lurk text.")
 
-(defface lurk-bold
-  '((t :inherit font-lock-function-name-face))
-  "Face used for bold Lurk text.")
-
 (defface lurk-error
   '((t :inherit font-lock-regexp-grouping-construct))
   "Face used for Lurk error text.")
@@ -113,7 +109,7 @@
   (unless (equal "open" (string-trim string))
     (lurk-display-error "Disconnected from server.")
     (clrhash lurk-contexts)
-    (setq lurk-current-context nil)
+    (lurk-set-current-context nil)
     (lurk-render-prompt)
     (cancel-timer lurk-ping-timer)))
 
@@ -150,7 +146,7 @@
     (if (not (assoc network lurk-networks))
         (lurk-display-error "Network '" network "' is unknown.")
       (clrhash lurk-contexts)
-      (setq lurk-current-context nil)
+      (lurk-set-current-context nil)
       (lurk-start-process network)
       (lurk-send-msg (lurk-msg nil nil "USER" lurk-nick 0 "*" lurk-nick))
       (lurk-send-msg (lurk-msg nil nil "NICK" lurk-nick))
@@ -303,26 +299,21 @@ portion of the source component of the message, as LURK doesn't use this.")
           (car context-list)))
     nil))
 
+(defun lurk-set-current-context (context)
+  (setq lurk-current-context context)
+  (lurk-highlight-context context))
+
 (defun lurk-cycle-contexts (&optional rev)
   (if lurk-current-context
       (progn
-        (setq lurk-current-context (lurk-get-next-context rev))
+        (lurk-set-current-context (lurk-get-next-context rev))
         (lurk-render-prompt))
     (lurk-display-error "No channels joined.")))
 
-(defun lurk-cycle-contexts-forward ()
-  (interactive)
-  (lurk-cycle-contexts)
-  (lurk-highlight-context lurk-current-context))
-
-(defun lurk-cycle-contexts-reverse ()
-  (interactive)
-  (lurk-cycle-contexts t)
-  (lurk-highlight-context lurk-current-context))
-
 
 ;;; Buffer
 ;;
+
 (defun lurk-render-prompt ()
   (with-current-buffer "*lurk*"
     (let ((update-point (= lurk-input-marker (point)))
@@ -362,6 +353,7 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-setup-buffer ()
   (with-current-buffer (get-buffer-create "*lurk*")
     (setq-local scroll-conservatively 1)
+    (setq-local buffer-invisibility-spec nil)
     (if (markerp lurk-prompt-marker)
         (set-marker lurk-prompt-marker (point-max))
       (setq lurk-prompt-marker (point-max-marker)))
@@ -430,10 +422,20 @@ portion of the source component of the message, as LURK doesn't use this.")
     (lurk-display-string
      context
      (pcase (lurk-get-context-type to)
-       ('channel (concat to " <" from "> " text))
-       ('nick (concat "[" from " -> " to "] " text))
+       ('channel (concat to " <" from "> "))
+       ('nick (concat "[" from " -> " to "] "))
        (_
-        (error "Unsupported context type"))))))
+        (error "Unsupported context type")))
+     text)))
+
+(defun lurk-display-action (from to action-text)
+  (let ((context (if (eq 'channel (lurk-get-context-type to))
+                     to
+                   (if (equal to lurk-nick) from to))))
+    (lurk-display-string
+     context
+     "* " from " " action-text)))
+     
 
 (defun lurk-display-notice (context &rest notices)
   (lurk-display-string
@@ -451,7 +453,7 @@ portion of the source component of the message, as LURK doesn't use this.")
   (maphash
    (lambda (this-context facelist)
      (if (equal this-context context)
-         (setcar facelist 'lurk-bold)
+         (setcar facelist 'lurk-text)
        (setcar facelist 'lurk-faded)))
    lurk-context-facelists)
   (force-window-update "*lurk*"))
@@ -460,10 +462,11 @@ portion of the source component of the message, as LURK doesn't use this.")
   (with-current-buffer "*lurk*"
     (maphash
      (lambda (this-context _)
-       (let ((this-context-atom (if this-context (intern this-context) nil)))
-         (if (equal this-context context)
-             (remove-from-invisibility-spec this-context-atom)
-           (add-to-invisibility-spec this-context-atom))))
+       (when this-context
+         (let ((this-context-atom (intern this-context)))
+           (if (equal this-context context)
+               (remove-from-invisibility-spec this-context-atom)
+             (add-to-invisibility-spec this-context-atom)))))
      lurk-context-facelists)
     (force-window-update "*lurk*")))
 
@@ -482,7 +485,6 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defun lurk-eval-msg-string (string)
   ;; (lurk-display-string nil string)
   (let* ((msg (lurk-string->msg string)))
-    ;; (message (pp msg))
     (pcase (lurk-msg-cmd msg)
       ("PING"
        (lurk-send-msg
@@ -513,6 +515,19 @@ portion of the source component of the message, as LURK doesn't use this.")
           (lurk--as-string (length (lurk-get-context-users channel)))
           " users in " channel)))
 
+      ("331"
+       (let* ((params (lurk-msg-params msg))
+              (channel (elt params 1)))
+         (lurk-display-notice
+          channel
+          "No topic set.")))
+
+      ("332"
+       (let* ((params (lurk-msg-params msg))
+              (channel (elt params 1))
+              (topic (elt params 2)))
+         (lurk-display-notice channel "Topic: " topic)))
+
       ((rx (= 3 (any digit)))
        (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " ")))
 
@@ -520,7 +535,7 @@ portion of the source component of the message, as LURK doesn't use this.")
             (guard (equal lurk-nick (lurk-msg-src msg))))
        (let ((channel (car (lurk-msg-params msg))))
          (lurk-add-context channel)
-         (setq lurk-current-context channel)
+         (lurk-set-current-context channel)
          (lurk-display-notice channel "Joining channel " channel)
          (lurk-render-prompt)))
 
@@ -537,7 +552,7 @@ portion of the source component of the message, as LURK doesn't use this.")
          (lurk-display-notice channel "Left channel " channel)
          (lurk-del-context channel)
          (if (equal channel lurk-current-context)
-             (setq lurk-current-context (lurk-get-next-context)))
+             (lurk-set-current-context (lurk-get-next-context)))
          (lurk-render-prompt)))
 
       ("PART"
@@ -593,10 +608,13 @@ portion of the source component of the message, as LURK doesn't use this.")
 
            ((rx (let ping (: "\01PING " (* (not "\01")) "\01")))
             (lurk-send-msg (lurk-msg nil nil "NOTICE" (list from ping)))
-            (lurk-display-notice "CTCP ping received from " from))
+            (lurk-display-notice from "CTCP ping received from " from))
 
            ("\01USERINFO\01"
-            (lurk-display-notice "CTCP userinfo request from " from " (no response sent)"))
+            (lurk-display-notice from "CTCP userinfo request from " from " (no response sent)"))
+
+           ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01"))
+            (lurk-display-action from to action-text))
 
            (_
             (if (and (equal from "BitBot")
@@ -622,10 +640,10 @@ portion of the source component of the message, as LURK doesn't use this.")
          (lurk-send-msg (lurk-msg nil nil "TOPIC" lurk-current-context new-topic)))
 
         ((rx (: "ME " (let action (* not-newline))))
-         (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
-                                  (list lurk-current-context
-                                        (concat "\01ACTION " action "\01"))))
-         (lurk-display-action lurk-nick action))
+         (let ((ctcp-text (concat "\01ACTION " action "\01")))
+           (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
+                                    (list lurk-current-context ctcp-text)))
+           (lurk-display-action lurk-nick lurk-current-context action)))
 
         ((rx (: "VERSION" " " (let nick (+ (not whitespace)))))
          (lurk-send-msg (lurk-msg nil nil "PRIVMSG"
@@ -685,12 +703,38 @@ portion of the source component of the message, as LURK doesn't use this.")
       (lurk-enter-string line))))
 
 
+;;; Command completion
+;;
+
+;;; Interactive functions
+;;
+
+(defun lurk-cycle-contexts-forward ()
+  (interactive)
+  (lurk-cycle-contexts))
+
+(defun lurk-cycle-contexts-reverse ()
+  (interactive)
+  (lurk-cycle-contexts t))
+
+(defvar lurk-zoomed nil
+  "Keeps track of zoom status.")
+
+(defun lurk-toggle-zoom ()
+  (interactive)
+  (if lurk-zoomed
+      (lurk-zoom-out)
+    (lurk-zoom-in lurk-current-context))
+  (setq lurk-zoomed (not lurk-zoomed)))
+
 ;;; Mode
 ;;
 
 (defvar lurk-mode-map
   (let ((map (make-sparse-keymap)))
     (define-key map (kbd "RET") 'lurk-enter)
+    (define-key map (kbd "<tab>") 'lurk-complete)
+    (define-key map (kbd "C-c C-z") 'lurk-toggle-zoom)
     (define-key map (kbd "<C-tab>") 'lurk-cycle-contexts-forward)
     (define-key map (kbd "<C-S-tab>") 'lurk-cycle-contexts-reverse)
     map))
@@ -715,5 +759,4 @@ portion of the source component of the message, as LURK doesn't use this.")
   "Started LURK.")
 
 
-
 ;;; lurk.el ends here