X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=lurk.git;a=blobdiff_plain;f=lurk.el;h=26eb8949d8a6adca12617bf90e1f303e2fda2331;hp=06df5154be817f9d8fff34693301052c2779b8cf;hb=8d3a7b25c3766e81cbbd0062b311c8bb6cf25abb;hpb=b0daf99266a79eebc1dfb40eb2906fa0a295f595 diff --git a/lurk.el b/lurk.el index 06df515..26eb894 100644 --- a/lurk.el +++ b/lurk.el @@ -1,4 +1,4 @@ -;;; lurk.el --- Little Unified iRc Klient -*- lexical-binding:t -*- +;;; lurk.el --- Little Uni-buffer iRc Klient -*- lexical-binding:t -*- ;; Copyright (C) 2021 Tim Vaughan @@ -6,7 +6,7 @@ ;; Created: 14 June 2021 ;; Version: 1.0 ;; Keywords: network -;; Homepage: http://thelambdalab.xyz/erc +;; Homepage: http://thelambdalab.xyz/lurk ;; Package-Requires: ((emacs "26")) ;; This file is not part of GNU Emacs. @@ -35,77 +35,74 @@ ;; (defgroup lurk nil - "Little Unified iRc Klient." + "Little Uni-buffer iRc Klient." :group 'network) (defcustom lurk-nick "plugd" "Default nick.") -(defcustom lurk-full-name "plugd" - "Default full name.") -(defcustom lurk-user-name "plugd" - "Default user name.") + +(defcustom lurk-default-quit-msg "Bye" + "Default quit message when none supplied.") (defcustom lurk-networks '(("libera" "irc.libera.chat" 6697) ("freenode" "chat.freenode.net" 6697) + ("tilde" "tilde.chat" 6697) + ("mbr" "mbrserver.com" 6667 :notls) ("local" "localhost" 6697)) "IRC networks.") (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 ;; (defface lurk-text - '((t :inherit font-lock-preprocessor-face)) + '((t :inherit default)) "Face used for Lurk text.") -(defface lurk-your-nick - '((t :inherit font-lock-constant-face)) - "Face used for highlighting your nick.") - (defface lurk-prompt - '((t :inherit org-level-2)) + '((t :inherit org-priority)) "Face used for the prompt.") (defface lurk-context - '((t :inherit org-list-dt)) + '((t :inherit org-tag)) "Face used for the context name in the prompt.") (defface lurk-faded - '((t :inherit font-lock-preprocessor-face)) + '((t :inherit org-agenda-dimmed-todo-face)) "Face used for faded Lurk text.") -(defface lurk-bold - '((t :inherit font-lock-function-name-face)) - "Face used for bold 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-notice-prefix - (concat - (propertize - "-" 'face 'lurk-faded) - (propertize - "!" 'face 'lurk-bold) - (propertize - "-" 'face 'lurk-faded))) +(defvar lurk-version "Lurk v0.1" + "Value of this string is used in response to CTCP version queries.") -(defvar lurk-error-prefix - (propertize "!!!" 'face 'lurk-error)) +(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.") ;;; Network process ;; @@ -122,7 +119,7 @@ (unless (equal "open" (string-trim string)) (lurk-display-error "Disconnected from server.") (clrhash lurk-contexts) - (setq lurk-current-context nil) + (lurk-set-current-context nil) (lurk-render-prompt) (cancel-timer lurk-ping-timer))) @@ -159,14 +156,19 @@ (if (not (assoc network lurk-networks)) (lurk-display-error "Network '" network "' is unknown.") (clrhash lurk-contexts) - (setq lurk-current-context nil) + (lurk-set-current-context nil) (lurk-start-process network) - (lurk-send-msg (lurk-msg nil nil "USER" lurk-user-name 0 "*" lurk-full-name)) + (lurk-send-msg (lurk-msg nil nil "USER" lurk-nick 0 "*" lurk-nick)) (lurk-send-msg (lurk-msg nil nil "NICK" lurk-nick)) (setq lurk-ping-timer (run-with-timer lurk-ping-period nil #'lurk-ping-function))))) +(defun lurk-connected-p () + (let ((proc (get-process "lurk"))) + (and proc (eq (process-status proc) 'open)))) (defun lurk-send-msg (msg) + (if lurk-debug + (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")) @@ -250,14 +252,9 @@ portion of the source component of the message, as LURK doesn't use this.") nil)))) -;;; Contexts and users +;;; Contexts ;; -(defvar lurk-context-table - '((channel lurk-display-channel-message) - (nick lurk-display-private-message) - (host lurk-diaplay-server-message))) - (defvar lurk-current-context nil) (defvar lurk-contexts (make-hash-table :test #'equal)) @@ -285,6 +282,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) @@ -309,39 +311,23 @@ portion of the source component of the message, as LURK doesn't use this.") (car context-list))) nil)) +(defun lurk-set-current-context (context) + (setq lurk-current-context context) + (lurk-highlight-context context) + (if lurk-zoomed + (lurk-zoom-in lurk-current-context))) + (defun lurk-cycle-contexts (&optional rev) (if lurk-current-context (progn - (setq lurk-current-context (lurk-get-next-context rev)) + (lurk-set-current-context (lurk-get-next-context rev)) (lurk-render-prompt)) (lurk-display-error "No channels joined."))) -(defun lurk-cycle-contexts-forward () - (interactive) - (lurk-cycle-contexts)) - -(defun lurk-cycle-contexts-reverse () - (interactive) - (lurk-cycle-contexts t)) ;;; 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))) @@ -361,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))) @@ -380,6 +366,8 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-setup-buffer () (with-current-buffer (get-buffer-create "*lurk*") + (setq-local scroll-conservatively 1) + (setq-local buffer-invisibility-spec nil) (if (markerp lurk-prompt-marker) (set-marker lurk-prompt-marker (point-max)) (setq lurk-prompt-marker (point-max-marker))) @@ -390,56 +378,190 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-render-prompt))) -;;; Output formatting +;;; Output formatting and highlighting ;; -(defun lurk-display-message (from to text) - (let* ((to-type (lurk-get-context-type to)) - (display-fun (cadr (assoc to-type lurk-context-table)))) - (funcall display-fun from to text))) +;; 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. + +;; Additionally, we allow selective hiding of contexts via +;; the buffer-invisibility-spec. + +(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--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 + (goto-char lurk-prompt-marker) + (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 " ") "")) + (context-atom (if context (intern context) nil))) + (insert-before-markers + (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-channel-message (from to text) - (lurk-display-string - (propertize (concat to - " <" from "> " - text) - 'face 'lurk-text))) - - -(defun lurk-display-action (channel-name nick action) - (lurk-display-string (concat channel-name - " * " - (propertize (concat nick " " action) - 'face 'lurk-text)))) - -(defun lurk-display-private-message (from to text) +(defun lurk-display-message (from to text) + (let ((context (if (eq 'channel (lurk-get-context-type to)) + to + (if (equal to lurk-nick) from to)))) + (lurk-display-string + context + (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) + (let ((context (if (eq 'channel (lurk-get-context-type to)) + to + (if (equal to lurk-nick) from to)))) + (lurk-display-string + context + (concat "* " from) + action-text))) + +(defun lurk-display-notice (context &rest notices) (lurk-display-string - (concat - (propertize - (concat "[" from " -> " to "] " - text) - 'face 'lurk-text)))) - - -(defun lurk-display-notice (&rest notices) - (lurk-display-string lurk-notice-prefix " " (apply #'concat notices))) + context + (propertize lurk-notice-prefix 'face 'lurk-notice) + (apply #'concat notices))) (defun lurk-display-error (&rest messages) - (lurk-display-string lurk-error-prefix " " - (propertize (apply #'concat messages) - 'face 'lurk-error))) + (lurk-display-string + nil + (propertize lurk-error-prefix 'face 'lurk-error) + (apply #'concat messages))) + +(defun lurk-highlight-context (context) + (maphash + (lambda (this-context facelist) + (if (equal this-context context) + (setcar facelist 'lurk-text) + (setcar facelist 'lurk-faded))) + lurk-context-facelists) + (force-window-update "*lurk*")) + +(defun lurk-zoom-in (context) + (with-current-buffer "*lurk*" + (maphash + (lambda (this-context _) + (when this-context + (let ((this-context-atom (intern this-context))) + (if (equal this-context context) + (remove-from-invisibility-spec this-context-atom) + (add-to-invisibility-spec this-context-atom))))) + lurk-context-facelists) + (force-window-update "*lurk*"))) + +(defun lurk-zoom-out () + (with-current-buffer "*lurk*" + (maphash + (lambda (this-context _) + (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*"))) + +(defconst lurk-url-regex + (rx (: + (group (+ alpha)) + "://" + (group (or (+ (any alnum "." "-")) + (+ (any alnum ":")))) + (opt (group (: ":" (+ digit)))) + (opt (group (: "/" + (opt + (* (any alnum "-/.,#:%=&_")) + (any alnum "-/#:%=&_"))))))) + "Imperfect regex used to find URLs in plain text.") + +(defun lurk-click-url (button) + (browse-url (button-get button 'url))) + +(defun lurk-buttonify-urls (string) + "Turn substrings which look like urls in STRING into clickable buttons." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (while (re-search-forward lurk-url-regex nil t) + (let ((url (match-string 0))) + (make-text-button (match-beginning 0) + (match-end 0) + 'action #'lurk-click-url + 'url url + 'follow-link t + 'face 'button + 'help-echo "Open URL in browser."))) + (buffer-string))) + ;;; Message evaluation ;; (defun lurk-eval-msg-string (string) - ;; (lurk-display-string string) + (if lurk-debug + (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 "ping-pong")) + (lurk-msg nil nil "PONG" (lurk-msg-params msg)))) + + ("PONG") + + ("001" + (let* ((params (lurk-msg-params msg)) + (nick (elt params 0)) + (text (string-join (seq-drop params 1) " "))) + (setq lurk-nick nick) + (lurk-display-notice nil text))) ("353" ; NAMEREPLY (let* ((params (lurk-msg-params msg)) @@ -448,58 +570,94 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-add-context-users channel names))) ("366" ; ENDOFNAMES - (lurk-display-notice - (lurk--as-string (length (lurk-get-context-users lurk-current-context))) - " users in " lurk-current-context)) + (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))) + + ("331" + (let* ((params (lurk-msg-params msg)) + (channel (elt params 1))) + (lurk-display-notice + channel + "No topic set."))) + + ("332" + (let* ((params (lurk-msg-params msg)) + (channel (elt params 1)) + (topic (elt params 2))) + (lurk-display-notice channel "Topic: " topic))) + + ("333") ; Avoid displaying these ((rx (= 3 (any digit))) - (lurk-display-notice (mapconcat 'identity (cdr (lurk-msg-params msg)) " "))) + (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " "))) ((and "JOIN" (guard (equal lurk-nick (lurk-msg-src msg)))) - (let ((channel-name (car (lurk-msg-params msg)))) - (lurk-add-context channel-name) - (setq lurk-current-context channel-name) - (lurk-display-notice "Joining channel " channel-name) + (let ((channel (car (lurk-msg-params msg)))) + (lurk-add-context channel) + (lurk-set-current-context channel) + (lurk-display-notice channel "Joining channel " channel) (lurk-render-prompt))) ("JOIN" - (let ((channel-name (car (lurk-msg-params msg))) + (let ((channel (car (lurk-msg-params msg))) (nick (lurk-msg-src msg))) - (lurk-add-context-users channel-name (list nick)) - (lurk-display-notice nick " joined channel " channel-name))) + (lurk-add-context-users channel (list nick)) + (if lurk-show-joins + (lurk-display-notice channel nick " joined channel " channel)))) ((and "PART" (guard (equal lurk-nick (lurk-msg-src msg)))) - (let ((channel-name (car (lurk-msg-params msg)))) - (lurk-display-notice "Left channel " channel-name) - (lurk-del-context channel-name) - (if (equal channel-name lurk-current-context) - (setq lurk-current-context (lurk-get-next-context))) + (let ((channel (car (lurk-msg-params msg)))) + (lurk-display-notice channel "Left channel " channel) + (lurk-del-context channel) + (if (equal channel lurk-current-context) + (lurk-set-current-context (lurk-get-next-context))) (lurk-render-prompt))) ("PART" - (let ((channel-name (car (lurk-msg-params msg))) + (let ((channel (car (lurk-msg-params msg))) (nick (lurk-msg-src msg))) - (lurk-del-context-user channel-name nick) - (lurk-display-notice nick " left channel " channel-name))) + (lurk-del-context-user channel nick) + (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) " "))) (lurk-del-user nick) - (lurk-display-notice nick " quit: " reason))) + (if lurk-show-joins + (lurk-display-notice nil nick " quit: " reason)))) ((and "NICK" (guard (equal lurk-nick (lurk-msg-src msg)))) (setq lurk-nick (car (lurk-msg-params msg))) - (lurk-display-notice "Set nick to " lurk-nick)) + (lurk-display-notice nil "Set nick to " lurk-nick)) ("NICK" (let ((old-nick (lurk-msg-src msg)) (new-nick (car (lurk-msg-params msg)))) - (lurk-display-notice 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)) @@ -509,9 +667,9 @@ portion of the source component of the message, as LURK doesn't use this.") ((rx (: "\01VERSION " (let version (* (not "\01"))) "\01")) - (lurk-display-notice "CTCP version reply from " nick ": " version)) + (lurk-display-notice nil "CTCP version reply from " nick ": " version)) (_ - (lurk-display-notice text))))) + (lurk-display-notice nil text))))) ("PRIVMSG" (let* ((from (lurk-msg-src msg)) @@ -525,19 +683,22 @@ portion of the source component of the message, as LURK doesn't use this.") (list from (concat "\01VERSION " version-string "\01"))))) - (lurk-display-notice "CTCP version request received from " from)) + (lurk-display-notice nil "CTCP version request received from " from)) ((rx (let ping (: "\01PING " (* (not "\01")) "\01"))) (lurk-send-msg (lurk-msg nil nil "NOTICE" (list from ping))) - (lurk-display-notice "CTCP ping received from " from)) + (lurk-display-notice from "CTCP ping received from " from)) ("\01USERINFO\01" - (lurk-display-notice "CTCP userinfo request from " from " (no response sent)")) + (lurk-display-notice from "CTCP userinfo request from " from " (no response sent)")) + + ((rx (: "\01ACTION " (let action-text (* (not "\01"))) "\01")) + (lurk-display-action from to action-text)) (_ (lurk-display-message from to text))))) (_ - (lurk-display-string (lurk-msg->string msg)))))) + (lurk-display-notice nil (lurk-msg->string msg)))))) ;;; Command entering @@ -546,23 +707,27 @@ portion of the source component of the message, as LURK doesn't use this.") (defun lurk-enter-string (string) (if (string-prefix-p "/" string) (pcase (substring string 1) + ((rx "DEBUG") + (setq lurk-debug (not lurk-debug)) + (lurk-display-notice nil "Debug mode now " (if lurk-debug "on" "off") ".")) + ((rx (: "CONNECT " (let network (* not-newline)))) - (lurk-display-notice "Attempting to connect to " network "...") + (lurk-display-notice nil "Attempting to connect to " network "...") (lurk-connect network)) ((rx (: "TOPIC " (let new-topic (* not-newline)))) (lurk-send-msg (lurk-msg nil nil "TOPIC" lurk-current-context new-topic))) ((rx (: "ME " (let action (* not-newline)))) - (lurk-send-msg (lurk-msg nil nil "PRIVMSG" - (list lurk-current-context - (concat "\01ACTION " action "\01")))) - (lurk-display-action lurk-nick action)) + (let ((ctcp-text (concat "\01ACTION " action "\01"))) + (lurk-send-msg (lurk-msg nil nil "PRIVMSG" + (list lurk-current-context ctcp-text))) + (lurk-display-action lurk-nick lurk-current-context action))) - ((rx (: "VERSION" " " (let nick (* (not whitespace))))) + ((rx (: "VERSION" " " (let nick (+ (not whitespace))))) (lurk-send-msg (lurk-msg nil nil "PRIVMSG" (list nick "\01VERSION\01"))) - (lurk-display-notice "CTCP version request sent to " nick)) + (lurk-display-notice nil "CTCP version request sent to " nick)) ((rx "PART" (opt (: " " (let channel (* not-newline))))) (if (or lurk-current-context channel) @@ -571,6 +736,25 @@ portion of the source component of the message, as LURK doesn't use this.") lurk-current-context))) (lurk-display-error "No current channel to leave."))) + ((rx "QUIT" (opt (: " " (let quit-msg (* not-newline))))) + (lurk-send-msg (lurk-msg nil nil "QUIT" + (or quit-msg lurk-default-quit-msg)))) + + ((rx (: "NICK" (* whitespace) string-end)) + (lurk-display-notice nil "Current nick: " lurk-nick)) + + ((rx (: "NICK" (+ whitespace) (let nick (+ (not whitespace))))) + (if (lurk-connected-p) + (lurk-send-msg (lurk-msg nil nil "NICK" nick)) + (setq lurk-nick nick) + (lurk-display-notice nil "Set default nick to '" nick "'"))) + + ((rx "LIST") + (lurk-display-notice nil "This command can generate lots of output. Use `LIST -yes' if you're sure.")) + + ((rx (: "LIST" (+ whitespace) "-YES")) + (lurk-send-msg (lurk-msg nil nil "LIST"))) + ((rx "MSG " (let to (* (not whitespace))) " " @@ -594,14 +778,73 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-display-message lurk-nick lurk-current-context string)) (lurk-display-error "No current context."))))) +(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*" - (lurk-enter-string - (buffer-substring lurk-input-marker (point-max))) - (let ((inhibit-read-only t)) - (delete-region lurk-input-marker (point-max))))) + (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) + (when lurk-history + (with-current-buffer "*lurk*" + (if lurk-history-index + (setq lurk-history-index + (max 0 + (min (- (length lurk-history) 1) + (+ delta lurk-history-index)))) + (setq lurk-history-index 0)) + (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 +;; + +(defun lurk-cycle-contexts-forward () + (interactive) + (lurk-cycle-contexts)) + +(defun lurk-cycle-contexts-reverse () + (interactive) + (lurk-cycle-contexts t)) + +(defvar lurk-zoomed nil + "Keeps track of zoom status.") + +(defun lurk-toggle-zoom () + (interactive) + (if lurk-zoomed + (lurk-zoom-out) + (lurk-zoom-in lurk-current-context)) + (setq lurk-zoomed (not lurk-zoomed))) + +(defun lurk-complete-nick () + (interactive) + (when (and (>= (point) lurk-input-marker) lurk-current-context) + (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))) + (unless (string-prefix-p "/" (buffer-substring start end)) + (completion-in-region start end (lurk-get-context-users lurk-current-context)))))) ;;; Mode @@ -610,10 +853,20 @@ portion of the source component of the message, as LURK doesn't use this.") (defvar lurk-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'lurk-enter) + (define-key map (kbd "") 'lurk-complete-nick) + (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* 'insert map + ;; (kbd "") 'lurk-history-prev + ;; (kbd "") 'lurk-history-next)) map)) +(defvar lurk-mode-map) + (define-derived-mode lurk-mode text-mode "lurk" "Major mode for LURK.") @@ -628,11 +881,10 @@ portion of the source component of the message, as LURK doesn't use this.") (interactive) (if (get-buffer "*lurk*") (switch-to-buffer "*lurk*") - (switch-to-buffer "*lurk*")) - (lurk-mode) - (lurk-setup-buffer) + (switch-to-buffer "*lurk*") + (lurk-mode) + (lurk-setup-buffer)) "Started LURK.") - ;;; lurk.el ends here