286 lines
9.2 KiB
EmacsLisp
286 lines
9.2 KiB
EmacsLisp
;;; +circe.el -*- lexical-binding: t; -*-
|
|
|
|
;;; Code:
|
|
|
|
(require '+util)
|
|
(require 'circe)
|
|
|
|
(defgroup +circe nil
|
|
"Extra customizations for Circe."
|
|
:group 'circe)
|
|
|
|
(defcustom +circe-left-margin 16
|
|
"The size of the margin on the left."
|
|
:type 'integer)
|
|
|
|
(defcustom +circe-network-inhibit-autoconnect nil
|
|
"Servers to inhibit autoconnecting from `circe-network-options'."
|
|
:type '(repeat string))
|
|
|
|
;;; Connecting to IRC
|
|
|
|
;;;###autoload
|
|
(defun +irc ()
|
|
"Connect to all IRC networks in `circe-network-options'."
|
|
(interactive)
|
|
(dolist (network (mapcar 'car circe-network-options))
|
|
(unless (member network +circe-network-inhibit-autoconnect)
|
|
(+circe-maybe-connect network))))
|
|
|
|
(defun +circe-network-connected-p (network)
|
|
"Return t if connected to NETWORK, nil otherwise."
|
|
(catch 'return
|
|
(dolist (buffer (circe-server-buffers))
|
|
(with-current-buffer buffer
|
|
(when (string= network circe-server-network)
|
|
(throw 'return t))))))
|
|
|
|
(defun +circe-maybe-connect (network)
|
|
"Connect to NETWORK, asking for confirmation to reconnect."
|
|
(interactive ("sNetwork: "))
|
|
(when (or (not (+circe-network-connected-p network))
|
|
(yes-or-no-p (format "Already connected to %s, reconnect? "
|
|
network)))
|
|
(circe network)))
|
|
|
|
;;; Channel information
|
|
|
|
(defvar-local +circe-current-topic ""
|
|
"Cached topic of the buffer's channel.")
|
|
|
|
(defun +circe-current-topic (&optional message)
|
|
"Return the topic of the current channel.
|
|
When called with optional MESSAGE non-nil, or interactively, also
|
|
message the current topic."
|
|
(interactive "p")
|
|
(let ((topic
|
|
(or (save-excursion
|
|
(goto-char (point-max))
|
|
(and (re-search-backward
|
|
(rx (group "*** "
|
|
(or "Topic" "topic" "TOPIC")
|
|
(* (not ":")) ": ")
|
|
(group (+ nonl)))
|
|
nil t)
|
|
(buffer-substring-no-properties
|
|
(match-beginning 2) (match-end 2))))
|
|
+circe-current-topic)))
|
|
(setq +circe-current-topic topic)
|
|
(when message
|
|
(message "%s" topic))
|
|
topic))
|
|
|
|
;;; Formatting messages
|
|
|
|
(defun +circe-format-meta (string &optional no-nick)
|
|
"Return a format string for `lui-format' for metadata messages.
|
|
Include nick unless NO-NICK is non-nil. If NO-NICK is a string,
|
|
replace {nick} in the string with {NO-NICK}."
|
|
(cond
|
|
((stringp no-nick)
|
|
(format "{%1$s:%2$d.%2$ds} *** %3$s"
|
|
no-nick (- +circe-left-margin 3) string))
|
|
(no-nick
|
|
(format (format "%%%ds *** %s" (- +circe-left-margin 3) string) " "))
|
|
(t
|
|
(format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string))))
|
|
|
|
(defun +circe-format-meta* (string)
|
|
"Return a format string for `lui-format' for metadata messages, /without/ ")
|
|
|
|
(defmacro +lui-make-formatting-list-rx (char)
|
|
"Make a formatting regex for CHAR delimiters.
|
|
For entry into `lui-formatting-list'."
|
|
`(rx (or bol whitespace)
|
|
(group ,char (+? (not (any whitespace ,char))) ,char)
|
|
(or eol whitespace)))
|
|
|
|
;;; Hooks & Advice
|
|
|
|
(defun +circe-chat@set-prompt ()
|
|
"Set the prompt to the (shortened) buffer name."
|
|
(interactive)
|
|
(lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin
|
|
:after " > "
|
|
:ellipsis "~"
|
|
:alignment 'right))))
|
|
|
|
(defun +circe-kill-buffer (&rest _)
|
|
"Kill a circe buffer without confirmation, and after a delay."
|
|
(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'."
|
|
(with-circe-server-buffer
|
|
(dolist (buf (circe-server-buffers))
|
|
(with-current-buffer buf
|
|
(+circe-kill-buffer)))
|
|
(+circe-kill-buffer)))
|
|
|
|
(defun +circe-gquit@kill-buffer (&rest _)
|
|
"ADVICE: kill all Circe buffers after `circe-command-GQUIT'."
|
|
(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."
|
|
(ignore-errors
|
|
(advice-remove 'circe-command-GQUIT
|
|
'circe-gquit@kill-buffer)
|
|
(circe-command-GQUIT "Quitting Emacs, bye!")))
|
|
|
|
;;; Patches
|
|
|
|
(require 'el-patch)
|
|
|
|
(el-patch-feature circe)
|
|
(defvar +circe-server-buffer-action 'pop-to-buffer-same-window
|
|
"What to do with `circe-server' buffers when created.")
|
|
|
|
(el-patch-defun circe (network-or-server &rest server-options)
|
|
"Connect to IRC.
|
|
|
|
Connect to the given network specified by NETWORK-OR-SERVER.
|
|
|
|
When this function is called, it collects options from the
|
|
SERVER-OPTIONS argument, the user variable
|
|
`circe-network-options', and the defaults found in
|
|
`circe-network-defaults', in this order.
|
|
|
|
If NETWORK-OR-SERVER is not found in any of these variables, the
|
|
argument is assumed to be the host name for the server, and all
|
|
relevant settings must be passed via SERVER-OPTIONS.
|
|
|
|
All SERVER-OPTIONS are treated as variables by getting the string
|
|
\"circe-\" prepended to their name. This variable is then set
|
|
locally in the server buffer.
|
|
|
|
See `circe-network-options' for a list of common options."
|
|
(interactive (circe--read-network-and-options))
|
|
(let* ((options (circe--server-get-network-options network-or-server
|
|
server-options))
|
|
(buffer (circe--server-generate-buffer options)))
|
|
(with-current-buffer buffer
|
|
(circe-server-mode)
|
|
(circe--server-set-variables options)
|
|
(circe-reconnect))
|
|
(el-patch-swap (pop-to-buffer-same-window buffer)
|
|
(funcall +circe-server-buffer-action buffer))))
|
|
|
|
;;; Chat commands
|
|
|
|
(defun circe-command-SLAP (nick)
|
|
"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 --- XXX: These don't work right.
|
|
;; Set `lui-input-function' to `+lui-filter', then add the filters you want to
|
|
;; `circe-channel-mode-hook'.
|
|
|
|
(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"
|
|
(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)))
|
|
|
|
(defun +circe-shorten-urls-all ()
|
|
"Turn on `+circe-shorten-url-mode' in all chat buffers."
|
|
(interactive)
|
|
(+mapc-some-buffers
|
|
(lambda () (+circe-shorten-url-mode +1))
|
|
(lambda (buf)
|
|
(derived-mode-p 'circe-chat-mode))))
|
|
|
|
;; 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 "[^.]\\([[:digit:]]+\\(?:\\.[[:digit:]]+\\)?[fF]\\)"
|
|
(lambda (match)
|
|
(format "%s/%dC" match
|
|
(fahrenheit-to-celsius
|
|
(string-to-number match))))
|
|
text
|
|
nil 1))
|
|
|
|
(provide '+circe)
|
|
;;; +circe.el ends here
|