X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lurk.el;h=4d2a92ea1f1bd424972e4122e2f2bb0aca455ec5;hb=fd808a729426527a060b8e4930e5e3c0a8116bd1;hp=0c9c31bf69b58cd063acafed3b55ab2e97d8adef;hpb=d0aadfe2997e1d561aacffb6a3d1f554af439811;p=lurk.git diff --git a/lurk.el b/lurk.el index 0c9c31b..4d2a92e 100644 --- a/lurk.el +++ b/lurk.el @@ -77,21 +77,29 @@ '((t :inherit org-agenda-dimmed-todo-face)) "Face used for faded Lurk text.") +(defface lurk-timestamp + '((t :inherit org-agenda-dimmed-todo-face)) + "Face used for timestamps.") + (defface lurk-error '((t :inherit font-lock-regexp-grouping-construct)) "Face used for Lurk error text.") +(defface lurk-notice + '((t :inherit org-upcoming-deadline)) + "Face used for Lurk notice text.") + ;;; Global variables ;; -(defvar lurk-version "Lurk v0.1") +(defvar lurk-version "Lurk v0.1" + "Value of this string is used in response to CTCP version queries.") (defvar lurk-notice-prefix "-!-") (defvar lurk-error-prefix "!!!") -(defvar lurk-prompt-string - (propertize "> " 'face 'lurk-prompt)) +(defvar lurk-prompt-string ">") (defvar lurk-debug nil "If non-nil, enable debug mode.") @@ -160,7 +168,7 @@ (defun lurk-send-msg (msg) (if lurk-debug - (lurk-display-string nil (lurk-msg->string msg))) + (lurk-display-string nil nil (lurk-msg->string msg))) (let ((proc (get-process "lurk"))) (if (and proc (eq (process-status proc) 'open)) (process-send-string proc (concat (lurk-msg->string msg) "\r\n")) @@ -339,7 +347,7 @@ portion of the source component of the message, as LURK doesn't use this.") "") 'face 'lurk-context 'read-only t) - (propertize lurk-prompt-string + (propertize (concat lurk-prompt-string " ") 'face 'lurk-prompt 'read-only t 'rear-nonsticky t))) @@ -397,18 +405,27 @@ portion of the source component of the message, as LURK doesn't use this.") (puthash context facelist lurk-context-facelists)) facelist)) -(defun lurk-display-string (context &rest strings) +(defun lurk-display-string (context prefix &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) - (context-atom (if context (intern context) nil))) + (let* ((inhibit-read-only t) + (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 (concat (format-time-string "%H:%M") " ") - 'face (lurk-get-context-facelist context) + (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) @@ -425,11 +442,13 @@ 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 - (pcase (lurk-get-context-type to) - ('channel (concat to " <" from "> ")) - ('nick (concat "[" from " -> " to "] ")) - (_ - (error "Unsupported context type"))) + (propertize + (pcase (lurk-get-context-type to) + ('channel (concat to " <" from ">")) + ('nick (concat "[" from " -> " to "]")) + (_ + (error "Unsupported context type"))) + 'face (lurk-get-context-facelist context)) text))) (defun lurk-display-action (from to action-text) @@ -438,19 +457,19 @@ 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 - "* " from " " action-text))) - + (concat "* " from) + action-text))) (defun lurk-display-notice (context &rest notices) (lurk-display-string context - lurk-notice-prefix " " + (propertize lurk-notice-prefix 'face 'lurk-notice) (apply #'concat notices))) (defun lurk-display-error (&rest messages) (lurk-display-string nil - lurk-error-prefix " " + (propertize lurk-error-prefix 'face 'lurk-error) (apply #'concat messages))) (defun lurk-highlight-context (context) @@ -492,8 +511,9 @@ portion of the source component of the message, as LURK doesn't use this.") (opt (group (: ":" (+ digit)))) (opt (group (: "/" (opt - (* (any alnum ",.-~/@|:%#=&_")) - (+ (any alnum "-~/@|:%#=&"))))))))) + (* (any alnum "-/.,#:%=&_")) + (any alnum "-/#:%=&_"))))))) + "Imperfect regex used to find URLs in plain text.") (defun lurk-click-url (button) (browse-url (button-get button 'url))) @@ -520,16 +540,14 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-eval-msg-string (string) (if lurk-debug - (lurk-display-string nil string)) + (lurk-display-string nil nil string)) (let* ((msg (lurk-string->msg string))) (pcase (lurk-msg-cmd msg) ("PING" (lurk-send-msg (lurk-msg nil nil "PONG" (lurk-msg-params msg)))) - ;; (lurk-display-notice nil "ping-pong (server initiated)")) ("PONG") - ;; (lurk-display-notice nil "ping-pong (client initiated)")) ("001" (let* ((params (lurk-msg-params msg)) @@ -601,6 +619,21 @@ portion of the source component of the message, as LURK doesn't use this.") (if lurk-show-joins (lurk-display-notice channel nick " left channel " channel)))) + ((and "KICK") + (let ((kicker-nick (lurk-msg-src msg)) + (channel (car (lurk-msg-params msg))) + (nick (cadr (lurk-msg-params msg))) + (reason (caddr (lurk-msg-params msg)))) + (if (equal nick lurk-nick) + (progn + (lurk-display-notice channel kicker-nick " kicked you from " channel ": " reason) + (lurk-del-context channel) + (if (equal channel lurk-current-context) + (lurk-set-current-context (lurk-get-next-context))) + (lurk-render-prompt)) + (lurk-del-context-user channel nick) + (lurk-display-notice channel kicker-nick " kicked " nick " from " channel ": " reason)))) + ("QUIT" (let ((nick (lurk-msg-src msg)) (reason (mapconcat 'identity (lurk-msg-params msg) " ")))