dotfiles/emacs/.emacs.d/vendor-lisp/sermon/sermon.el

210 lines
8.2 KiB
EmacsLisp

;;; sermon.el --- Clean up Circe buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2016 Tom Willemse
;; Author: Tom Willemse <chelys@drd>
;; Keywords: convenience
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is an extension module for Circe. It creates what I think is
;; a more minimalistic view of Circe buffers. It right-aligns all the
;; nicks, right-justifies and simplifies certain messages. It takes
;; care of both `fill-prefix' and `wrap-prefix' so it should be usable
;; with and without `lui-fill-type'.
;; The name sermon was chosen because it's pronounced somewhat
;; similarly to cermin, which is an amalgamation of circe
;; minimalistic.
;;; Code:
(defvar sermon-longest-nick 0
"The longest known nick.")
(make-variable-buffer-local 'sermon-longest-nick)
(defvar sermon-original-format-say nil
"The original value of `circe-format-say'.")
(defvar sermon-original-format-self-say nil
"The original value of `circe-format-self-say'.")
(defvar sermon-original-format-action nil
"The original value of `circe-format-action'.")
(defvar sermon-original-format-self-action nil
"The original value of `circe-format-self-action'.")
(defvar sermon-original-format-server-message nil
"The original value of `circe-format-server-message'.")
(defvar sermon-original-format-server-join-in-channel nil
"The original value of `circe-format-server-join-in-channel'.")
(defvar sermon-original-format-server-join nil
"The original value of `circe-format-server-join'.")
(defvar sermon-original-format-server-quit nil
"The original value of `circe-format-server-quit'.")
(defvar sermon-original-format-server-quit-channel nil
"The original value of `circe-format-server-quit-channel'.")
(defvar sermon-original-format-server-part nil
"The original value of `circe-format-server-part'.")
(defvar sermon-original-format-server-nick-change nil
"The original value of `circe-format-server-nick-change'.")
(defun sermon--update-longest-nick (keywords)
(let* ((nick (plist-get keywords :nick))
(len (length nick)))
(when (> len sermon-longest-nick)
(setq sermon-longest-nick len)
(setq-local lui-fill-type (make-string (+ len 3) ?\s)))))
(defun sermon-say-formatter (&rest keywords)
(sermon--update-longest-nick keywords)
(lui-format (format "{nick:%ds} {body}" sermon-longest-nick)
keywords))
(defun sermon-self-say-formatter (&rest keywords)
(format (format "%%%ds %%s" sermon-longest-nick)
">" (plist-get keywords :body)))
(defun sermon-action-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} {nick} {body}" sermon-longest-nick)
(plist-put keywords :intro "*")))
(defun sermon-server-message-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} {body}" sermon-longest-nick)
(plist-put keywords :intro "***")))
(defun sermon-server-join-in-channel-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} Join: {nick} ({userinfo}) joined {channel}"
sermon-longest-nick)
(plist-put keywords :intro ">>>")))
(defun sermon-server-join-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} Join: {nick} ({userinfo})"
sermon-longest-nick)
(plist-put keywords :intro ">>>")))
(defun sermon-server-quit-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} Quit: {nick} ({userhost}) left IRC: {reason}"
sermon-longest-nick)
(plist-put keywords :intro "<<<")))
(defun sermon-server-quit-channel-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} Quit: {nick} ({userhost}) left {channel}: {reason}"
sermon-longest-nick)
(plist-put keywords :intro "<<<")))
(defun sermon-server-part-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} Part: {nick} ({userhost}) left {channel}: {reason}"
sermon-longest-nick)
(plist-put keywords :intro "***")))
(defun sermon-server-nick-change-formatter (&rest keywords)
(lui-format
(format "{intro:%ds} Nick change: {old-nick} ({userhost}) is now know as {new-nick}"
sermon-longest-nick)
(plist-put keywords :intro "***")))
;;;###autoload
(defun enable-sermon ()
(interactive)
(if (null sermon-original-format-say)
(setq sermon-original-format-say
circe-format-say))
(setq circe-format-say #'sermon-say-formatter)
(if (null sermon-original-format-self-say)
(setq sermon-original-format-self-say
circe-format-self-say))
(setq circe-format-self-say #'sermon-say-formatter)
(if (null sermon-original-format-action)
(setq sermon-original-format-action
circe-format-action))
(setq circe-format-action #'sermon-action-formatter)
(if (null sermon-original-format-self-action)
(setq sermon-original-format-self-action
circe-format-self-action))
(setq circe-format-self-action #'sermon-action-formatter)
(if (null sermon-original-format-server-message)
(setq sermon-original-format-server-message
circe-format-server-message))
(setq circe-format-server-message #'sermon-server-message-formatter)
(if (null sermon-original-format-server-join-in-channel)
(setq sermon-original-format-server-join-in-channel
circe-format-server-join-in-channel))
(setq circe-format-server-join-in-channel
#'sermon-server-join-in-channel-formatter)
(if (null sermon-original-format-server-join)
(setq sermon-original-format-server-join
circe-format-server-join))
(setq circe-format-server-join #'sermon-server-join-formatter)
(if (null sermon-original-format-server-quit)
(setq sermon-original-format-server-quit
circe-format-server-quit))
(setq circe-format-server-quit #'sermon-server-quit-formatter)
(if (null sermon-original-format-server-quit-channel)
(setq sermon-original-format-server-quit-channel
circe-format-server-quit-channel))
(setq circe-format-server-quit-channel
#'sermon-server-quit-channel-formatter)
(if (null sermon-original-format-server-part)
(setq sermon-original-format-server-part
circe-format-server-part))
(setq circe-format-server-part #'sermon-server-part-formatter)
(if (null sermon-original-format-server-nick-change)
(setq sermon-original-format-server-nick-change
circe-format-server-nick-change))
(setq circe-format-server-nick-change
#'sermon-server-nick-change-formatter))
(defun disable-sermon ()
(interactive)
(setq circe-format-say sermon-original-format-say
sermon-original-format-say nil
circe-format-self-say sermon-original-format-self-say
sermon-original-format-self-say nil
circe-format-action sermon-original-format-action
sermon-original-format-action nil
circe-format-self-action sermon-original-format-self-action
sermon-original-format-self-action nil
circe-format-server-message sermon-original-format-server-message
sermon-original-format-server-message nil
circe-format-server-join-in-channel sermon-original-format-server-join-in-channel
sermon-original-format-server-join-in-channel nil
circe-format-server-join sermon-original-format-server-join
sermon-original-format-server-join nil
circe-format-server-quit sermon-original-format-server-quit
sermon-original-format-server-quit nil
circe-format-server-quit-channel sermon-original-format-server-quit-channel
sermon-original-format-server-quit-channel nil
circe-format-server-part sermon-original-format-server-part
sermon-original-format-server-part nil
circe-format-server-nick-change sermon-original-format-server-nick-change))
(provide 'sermon)
;;; sermon.el ends here