X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lurk.el;h=89670946b443e4787dc9bdedd7e121a0de2f9d15;hb=d2507cb2725f6b4fb367fc48c99950ea00fb9ee7;hp=675ec0ee5d95d8633949032638964e3857856227;hpb=943a2fbb17df9da6a47389e77082a889a552f588;p=lurk.git diff --git a/lurk.el b/lurk.el index 675ec0e..8967094 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) @@ -443,8 +446,14 @@ 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-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 +480,11 @@ 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)))))) + (dolist (window (get-buffer-window-list)) + (if (>= (window-point window) (lurk--start-of-final-line)) + (with-selected-window window + (recenter -1)))))) (defun lurk-display-message (from to text) (let ((context (if (eq 'channel (lurk-get-context-type to)) @@ -635,15 +648,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,6 +843,7 @@ 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) ("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) @@ -866,34 +884,6 @@ in which case they match anything.") (lurk-display-notice nil " \x02" (elt row 0) "\x02: " (elt row 1))) (lurk-display-notice nil "Use /HELP COMMAND to display information about a specific command."))) -;;; Command entering -;; - -(defun lurk-enter-string (string) - (if (string-prefix-p "/" string) - (pcase string - ((rx (: "/" (let cmd-str (+ (not whitespace))) - (opt (+ whitespace) - (let params-str (+ anychar)) - string-end))) - (let ((command-row (assoc (upcase cmd-str) lurk-command-table #'equal)) - (params (if params-str - (split-string params-str nil t) - nil))) - (if command-row - (funcall (elt command-row 2) params) - (lurk-send-msg (lurk-msg nil nil (upcase cmd-str) params))))) - (_ - (lurk-display-error "Badly formed command."))) - (unless (string-empty-p string) - (if lurk-current-context - (progn - (lurk-send-msg (lurk-msg nil nil "PRIVMSG" - lurk-current-context - string)) - (lurk-display-message lurk-nick lurk-current-context string)) - (lurk-display-error "No current context."))))) - (defun lurk-command-debug (params) (setq lurk-debug (if params @@ -921,9 +911,14 @@ 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-part (params) (let ((channel (if params (car params) lurk-current-context))) @@ -940,7 +935,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) @@ -986,24 +981,41 @@ in which case they match anything.") (lurk-display-notice nil "Usage: /msg "))) +;;; Command entering +;; + +(defun lurk-enter-string (string) + (if (string-prefix-p "/" string) + (pcase string + ((rx (: "/" (let cmd-str (+ (not whitespace))) + (opt (+ whitespace) + (let params-str (+ anychar)) + string-end))) + (let ((command-row (assoc (upcase cmd-str) lurk-command-table #'equal)) + (params (if params-str + (split-string params-str nil t) + nil))) + (if command-row + (funcall (elt command-row 2) params) + (lurk-send-msg (lurk-msg nil nil (upcase cmd-str) params))))) + (_ + (lurk-display-error "Badly formed command."))) + (unless (string-empty-p string) + (if lurk-current-context + (progn + (lurk-send-msg (lurk-msg nil nil "PRIVMSG" + lurk-current-context + string)) + (lurk-display-message lurk-nick lurk-current-context string)) + (lurk-display-error "No current context."))))) + + ;;; Command history ;; (defvar lurk-history nil "Commands and messages sent in current session.") - -(defun lurk-enter () - "Enter current contents of line after prompt." - (interactive) - (with-current-buffer "*lurk*" - (let ((line (buffer-substring lurk-input-marker (point-max)))) - (push line lurk-history) - (setq lurk-history-index nil) - (let ((inhibit-read-only t)) - (delete-region lurk-input-marker (point-max))) - (lurk-enter-string line)))) - (defvar lurk-history-index nil) (defun lurk-history-cycle (delta) @@ -1018,14 +1030,6 @@ in which case they match anything.") (delete-region lurk-input-marker (point-max)) (insert (elt lurk-history lurk-history-index))))) -(defun lurk-history-next () - (interactive) - (lurk-history-cycle -1)) - -(defun lurk-history-prev () - (interactive) - (lurk-history-cycle +1)) - ;;; Interactive functions ;; @@ -1048,6 +1052,14 @@ in which case they match anything.") (lurk-zoom-in lurk-current-context)) (setq lurk-zoomed (not lurk-zoomed))) +(defun lurk-history-next () + (interactive) + (lurk-history-cycle -1)) + +(defun lurk-history-prev () + (interactive) + (lurk-history-cycle +1)) + (defun lurk-complete-input () (interactive) (let ((completion-ignore-case t)) @@ -1074,6 +1086,17 @@ in which case they match anything.") (unless (string-prefix-p "/" (buffer-substring start end)) (completion-in-region start end (lurk-get-context-users lurk-current-context))))))))) +(defun lurk-enter () + "Enter current contents of line after prompt." + (interactive) + (with-current-buffer "*lurk*" + (let ((line (buffer-substring lurk-input-marker (point-max)))) + (push line lurk-history) + (setq lurk-history-index nil) + (let ((inhibit-read-only t)) + (delete-region lurk-input-marker (point-max))) + (lurk-enter-string line)))) + ;;; Mode ;; @@ -1081,12 +1104,15 @@ in which case they match anything.") (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) @@ -1097,17 +1123,21 @@ in which case they match anything.") (when (fboundp 'evil-set-initial-state) (evil-set-initial-state 'lurk-mode 'insert)) + ;;; Main start procedure ;; -(defun lurk () - "Switch to *lurk* buffer." +(defun lurk (&optional network) + "Start lurk or just switch to the lurk buffer if one already exists. +Also connect to NETWORK if non-nil." (interactive) (if (get-buffer "*lurk*") (switch-to-buffer "*lurk*") (switch-to-buffer "*lurk*") (lurk-mode) - (lurk-setup-buffer)) + (lurk-setup-buffer) + (if network + (lurk-command-connect (list network)))) "Started LURK.")