Fixed action face.

[lurk.git] / lurk.el

diff --git a/lurk.el b/lurk.el
index 4d2a92e..96b93ae 100644 (file)
--- a/lurk.el
+++ b/lurk.el
@@ -58,6 +58,9 @@
 (defcustom lurk-show-joins nil
   "Set to non-nil to be notified of joins, parts and quits.")
 
+(defcustom lurk-display-header t
+  "If non-nil, use buffer header to display information on current host and channel.")
+
 ;;; Faces
 ;;
 
@@ -364,6 +367,24 @@ portion of the source component of the message, as LURK doesn't use this.")
 (defvar lurk-input-marker nil
   "Marker for prompt position in LURK buffer.")
 
+(defun lurk-setup-header ()
+  (setq-local header-line-format
+              '(:eval
+                (let ((proc (get-process "lurk")))
+                  (if proc
+                      (concat
+                       "Host: " (car (process-contact proc))
+                       ", Context: "
+                       (if lurk-current-context
+                           (concat
+                            lurk-current-context
+                            " ("
+                            (number-to-string
+                             (length (lurk-get-context-users lurk-current-context)))
+                            " users)")
+                         "Server"))
+                    "No connection")))))
+
 (defun lurk-setup-buffer ()
   (with-current-buffer (get-buffer-create "*lurk*")
     (setq-local scroll-conservatively 1)
@@ -375,7 +396,9 @@ portion of the source component of the message, as LURK doesn't use this.")
         (set-marker lurk-input-marker (point-max))
       (setq lurk-input-marker (point-max-marker)))
     (goto-char (point-max))
-    (lurk-render-prompt)))
+    (lurk-render-prompt)
+    (if lurk-display-header
+        (lurk-setup-header))))
 
 
 ;;; Output formatting and highlighting
@@ -405,6 +428,15 @@ portion of the source component of the message, as LURK doesn't use this.")
       (puthash context facelist lurk-context-facelists))
     facelist))
 
+(defun lurk--fill-strings (col indent &rest strings)
+  (with-temp-buffer
+    (setq buffer-invisibility-spec nil)
+    (let ((fill-column col)
+          (adaptive-fill-regexp (rx-to-string `(= ,indent anychar))))
+      (apply #'insert strings)
+      (fill-region (point-min) (point-max) nil t)
+      (buffer-string))))
+
 (defun lurk-display-string (context prefix &rest strings)
   (with-current-buffer (get-buffer-create "*lurk*")
     (save-excursion
@@ -413,28 +445,26 @@ portion of the source component of the message, as LURK doesn't use this.")
              (old-pos (marker-position lurk-prompt-marker))
              (padded-timestamp (concat (format-time-string "%H:%M ")))
              (padded-prefix (if prefix (concat prefix " ") ""))
-             (adaptive-fill-regexp (rx-to-string
-                                    `(= ,(+ (length padded-timestamp)
-                                            (length padded-prefix))
-                                        anychar)))
-             (fill-column 80)
              (context-atom (if context (intern context) nil)))
         (insert-before-markers
-         (propertize padded-timestamp
-                     'face 'lurk-timestamp
-                     'read-only t
-                     'context context
-                     'invisible context-atom)
-         (propertize padded-prefix
-                     'read-only t
-                     'context context
-                     'invisible context-atom)
-         (propertize (concat (lurk-buttonify-urls (apply #'concat strings)) "\n")
-                     'face (lurk-get-context-facelist context)
-                     'read-only t
-                     'context context
-                     'invisible context-atom))
-        (fill-region old-pos lurk-prompt-marker nil t)))))
+         (lurk--fill-strings
+          80
+          (+ (length padded-timestamp)
+             (length padded-prefix))
+          (propertize padded-timestamp
+                      'face 'lurk-timestamp
+                      'read-only t
+                      'context context
+                      'invisible context-atom)
+          (propertize padded-prefix
+                      'read-only t
+                      'context context
+                      'invisible context-atom)
+          (propertize (concat (lurk-buttonify-urls (apply #'concat strings)) "\n")
+                      'face (lurk-get-context-facelist context)
+                      'read-only t
+                      'context context
+                      'invisible context-atom)))))))
 
 (defun lurk-display-message (from to text)
   (let ((context (if (eq 'channel (lurk-get-context-type to))
@@ -457,7 +487,9 @@ portion of the source component of the message, as LURK doesn't use this.")
                    (if (equal to lurk-nick) from to))))
     (lurk-display-string
      context
-     (concat "* " from)
+     (propertize
+      (concat context " * " from)
+      'face (lurk-get-context-facelist context))
      action-text)))
 
 (defun lurk-display-notice (context &rest notices)
@@ -704,6 +736,14 @@ portion of the source component of the message, as LURK doesn't use this.")
          (setq lurk-debug (not lurk-debug))
          (lurk-display-notice nil "Debug mode now " (if lurk-debug "on" "off") "."))
 
+        ((rx "HEADER")
+         (if header-line-format
+           (progn
+             (setq-local header-line-format nil)
+             (lurk-display-notice nil "Header disabled."))
+           (lurk-setup-header)
+           (lurk-display-notice nil "Header enabled.")))
+
         ((rx (: "CONNECT " (let network (* not-newline))))
          (lurk-display-notice nil "Attempting to connect to " network "...")
          (lurk-connect network))
@@ -835,7 +875,8 @@ portion of the source component of the message, as LURK doesn't use this.")
     (let* ((end (max lurk-input-marker (point)))
            (space-idx (save-excursion
                         (re-search-backward " " lurk-input-marker t)))
-           (start (if space-idx (+ 1 space-idx) lurk-input-marker)))
+           (start (if space-idx (+ 1 space-idx) lurk-input-marker))
+           (completion-ignore-case t))
       (unless (string-prefix-p "/" (buffer-substring start end))
         (completion-in-region start end (lurk-get-context-users lurk-current-context))))))