path: root/lisp/+circe.el

;;; +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