From b7295426c95bf968288bb6ead2db416a71ec4d3e Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sun, 9 Jan 2022 20:52:07 -0600
Subject: Weekend, babee

---
 lisp/+circe.el | 130 ++++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 105 insertions(+), 25 deletions(-)

(limited to 'lisp/+circe.el')

diff --git a/lisp/+circe.el b/lisp/+circe.el
index c29cea6..3d6ea60 100644
--- a/lisp/+circe.el
+++ b/lisp/+circe.el
@@ -101,9 +101,11 @@ For entry into `lui-formatting-list'."
 
 (defun +circe-kill-buffer (&rest _)
   "Kill a circe buffer without confirmation, and after a delay."
-  (let ((circe-channel-killed-confirmation nil)
-        (circe-server-killed-confirmation nil))
-    (run-with-timer 0.25 nil 'kill-buffer)))
+  (let ((circe-channel-killed-confirmation)
+        (circe-server-killed-confirmation))
+    (when (derived-mode-p 'lui-mode)    ; don't spuriously kill
+      (ignore-errors
+        (kill-buffer)))))
 
 (defun +circe-quit@kill-buffer (&rest _)
   "ADVICE: kill all buffers of a server after `circe-command-QUIT'."
@@ -115,9 +117,11 @@ For entry into `lui-formatting-list'."
 
 (defun +circe-gquit@kill-buffer (&rest _)
   "ADVICE: kill all Circe buffers after `circe-command-GQUIT'."
-  (dolist (buf (circe-server-buffers))
-    (with-current-buffer buf
-      (+circe-quit@kill-buffer))))
+  (let ((circe-channel-killed-confirmation)
+        (circe-server-killed-confirmation))
+    (dolist (buf (circe-server-buffers))
+      (with-current-buffer buf
+        (+circe-quit@kill-buffer)))))
 
 (defun +circe-quit-all@kill-emacs ()
   "Quit all circe buffers when killing Emacs."
@@ -165,28 +169,104 @@ See `circe-network-options' for a list of common options."
                      (funcall +circe-server-buffer-action buffer))))
 
 ;;; Chat commands
-;; TODO: Actually ... write these~!?!?!
-
-(defun circe-command-SHORTEN (url)
-  "Shorten URL using `0x0-shorten-uri'.")
 
 (defun circe-command-SLAP (nick)
-  "Slap NICK around a bit with a large trout.")
-
-(defun circe-command-POKE (nick)
-  "Poke NICK like in the old Facebook days.")
-
-;;; Pure idiocy
-
-(define-minor-mode circe-cappy-hour-mode
+  "Slap NICK around a bit with a large trout."
+  (interactive (list (completing-read "Nick to slap: "
+                                      (circe-channel-nicks)
+                                      nil t nil)))
+  (circe-command-ME (format "slaps %s about a bit with a large trout" nick)))
+
+;;; Filtering functions
+;; Set `lui-input-function' to `+lui-filter', then add the filters you want to
+;; `circe-channel-mode-hook'.
+
+(require 'dash)
+
+(defvar +lui-filters nil
+  "Stack of input functions to apply.
+This is an alist with cells of the structure (TAG . FN), so we
+can easily remove elements.")
+(make-variable-buffer-local '+lui-filters)
+
+(defun +lui-filter (text &optional fn-alist)
+  (let ((fs (nreverse (purecopy (or fn-alist +lui-filters)))))
+    (while fs
+      (setq text (funcall (cdr (pop fs)) text)))
+    (circe--input text)))
+
+(defmacro +circe-define-filter (name docstring &rest body)
+  "Define a filter for circe-inputted text."
+  (declare (doc-string 2)
+           (indent 1))
+  (let (plist)
+    (while (keywordp (car-safe body))
+      (push (pop body) plist)
+      (push (pop body) plist))
+    ;; Return value
+    `(define-minor-mode ,name
+       ,docstring
+       ,@(nreverse plist)
+       (when (derived-mode-p 'circe-chat-mode)
+         (if ,name
+             (push '(,name . (lambda (it) ,@body)) +lui-filters)
+           (setq +lui-filters
+                 (assoc-delete-all ',name +lui-filters)))))))
+
+;; CAPPY HOUR! (Pure idiocy)
+
+(+circe-define-filter +circe-cappy-hour-mode
   "ENABLE CAPPY HOUR IN CIRCE!"
-  :lighter "CAPPY HOUR"
-  (when (derived-mode-p 'circe-chat-mode)
-    (if circe-cappy-hour-mode
-        (setq-local lui-input-function
-                    (lambda (input) (circe--input (upcase input))))
-      ;; XXX: It'd be better if this were more general, but whatever.
-      (setq-local lui-input-function #'circe--input))))
+  :lighter " CAPPY HOUR"
+  (upcase it))
+
+;; URL Shortener
+
+(+circe-define-filter +circe-shorten-url-mode
+  "Shorten long urls when chatting."
+  :lighter " c0x0"
+  (+circe-0x0-shorten-urls it))
+
+(defvar +circe-0x0-max-length 20
+  "Maximum length of URLs before using a shortener.")
+
+(defun +circe-0x0-shorten-urls (text)
+  "Find urls in TEXT and shorten them using `0x0'."
+  (require '0x0)
+  (require 'browse-url)
+  (let ((case-fold-search t))
+    (replace-regexp-in-string
+     browse-url-button-regexp
+     (lambda (match)
+       (if (> (length match) +circe-0x0-max-length)
+           (+with-message (format "Shortening URL: %s" match)
+             (0x0-shorten-uri (0x0--choose-server)
+                              (substring-no-properties match)))
+         match))
+     text)))
+
+;; Temperature conversion
+
+(+circe-define-filter +circe-F/C-mode
+  "Convert degF to degF/degC for international chats."
+  :lighter " F/C"
+  (str-F/C it))
+
+(defun fahrenheit-to-celsius (degf)
+  "Convert DEGF to Celsius."
+  (round (* (/ 5.0 9.0) (- degf 32))))
+
+(defun celsius-to-fahrenheit (degc)
+  "Convert DEGC to Fahrenheit."
+  (round (+ 32 (* (/ 9.0 5.0) degc))))
+
+(defun str-F/C (text)
+  (replace-regexp-in-string "[0-9.]+[Ff]"
+                            (lambda (match)
+                              (format "%s/%dC" match
+                                      (fahrenheit-to-celsius
+                                       (string-to-number match))))
+                            text))
 
 (provide '+circe)
 ;;; +circe.el ends here
-- 
cgit 1.4.1-21-gabe81