X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lurk.git;a=blobdiff_plain;f=lurk.el;h=edfb66fe7d6b79b90021d2d35b7a8c79ea85c7df;hp=bd1e416ac95aa8610cfc4824238f53b47aa3ebac;hb=HEAD;hpb=d9a9192dde02a1d7b79771bfbc6e6cfe3a7fe1a9 diff --git a/lurk.el b/lurk.el index bd1e416..52ee3b6 100644 --- a/lurk.el +++ b/lurk.el @@ -65,27 +65,27 @@ "Face used for Lurk text.") (defface lurk-prompt - '((t :inherit org-priority)) + '((t :inherit font-lock-keyword-face)) "Face used for the prompt.") (defface lurk-context - '((t :inherit org-tag)) + '((t :inherit lurk-context)) "Face used for the context name in the prompt.") (defface lurk-faded - '((t :inherit org-agenda-dimmed-todo-face)) + '((t :inherit shadow)) "Face used for faded Lurk text.") (defface lurk-timestamp - '((t :inherit org-agenda-dimmed-todo-face)) + '((t :inherit shadow)) "Face used for timestamps.") (defface lurk-error - '((t :inherit font-lock-regexp-grouping-construct)) + '((t :inherit error)) "Face used for Lurk error text.") (defface lurk-notice - '((t :inherit org-upcoming-deadline)) + '((t :inherit warning)) "Face used for Lurk notice text.") ;;; Global variables @@ -271,10 +271,13 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-get-context-users (name) (gethash name lurk-contexts)) +(defun lurk-context-known-p (name) + (not (eq (gethash name lurk-contexts 0) 0))) + (defun lurk-add-context-users (context users) (puthash context - (append users - (gethash context lurk-contexts)) + (cl-union users + (gethash context lurk-contexts)) lurk-contexts)) (defun lurk-del-context-user (context user) @@ -318,14 +321,13 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-set-current-context (context) (setq lurk-current-context context) (lurk-highlight-context context) + (lurk-render-prompt) (if lurk-zoomed (lurk-zoom-in lurk-current-context))) (defun lurk-cycle-contexts (&optional rev) (if lurk-current-context - (progn - (lurk-set-current-context (lurk-get-next-context rev)) - (lurk-render-prompt)) + (lurk-set-current-context (lurk-get-next-context rev)) (lurk-display-error "No channels joined."))) @@ -406,6 +408,11 @@ portion of the source component of the message, as LURK doesn't use this.") (if lurk-display-header (lurk-setup-header)))) +(defun lurk-clear-buffer () + "Completely erase all non-prompt and non-input text from lurk buffer." + (with-current-buffer "*lurk*" + (let ((inhibit-read-only t)) + (delete-region (point-min) lurk-prompt-marker)))) ;;; Output formatting and highlighting ;; @@ -443,8 +450,35 @@ portion of the source component of the message, as LURK doesn't use this.") (fill-region (point-min) (point-max) nil t) (buffer-string)))) +(defun lurk--start-of-final-line () + (with-current-buffer "*lurk*" + (save-excursion + (goto-char (point-max)) + (line-beginning-position)))) + +(defun lurk-scroll-windows-to-last-line () + (with-current-buffer "*lurk*" + (dolist (window (get-buffer-window-list)) + (if (>= (window-point window) (lurk--start-of-final-line)) + (with-selected-window window + (recenter -1)))))) + +(defun lurk-make-context-button (context &optional label) + (with-temp-buffer + (insert-text-button (or label context) + 'action #'lurk--context-button-action + 'follow-link t + 'help-echo "Switch context.") + (buffer-string))) + +(defun lurk--context-button-action (button) + (let ((context (button-get button 'context))) + (if (eq lurk-current-context context) + (lurk-toggle-zoom) + (lurk-set-current-context context)))) + (defun lurk-display-string (context prefix &rest strings) - (with-current-buffer (get-buffer-create "*lurk*") + (with-current-buffer "*lurk*" (save-excursion (goto-char lurk-prompt-marker) (let* ((inhibit-read-only t) @@ -471,7 +505,8 @@ portion of the source component of the message, as LURK doesn't use this.") 'face (lurk-get-context-facelist context) 'read-only t 'context context - 'invisible context-atom)))))))) + 'invisible context-atom))))))) + (lurk-scroll-windows-to-last-line)) (defun lurk-display-message (from to text) (let ((context (if (eq 'channel (lurk-get-context-type to)) @@ -481,8 +516,10 @@ portion of the source component of the message, as LURK doesn't use this.") context (propertize (pcase (lurk-get-context-type to) - ('channel (concat to " <" from ">")) - ('nick (concat "[" from " -> " to "]")) + ('channel (concat + (lurk-make-context-button to) + " <" from ">")) + ('nick (lurk-make-context-button context (concat "[" from " -> " to "]"))) (_ (error "Unsupported context type"))) 'face (lurk-get-context-facelist context)) @@ -495,7 +532,7 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-display-string context (propertize - (concat context " * " from) + (concat (lurk-make-context-button context) " * " from) 'face (lurk-get-context-facelist context)) action-text))) @@ -530,7 +567,8 @@ portion of the source component of the message, as LURK doesn't use this.") (remove-from-invisibility-spec this-context-atom) (add-to-invisibility-spec this-context-atom))))) lurk-context-facelists) - (force-window-update "*lurk*"))) + (force-window-update "*lurk*")) + (lurk-scroll-windows-to-last-line)) (defun lurk-zoom-out () (with-current-buffer "*lurk*" @@ -539,7 +577,18 @@ portion of the source component of the message, as LURK doesn't use this.") (let ((this-context-atom (if this-context (intern this-context) nil))) (remove-from-invisibility-spec this-context-atom))) lurk-context-facelists) - (force-window-update "*lurk*"))) + (force-window-update "*lurk*")) + (lurk-scroll-windows-to-last-line)) + +(defun lurk-clear-context (context) + (with-current-buffer "*lurk*" + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) + (match nil)) + (while (setq match (text-property-search-forward 'context context t)) + (delete-region (prop-match-beginning match) + (prop-match-end match))))))) (defconst lurk-url-regex (rx (: @@ -583,7 +632,8 @@ portion of the source component of the message, as LURK doesn't use this.") (strikethrough nil) (prev-point (point))) (while (re-search-forward (rx (or (any "\x02\x1D\x1F\x1E\x0F") - (: "\x03" (+ digit) (opt "," (* digit))))) nil t) + (: "\x03" (+ digit) (opt "," (* digit))))) + nil t) (let ((beg (+ (match-beginning 0) 1))) (if bold (add-face-text-property prev-point beg '(:weight bold))) @@ -635,15 +685,19 @@ portion of the source component of the message, as LURK doesn't use this.") (let* ((params (lurk-msg-params msg)) (channel (elt params 2)) (names (split-string (elt params 3)))) - (lurk-add-context-users channel names))) + (if (lurk-context-known-p channel) + (lurk-add-context-users channel names) + (lurk-display-notice nil "Users in " channel ": " (string-join names " "))))) ("366" ; ENDOFNAMES (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))) + (if (lurk-context-known-p channel) + (lurk-display-notice + channel + (lurk--as-string (length (lurk-get-context-users channel))) + " users in " channel) + (lurk-display-notice nil "End of " channel " names list.")))) ("331" (let* ((params (lurk-msg-params msg)) @@ -826,14 +880,19 @@ in which case they match anything.") '(("DEBUG" "Toggle debug mode on/off." lurk-command-debug lurk-boolean-completions) ("HEADER" "Toggle display of header." lurk-command-header lurk-boolean-completions) ("CONNECT" "Connect to an IRC network." lurk-command-connect lurk-network-completions) + ("NETWORKS" "List known IRC networks." lurk-command-networks) + ("JOIN" "Join one or more channels." lurk-command-join) ("TOPIC" "Set topic for current channel." lurk-command-topic) ("ME" "Display action." lurk-command-me) - ("VERSION" "Request version of another user's client via CTCP." lurk-command-version) + ("VERSION" "Request version of another user's client via CTCP." lurk-command-version lurk-nick-completions) ("PART" "Leave channel." lurk-command-part lurk-context-completions) ("QUIT" "Disconnect from current network." lurk-command-quit) ("NICK" "Change nick." lurk-command-nick) ("LIST" "Display details of one or more channels." lurk-command-list) + ("WHOIS" "Ask server for details of nick." nil lurk-nick-completions) + ("USERS" "List nicks of users in current context." lurk-command-users) ("MSG" "Send private message to user." lurk-command-msg lurk-nick-completions) + ("CLEAR" "Clear buffer text." lurk-command-clear lurk-context-completions) ("HELP" "Display help on client commands." lurk-command-help lurk-help-completions)) "Table of commands explicitly supported by Lurk.") @@ -893,9 +952,20 @@ in which case they match anything.") (lurk-connect network)) (lurk-display-notice nil "Usage: /connect "))) -(defun lurk-command-quit (params) - (let ((quit-msg (if params (string-join params " ") nil))) - (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg)))) +(defun lurk-command-networks (params) + (lurk-display-notice nil "Currently-known networks:") + (dolist (row lurk-networks) + (seq-let (network server port &rest others) row + (lurk-display-notice nil "\t" network + " [" server + " " (number-to-string port) "]"))) + (lurk-display-notice nil "(Modify the `lurk-networks' variable to add more.)")) + +(defun lurk-command-join (params) + (if params + (dolist (channel params) + (lurk-send-msg (lurk-msg nil nil "JOIN" channel))) + (lurk-display-notice nil "Usage: /join channel [channel2 ...]"))) (defun lurk-command-part (params) (let ((channel (if params (car params) lurk-current-context))) @@ -912,7 +982,7 @@ in which case they match anything.") (lurk-display-notice nil "Usage: /version "))) (defun lurk-command-quit (params) - (let ((quit-msg (if params (string-join parms " ") lurk-default-quit-msg))) + (let ((quit-msg (if params (string-join params " ") lurk-default-quit-msg))) (lurk-send-msg (lurk-msg nil nil "QUIT" quit-msg)))) (defun lurk-command-nick (params) @@ -920,8 +990,8 @@ in which case they match anything.") (if new-nick (if (lurk-connected-p) (lurk-send-msg (lurk-msg nil nil "NICK" new-nick)) - (setq lurk-nick nick) - (lurk-display-notice nil "Set default nick to '" nick "'.")) + (setq lurk-nick new-nick) + (lurk-display-notice nil "Set default nick to '" lurk-nick "'.")) (lurk-display-notice nil "Current nick: " lurk-nick)))) (defun lurk-command-me (params) @@ -957,6 +1027,20 @@ in which case they match anything.") (lurk-display-message lurk-nick to text)) (lurk-display-notice nil "Usage: /msg "))) +(defun lurk-command-clear (params) + (if (not params) + (lurk-clear-buffer) + (dolist (context params) + (lurk-clear-context context)))) + +(defun lurk-command-users (params) + (if lurk-current-context + (progn + (lurk-display-notice lurk-current-context "Users in " lurk-current-context ":") + (lurk-display-notice + lurk-current-context + (string-join (lurk-get-context-users lurk-current-context) " "))) + (lurk-display-notice nil "No current channel."))) ;;; Command entering ;; @@ -972,7 +1056,7 @@ in which case they match anything.") (params (if params-str (split-string params-str nil t) nil))) - (if command-row + (if (and command-row (elt command-row 2)) (funcall (elt command-row 2) params) (lurk-send-msg (lurk-msg nil nil (upcase cmd-str) params))))) (_ @@ -1040,7 +1124,7 @@ in which case they match anything.") (defun lurk-complete-input () (interactive) (let ((completion-ignore-case t)) - (when (and (>= (point) lurk-input-marker)) + (when (>= (point) lurk-input-marker) (pcase (buffer-substring lurk-input-marker (point)) ((rx (: "/" (let cmd-str (+ (not whitespace))) (+ " ") (* (not whitespace)) string-end)) (let ((space-idx (save-excursion @@ -1061,7 +1145,11 @@ in which case they match anything.") (re-search-backward " " lurk-input-marker t))) (start (if space-idx (+ 1 space-idx) lurk-input-marker))) (unless (string-prefix-p "/" (buffer-substring start end)) - (completion-in-region start end (lurk-get-context-users lurk-current-context))))))))) + (let* ((users (lurk-get-context-users lurk-current-context)) + (users-no@ (mapcar + (lambda (u) (car (split-string u "@" t))) + users))) + (completion-in-region start end users-no@))))))))) (defun lurk-enter () "Enter current contents of line after prompt." @@ -1075,23 +1163,23 @@ in which case they match anything.") (lurk-enter-string line)))) - ;;; Mode ;; (defvar lurk-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'lurk-enter) - (define-key map (kbd "") 'lurk-complete-input) + (define-key map (kbd "TAB") 'lurk-complete-input) (define-key map (kbd "C-c C-z") 'lurk-toggle-zoom) (define-key map (kbd "") 'lurk-cycle-contexts-forward) (define-key map (kbd "") 'lurk-cycle-contexts-reverse) (define-key map (kbd "") 'lurk-history-prev) (define-key map (kbd "") 'lurk-history-next) + (when (fboundp 'evil-define-key*) + (evil-define-key* 'motion map + (kbd "TAB") 'lurk-complete-input)) map)) -(defvar lurk-mode-map) - (define-derived-mode lurk-mode text-mode "lurk" "Major mode for LURK.")