X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=lurk.el;h=b22ca8514a860349ae41112939a0c475aadd057d;hb=28b4ff917a9d70cc7cfec9e4773a05d512df158a;hp=48b061125d16a7245dcc528c893f97b9f8e03687;hpb=a65cb434a57b716eceb9f85dd5eda20a60dc3d7a;p=lurk.git diff --git a/lurk.el b/lurk.el index 48b0611..b22ca85 100644 --- a/lurk.el +++ b/lurk.el @@ -35,7 +35,7 @@ ;; (defgroup lurk nil - "Little Unified iRc Klient." + "Little Uni-buffer iRc Klient." :group 'network) (defcustom lurk-nick "plugd" @@ -93,6 +93,8 @@ (defvar lurk-prompt-string (propertize "> " 'face 'lurk-prompt)) +(defvar lurk-debug nil + "If non-nil, enable debug mode.") ;;; Network process ;; @@ -157,6 +159,8 @@ (and proc (eq (process-status proc) 'open)))) (defun lurk-send-msg (msg) + (if lurk-debug + (lurk-display-string 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")) @@ -301,7 +305,9 @@ 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-highlight-context context) + (if lurk-zoomed + (lurk-zoom-in lurk-current-context))) (defun lurk-cycle-contexts (&optional rev) (if lurk-current-context @@ -353,6 +359,7 @@ 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))) @@ -377,7 +384,7 @@ portion of the source component of the message, as LURK doesn't use this.") ;; and for different elements of the context-specific text to have ;; different styling. -;; Additionally, we can allow selective hiding of contexts via +;; Additionally, we allow selective hiding of contexts via ;; the buffer-invisibility-spec. (defvar lurk-context-facelists (make-hash-table :test 'equal) @@ -404,14 +411,12 @@ 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 - 'help-echo (concat "Context: " (or context "none"))) - (propertize (concat (apply #'concat strings) "\n") + '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 - 'help-echo (concat "Context: " (or context "none")))) + 'invisible context-atom)) (fill-region old-pos lurk-prompt-marker nil t))))) (defun lurk-display-message (from to text) @@ -478,11 +483,44 @@ portion of the source component of the message, as LURK doesn't use this.") 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 "-~/@|:%#=&"))))))))) + +(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 nil string) + (if lurk-debug + (lurk-display-string nil string)) (let* ((msg (lurk-string->msg string))) (pcase (lurk-msg-cmd msg) ("PING" @@ -527,6 +565,8 @@ portion of the source component of the message, as LURK doesn't use this.") (topic (elt params 2))) (lurk-display-notice channel "Topic: " topic))) + ("333") ; Avoid displaying these + ((rx (= 3 (any digit))) (lurk-display-notice nil (mapconcat 'identity (cdr (lurk-msg-params msg)) " "))) @@ -616,10 +656,6 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-display-action from to action-text)) (_ - (if (and (equal from "BitBot") - (equal to "##moshpit") - (cl-search "\\_o< QUACK!" text)) - (lurk-send-msg (lurk-msg nil nil "PRIVMSG" to ",bef"))) (lurk-display-message from to text))))) (_ (lurk-display-notice nil (lurk-msg->string msg)))))) @@ -631,6 +667,10 @@ 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 nil "Attempting to connect to " network "...") (lurk-connect network)) @@ -669,6 +709,12 @@ portion of the source component of the message, as LURK doesn't use this.") (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))) " " @@ -702,9 +748,6 @@ portion of the source component of the message, as LURK doesn't use this.") (lurk-enter-string line)))) -;;; Command completion -;; - ;;; Interactive functions ;; @@ -726,13 +769,23 @@ portion of the source component of the message, as LURK doesn't use this.") (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 ;; (defvar lurk-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "RET") 'lurk-enter) - (define-key map (kbd "") 'lurk-complete) + (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) @@ -752,9 +805,9 @@ 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.")