X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lurk.el;h=fb8389225e6b26d4157f1c5d7adff5f24a088864;hb=f0d495cfd2f7b7bb1fb7743aa8b3996111a5b922;hp=c5ba5159e63e1896708ef6002ff05476820c0da1;hpb=d0bcb510b018ea2948a1557d7dc8a68537c7f7fa;p=lurk.git diff --git a/lurk.el b/lurk.el index c5ba515..fb83892 100644 --- a/lurk.el +++ b/lurk.el @@ -55,6 +55,9 @@ (defcustom lurk-allow-ipv6 nil "Set to non-nil to allow use of IPv6.") +(defcustom lurk-show-joins nil + "Set to non-nil to be notified of joins, parts and quits.") + ;;; Faces ;; @@ -103,7 +106,6 @@ (defvar lurk-error-prefix (propertize "!!!" 'face 'lurk-error)) - (defvar lurk-prompt-string (propertize "> " 'face 'lurk-prompt)) @@ -284,6 +286,11 @@ portion of the source component of the message, as LURK doesn't use this.") (dolist (context (lurk-get-context-list)) (lurk-del-context-user context user))) +(defun lurk-rename-user (old-nick new-nick) + (dolist (context (lurk-get-context-list)) + (lurk-del-context-user context old-nick) + (lurk-add-context-users context (list new-nick)))) + (defun lurk-get-context-type (name) (cond ((string-prefix-p "#" name) 'channel) @@ -326,22 +333,6 @@ portion of the source component of the message, as LURK doesn't use this.") ;;; Buffer ;; - -(defun lurk-display-string (&rest strings) - (with-current-buffer (get-buffer-create "*lurk*") - (save-excursion - (goto-char lurk-prompt-marker) - (let ((inhibit-read-only t) - (old-pos (marker-position lurk-prompt-marker)) - (adaptive-fill-regexp (rx (= 6 anychar)))) - (insert-before-markers - (propertize (concat (format-time-string "%H:%M") " ") - 'face 'lurk-text - 'read-only t) - (propertize (concat (apply #'concat strings) "\n") - 'read-only t)) - (fill-region old-pos lurk-prompt-marker))))) - (defun lurk-render-prompt () (with-current-buffer "*lurk*" (let ((update-point (= lurk-input-marker (point))) @@ -394,6 +385,43 @@ portion of the source component of the message, as LURK doesn't use this.") ;;; Output formatting ;; +;; Partially-implemented idea: the face text property can be +;; a list of faces, applied in order. By assigning each context +;; a unique list and keeping track of these in a hash table, we can +;; easily switch the face corresponding to a particular context +;; by modifying the elements of this list. +;; +;; More subtly, we make only the cdrs of this list shared among +;; all text of a given context, allowing the cars to be different +;; and for different elements of the context-specific text to have +;; different styling. + +(defvar lurk-context-facelists (make-hash-table :test 'equal) + "List of seen contexts and associated face lists.") + +(defun lurk-get-context-facelist (context) + (let ((facelist (gethash context lurk-context-facelists))) + (unless facelist + (setq facelist (list 'lurk-text)) + (puthash context facelist lurk-context-facelists)) + facelist)) + +(defun lurk-display-string (&rest strings) + (with-current-buffer (get-buffer-create "*lurk*") + (save-excursion + (goto-char lurk-prompt-marker) + (let ((inhibit-read-only t) + (old-pos (marker-position lurk-prompt-marker)) + (adaptive-fill-regexp (rx (= 6 anychar))) + (fill-column 80)) + (insert-before-markers + (propertize (concat (format-time-string "%H:%M") " ") + 'face 'lurk-text + 'read-only t) + (propertize (concat (apply #'concat strings) "\n") + 'read-only t)) + (fill-region old-pos lurk-prompt-marker nil t))))) + (defun lurk-display-message (from to text) (let ((context (if (eq 'channel (lurk-get-context-type to)) to @@ -405,7 +433,7 @@ portion of the source component of the message, as LURK doesn't use this.") ('nick (concat "[" from " -> " to "] " text)) (_ (error "Unsupported context type"))) - 'face 'lurk-text + 'face (lurk-get-context-facelist context) 'help-echo (concat "Context: " context) 'context context)))) @@ -447,6 +475,7 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-eval-msg-string (string) ;; (lurk-display-string string) (let* ((msg (lurk-string->msg string))) + ;; (message (pp msg)) (pcase (lurk-msg-cmd msg) ("PING" (lurk-send-msg @@ -492,7 +521,8 @@ portion of the source component of the message, as LURK doesn't use this.") (let ((channel (car (lurk-msg-params msg))) (nick (lurk-msg-src msg))) (lurk-add-context-users channel (list nick)) - (lurk-display-notice channel nick " joined channel " channel))) + (if lurk-show-joins + (lurk-display-notice channel nick " joined channel " channel)))) ((and "PART" (guard (equal lurk-nick (lurk-msg-src msg)))) @@ -507,13 +537,15 @@ portion of the source component of the message, as LURK doesn't use this.") (let ((channel (car (lurk-msg-params msg))) (nick (lurk-msg-src msg))) (lurk-del-context-user channel nick) - (lurk-display-notice channel nick " left channel " channel))) + (if lurk-show-joins + (lurk-display-notice channel nick " left channel " channel)))) ("QUIT" (let ((nick (lurk-msg-src msg)) (reason (mapconcat 'identity (lurk-msg-params msg) " "))) (lurk-del-user nick) - (lurk-display-notice nil nick " quit: " reason))) + (if lurk-show-joins + (lurk-display-notice nil nick " quit: " reason)))) ((and "NICK" (guard (equal lurk-nick (lurk-msg-src msg)))) @@ -523,8 +555,8 @@ portion of the source component of the message, as LURK doesn't use this.") ("NICK" (let ((old-nick (lurk-msg-src msg)) (new-nick (car (lurk-msg-params msg)))) - (lurk-display-notice nil nick " is now known as " new-nick) - (lurk-rename-user nick new-nick))) + (lurk-display-notice nil old-nick " is now known as " new-nick) + (lurk-rename-user old-nick new-nick))) ("NOTICE" (let ((nick (lurk-msg-src msg)) @@ -562,7 +594,7 @@ portion of the source component of the message, as LURK doesn't use this.") (_ (lurk-display-message from to text))))) (_ - (lurk-display-string (lurk-msg->string msg)))))) + (lurk-display-notice nil (lurk-msg->string msg)))))) ;;; Command entering