diff options
| author | William Carroll <wpcarro@gmail.com> | 2018-09-10T18·51-0400 |
|---|---|---|
| committer | William Carroll <wpcarro@gmail.com> | 2018-09-10T18·53-0400 |
| commit | 17ee0e400bef47c371afcae76037f9ea6a44ad13 (patch) | |
| tree | 0e5efee6f00e402890e91f3eceb4b29408a498b6 /configs/shared/emacs/.emacs.d/elpa/circe-20180525.531 | |
| parent | 8b2fadf4776b7ddb4a67b4bc8ff6463770e56028 (diff) | |
Support Vim, Tmux, Emacs with Stow
After moving off of Meta, Dotfiles has a greater responsibility to manage configs. Vim, Tmux, and Emacs are now within Stow's purview.
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.531')
38 files changed, 9629 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-autoloads.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-autoloads.el new file mode 100644 index 000000000000..20f3a7807a93 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-autoloads.el @@ -0,0 +1,226 @@ +;;; circe-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) + +;;;### (autoloads nil "circe" "circe.el" (23377 61594 971310 23000)) +;;; Generated autoloads from circe.el + +(autoload 'circe-version "circe" "\ +Display Circe's version. + +\(fn)" t nil) + +(autoload 'circe "circe" "\ +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. + +\(fn NETWORK-OR-SERVER &rest SERVER-OPTIONS)" t nil) + +;;;*** + +;;;### (autoloads nil "circe-color-nicks" "circe-color-nicks.el" +;;;;;; (23377 61594 965904 520000)) +;;; Generated autoloads from circe-color-nicks.el + +(autoload 'enable-circe-color-nicks "circe-color-nicks" "\ +Enable the Color Nicks module for Circe. +This module colors all encountered nicks in a cross-server fashion. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "circe-display-images" "circe-display-images.el" +;;;;;; (23377 61594 968709 333000)) +;;; Generated autoloads from circe-display-images.el + +(autoload 'enable-circe-display-images "circe-display-images" "\ +Enable the Display Images module for Circe. +This module displays various image types when they are linked in a channel + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "circe-lagmon" "circe-lagmon.el" (23377 61594 +;;;;;; 970011 224000)) +;;; Generated autoloads from circe-lagmon.el + +(defvar circe-lagmon-mode nil "\ +Non-nil if Circe-Lagmon mode is enabled. +See the `circe-lagmon-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `circe-lagmon-mode'.") + +(custom-autoload 'circe-lagmon-mode "circe-lagmon" nil) + +(autoload 'circe-lagmon-mode "circe-lagmon" "\ +Circe-lagmon-mode monitors the amount of lag on your +connection to each server, and displays the lag time in seconds +in the mode-line. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "circe-new-day-notifier" "circe-new-day-notifier.el" +;;;;;; (23377 61594 980603 307000)) +;;; Generated autoloads from circe-new-day-notifier.el + +(autoload 'enable-circe-new-day-notifier "circe-new-day-notifier" "\ + + +\(fn)" t nil) + +(autoload 'disable-circe-new-day-notifier "circe-new-day-notifier" "\ + + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "lui-autopaste" "lui-autopaste.el" (23377 61594 +;;;;;; 974106 860000)) +;;; Generated autoloads from lui-autopaste.el + +(autoload 'enable-lui-autopaste "lui-autopaste" "\ +Enable the lui autopaste feature. + +If you enter more than `lui-autopaste-lines' at once, Lui will +ask if you would prefer to use a paste service instead. If you +agree, Lui will paste your input to `lui-autopaste-function' and +replace it with the resulting URL. + +\(fn)" t nil) + +(autoload 'disable-lui-autopaste "lui-autopaste" "\ +Disable the lui autopaste feature. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "lui-irc-colors" "lui-irc-colors.el" (23377 +;;;;;; 61594 983284 828000)) +;;; Generated autoloads from lui-irc-colors.el + +(autoload 'enable-lui-irc-colors "lui-irc-colors" "\ +Enable IRC color interpretation for Lui. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "lui-track-bar" "lui-track-bar.el" (23377 61594 +;;;;;; 967329 142000)) +;;; Generated autoloads from lui-track-bar.el + +(autoload 'enable-lui-track-bar "lui-track-bar" "\ +Enable a bar in Lui buffers that shows where you stopped reading. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "shorten" "shorten.el" (23377 61594 976651 +;;;;;; 52000)) +;;; Generated autoloads from shorten.el + +(autoload 'shorten-strings "shorten" "\ +Takes a list of strings and returns an alist ((STRING +. SHORTENED-STRING) ...). Uses `shorten-split-function' to split +the strings, and `shorten-join-function' to join shortened +components back together into SHORTENED-STRING. See also +`shorten-validate-component-function'. + +\(fn STRINGS)" nil nil) + +;;;*** + +;;;### (autoloads nil "tracking" "tracking.el" (23377 61594 963081 +;;;;;; 521000)) +;;; Generated autoloads from tracking.el + +(defvar tracking-mode nil "\ +Non-nil if Tracking mode is enabled. +See the `tracking-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `tracking-mode'.") + +(custom-autoload 'tracking-mode "tracking" nil) + +(autoload 'tracking-mode "tracking" "\ +Allow cycling through modified buffers. +This mode in itself does not track buffer modification, but +provides an API for programs to add buffers as modified (using +`tracking-add-buffer'). + +Once this mode is active, modified buffers are shown in the mode +line. The user can cycle through them using +\\[tracking-next-buffer]. + +\(fn &optional ARG)" t nil) + +(autoload 'tracking-add-buffer "tracking" "\ +Add BUFFER as being modified with FACES. +This does check whether BUFFER is currently visible. + +If FACES is given, it lists the faces that might be appropriate +for BUFFER in the mode line. The highest-priority face of these +and the current face of the buffer, if any, is used. Priority is +decided according to `tracking-faces-priorities'. +When `tracking-sort-faces-first' is non-nil, all buffers with any +face set will be stable-sorted before any buffers with no face set. + +\(fn BUFFER &optional FACES)" nil nil) + +(autoload 'tracking-remove-buffer "tracking" "\ +Remove BUFFER from being tracked. + +\(fn BUFFER)" nil nil) + +(autoload 'tracking-next-buffer "tracking" "\ +Switch to the next active buffer. + +\(fn)" t nil) + +(autoload 'tracking-previous-buffer "tracking" "\ +Switch to the last active buffer. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("circe-chanop.el" "circe-compat.el" "circe-pkg.el" +;;;;;; "irc.el" "lcs.el" "lui-format.el" "lui-logging.el" "lui.el" +;;;;;; "make-tls-process.el") (23377 61594 984675 379000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; circe-autoloads.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-chanop.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-chanop.el new file mode 100644 index 000000000000..a5880e5f8c1e --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-chanop.el @@ -0,0 +1,97 @@ +;;; circe-chanop.el --- Provide common channel operator commands + +;; Copyright (C) 2006, 2015 Jorgen Schaefer + +;; Author: Jorgen Schaefer <forcer@forcix.cx> + +;; This file is part of Circe. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This Circe module provides some often-used chanop commands. I was +;; very reluctant to add this. None of these commands will make it in +;; the core, or even be provided by default. You should have to go to +;; great lengths to use them. + +;; Always remember the Tao of IRC: +;; +;; IGNORE is the weapon of an IRC knight. Not as clumsy or as +;; random as a kickban. + +;;; Code: + +(require 'circe) + +(defun circe-command-MODE (mode) + "Set MODE in the current channel." + (interactive "sMode change: ") + (cond + ((not (string-match "^[+-]" mode)) + (irc-send-raw (circe-server-process) + (format "MODE %s" mode))) + ((eq major-mode 'circe-channel-mode) + (irc-send-raw (circe-server-process) + (format "MODE %s %s" circe-chat-target mode))) + (t + (circe-display-server-message "Not in a channel buffer.")))) + +(defun circe-command-BANS (&optional ignored) + "Show channel bans" + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (irc-send-raw (circe-server-process) + (format "MODE %s +b" circe-chat-target)))) + +(defun circe-command-KICK (nick &optional reason) + "Kick WHO from the current channel with optional REASON." + (interactive "sKick who: \nsWhy: ") + (if (not (eq major-mode 'circe-channel-mode)) + (circe-display-server-message "Not in a channel buffer.") + (when (not reason) + (if (string-match "^\\([^ ]*\\) +\\(.+\\)" nick) + (setq reason (match-string 2 nick) + nick (match-string 1 nick)) + (setq reason "-"))) + (irc-send-raw (circe-server-process) + (format "KICK %s %s :%s" + circe-chat-target nick reason)))) + +(defun circe-command-GETOP (&optional ignored) + "Ask chanserv for op on the current channel." + (interactive) + (if (not (eq major-mode 'circe-channel-mode)) + (circe-display-server-message "Not in a channel buffer.") + (irc-send-PRIVMSG (circe-server-process) + "chanserv" + (format "op %s" circe-chat-target)))) + +(defun circe-command-DROPOP (&optional ignored) + "Lose op mode on the current channel." + (interactive) + (if (not (eq major-mode 'circe-channel-mode)) + (circe-display-server-message "Not in a channel buffer.") + (irc-send-raw (circe-server-process) + (format "MODE %s -o %s" + circe-chat-target + (circe-nick))))) + +;; For KICKBAN (requested by Riastradh), we'd need a callback on a +;; USERHOST command. + +(provide 'circe-chanop) +;;; circe-chanop.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-chanop.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-chanop.elc new file mode 100644 index 000000000000..5b27c801d03b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-chanop.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-color-nicks.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-color-nicks.el new file mode 100644 index 000000000000..dd5e64e04fa6 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-color-nicks.el @@ -0,0 +1,340 @@ +;;; circe-color-nicks.el --- Color nicks in the channel + +;; Copyright (C) 2012 Taylan Ulrich Bayırlı/Kammer + +;; Author: Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> + +;; This file is part of Circe. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This Circe module adds the ability to assign a color to each +;; nick in a channel. + +;; Some ideas/code copied from rcirc-colors.el. + +;; To use it, put the following into your .emacs: + +;; (require 'circe-color-nicks) +;; (enable-circe-color-nicks) + +;;; Code: + +(require 'circe) +(require 'color) +(require 'cl-lib) + +;;;###autoload +(defun enable-circe-color-nicks () + "Enable the Color Nicks module for Circe. +This module colors all encountered nicks in a cross-server fashion." + (interactive) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'circe-channel-mode) + (add-circe-color-nicks)))) + (add-hook 'circe-channel-mode-hook + 'add-circe-color-nicks)) + +(defun disable-circe-color-nicks () + "Disable the Color Nicks module for Circe. +See `enable-circe-color-nicks'." + (interactive) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'circe-channel-mode) + (remove-circe-color-nicks)))) + (remove-hook 'circe-channel-mode-hook + 'add-circe-color-nicks)) + +(defun add-circe-color-nicks () + "Add `circe-color-nicks' to `lui-pre-output-hook'." + (add-hook 'lui-pre-output-hook 'circe-color-nicks)) + +(defun remove-circe-color-nicks () + "Remove `circe-color-nicks' from `lui-pre-output-hook'." + (remove-hook 'lui-pre-output-hook 'circe-color-nicks)) + + +(defgroup circe-color-nicks nil + "Nicks colorization for Circe" + :prefix "circe-color-nicks-" + :group 'circe) + +(defcustom circe-color-nicks-min-contrast-ratio 7 + "Minimum contrast ratio from background for generated colors; +recommended is 7:1, or at least 4.5:1 (7 stands for 7:1 here). +Lower value allows higher color spread, but could lead to less +readability." + :group 'circe-color-nicks) + +(defcustom circe-color-nicks-min-difference 17 + "Minimum difference from each other for generated colors." + :group 'circe-color-nicks) + +(defcustom circe-color-nicks-min-fg-difference 17 + "Minimum difference from foreground for generated colors." + :group 'circe-color-nicks) + +(defcustom circe-color-nicks-min-my-message-difference 0 + "Minimum difference from own nick color for generated colors." + :group 'circe-color-nicks) + +(defcustom circe-color-nicks-everywhere nil + "Whether nicks should be colored in message bodies too." + :type 'boolean + :group 'circe-color-nicks) + +(defcustom circe-color-nicks-message-blacklist nil + "Blacklist for nicks that shall never be highlighted inside + images." + :type '(repeat string) + :group 'circe-color-nicks) + +(defcustom circe-color-nicks-pool-type 'adaptive + "Type of the color nick pool. +Must be one of the following: + +'adaptive: Generate colors based on the current theme. + +List of strings: Pick colors from the specified list of hex codes +or color names (see `color-name-rgb-alist')." + :type '(choice (const :tag "Adaptive" adaptive) + (repeat string)) + :group 'circe-color-nicks) + + +;;; See http://www.w3.org/TR/2013/NOTE-WCAG20-TECHS-20130905/G18 + +(defsubst circe-w3-contrast-c-to-l (c) + (if (<= c 0.03928) + (/ c 12.92) + (expt (/ (+ c 0.055) 1.055) 2.4))) + +(defsubst circe-w3-contrast-relative-luminance (rgb) + (apply #'+ + (cl-mapcar (lambda (color coefficient) + (* coefficient + (circe-w3-contrast-c-to-l color))) + rgb + '(0.2126 0.7152 0.0722)))) + +(defsubst circe-w3-contrast-contrast-ratio (color1 color2) + (let ((l1 (+ 0.05 (circe-w3-contrast-relative-luminance color1))) + (l2 (+ 0.05 (circe-w3-contrast-relative-luminance color2)))) + (if (> l1 l2) + (/ l1 l2) + (/ l2 l1)))) + + +(defun circe-color-alist () + "Return list of colors (name rgb lab) where rgb is 0 to 1." + (let ((alist (if (display-graphic-p) + color-name-rgb-alist + (mapcar (lambda (c) + (cons (car c) (cddr c))) + (tty-color-alist)))) + (valmax (float (car (color-values "#ffffff"))))) + (mapcar (lambda (c) + (let* ((name (car c)) + (rgb (mapcar (lambda (v) + (/ v valmax)) + (cdr c))) + (lab (apply #'color-srgb-to-lab rgb))) + (list name rgb lab))) + alist))) + +(defun circe-color-canonicalize-format (color) + "Turns COLOR into (name rgb lab) format. Avoid calling this in +a loop, it's very slow on a tty!" + (let* ((name color) + (rgb (circe-color-name-to-rgb color)) + (lab (apply #'color-srgb-to-lab rgb))) + (list name rgb lab))) + +(defun circe-color-contrast-ratio (color1 color2) + "Gives the contrast ratio between two colors." + (circe-w3-contrast-contrast-ratio (nth 1 color1) (nth 1 color2))) + +(defun circe-color-diff (color1 color2) + "Gives the difference between two colors per CIEDE2000." + (color-cie-de2000 (nth 2 color1) (nth 2 color2))) + +(defun circe-color-name-to-rgb (color) + "Like `color-name-to-rgb' but also handles \"unspecified-bg\" +and \"unspecified-fg\"." + (cond ((equal color "unspecified-bg") '(0 0 0)) + ((equal color "unspecified-fg") '(1 1 1)) + (t (color-name-to-rgb color)))) + + +(defun circe-nick-color-appropriate-p (color bg fg my-msg) + "Tells whether COLOR is appropriate for being a nick color. +BG, FG, and MY-MSG are the background, foreground, and my-message +colors; these are expected as parameters instead of computed here +because computing them repeatedly is a heavy operation." + (and (>= (circe-color-contrast-ratio color bg) + circe-color-nicks-min-contrast-ratio) + (>= (circe-color-diff color fg) + circe-color-nicks-min-fg-difference) + (>= (circe-color-diff color my-msg) + circe-color-nicks-min-my-message-difference))) + +(defun circe-nick-colors-delete-similar (colors) + "Return list COLORS with pairs of colors filtered out that are +too similar per `circe-color-nicks-min-difference'. COLORS may +be mutated." + (cl-mapl (lambda (rest) + (let ((color (car rest))) + (setcdr rest (cl-delete-if + (lambda (c) + (< (circe-color-diff color c) + circe-color-nicks-min-difference)) + (cdr rest))))) + colors) + colors) + +(defun circe-nick-color-generate-pool () + "Return a list of appropriate nick colors." + (if (consp circe-color-nicks-pool-type) + circe-color-nicks-pool-type + (let ((bg (circe-color-canonicalize-format (face-background 'default))) + (fg (circe-color-canonicalize-format (face-foreground 'default))) + (my-msg (circe-color-canonicalize-format + (face-attribute + 'circe-my-message-face :foreground nil 'default)))) + (mapcar #'car (circe-nick-colors-delete-similar + (cl-remove-if-not + (lambda (c) + (circe-nick-color-appropriate-p c bg fg my-msg)) + (circe-color-alist))))))) + +(defun circe-nick-color-pool-test () + "Display all appropriate nick colors in a temp buffer." + (interactive) + (switch-to-buffer (get-buffer-create "*Circe color test*")) + (erase-buffer) + (let ((pool (circe-nick-color-generate-pool))) + (while pool + (let ((pt (point))) + (insert "The quick brown fox jumped over the lazy dog.\n") + (put-text-property pt (point) 'face `(:foreground ,(pop pool))))))) + +(defvar circe-nick-color-pool nil + "Pool of yet unused nick colors.") + +(defvar circe-nick-color-mapping (make-hash-table :test 'equal) + "Hash-table from nicks to colors.") + +(defun circe-nick-color-nick-list () + "Return list of all nicks that should be colored in this channel. +Own and blacklisted nicks are excluded." + (let ((our-nick (circe-nick)) + (channel-nicks (circe-channel-nicks))) + (cl-remove-if (lambda (nick) + (or (string= our-nick nick) + (member nick circe-color-nicks-message-blacklist))) + channel-nicks))) + +(defvar circe-nick-color-timestamps (make-hash-table :test 'equal) + "Hash-table from colors to the timestamp of their last use.") + +(defun circe-nick-color-for-nick (nick) + "Return the color for NICK. Assigns a color to NICK if one +wasn't assigned already." + (let ((color (gethash nick circe-nick-color-mapping))) + (when (not color) + ;; NOTE use this as entry point for taking NICK into account for + ;; picking the new color + (setq color (circe-nick-color-pick)) + (puthash nick color circe-nick-color-mapping)) + (puthash color (float-time) circe-nick-color-timestamps) + color)) + +(defun circe-nick-color-pick () + "Picks either a color from the pool of unused colors, or the +color that was used least recently (i.e. nicks that have it +assigned have been least recently active)." + (if (zerop (hash-table-count circe-nick-color-mapping)) + (setq circe-nick-color-pool (circe-nick-color-generate-pool))) + (or (pop circe-nick-color-pool) + (circe-nick-color-pick-least-recent))) + +(defun circe-nick-color-pick-least-recent () + "Pick the color that was used least recently. +See `circe-nick-color-pick', which is where this is used." + (let ((least-recent-color nil) + (oldest-time (float-time))) + (maphash + (lambda (color time) + (if (< time oldest-time) + (progn + (setq least-recent-color color) + (setq oldest-time time)))) + circe-nick-color-timestamps) + (if least-recent-color + least-recent-color + ;; Someone must have messed with `circe-nick-color-mapping', recover by + ;; re-filling the pool. + (setq circe-nick-color-pool (circe-nick-color-generate-pool)) + (pop circe-nick-color-pool)))) + +(defun circe-color-nicks () + "Color nicks on this lui output line." + (when (eq major-mode 'circe-channel-mode) + (let ((nickstart (text-property-any (point-min) (point-max) + 'lui-format-argument 'nick))) + (when nickstart + (goto-char nickstart) + (let ((nickend (next-single-property-change nickstart + 'lui-format-argument)) + (nick (plist-get (plist-get (text-properties-at nickstart) + 'lui-keywords) + :nick))) + (when (not (circe-server-my-nick-p nick)) + (let ((color (circe-nick-color-for-nick nick))) + (add-face-text-property nickstart nickend + `(:foreground ,color))))))) + (when circe-color-nicks-everywhere + (let ((body (text-property-any (point-min) (point-max) + 'lui-format-argument 'body))) + (when body + (with-syntax-table circe-nick-syntax-table + (goto-char body) + (let* ((nicks (circe-nick-color-nick-list)) + (regex (regexp-opt nicks 'words))) + (let (case-fold-search) + (while (re-search-forward regex nil t) + (let* ((nick (match-string-no-properties 0)) + (color (circe-nick-color-for-nick nick))) + (add-face-text-property (match-beginning 0) (match-end 0) + `(:foreground ,color)))))))))))) + +(defun circe-nick-color-reset () + "Reset the nick color mapping (and some internal data). + +This is useful if you switched between frames supporting +different color ranges and would like nicks to get new colors +appropriate to the new color range." + (interactive) + (setq circe-nick-color-pool (circe-nick-color-generate-pool)) + (setq circe-nick-color-mapping (make-hash-table :test 'equal)) + (setq circe-nick-color-timestamps (make-hash-table :test 'equal))) + +(provide 'circe-color-nicks) +;;; circe-color-nicks.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-color-nicks.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-color-nicks.elc new file mode 100644 index 000000000000..8758a95984c6 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-color-nicks.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-compat.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-compat.el new file mode 100644 index 000000000000..f509c66d5b14 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-compat.el @@ -0,0 +1,53 @@ +;;; circe-compat.el --- Compatibility definitions + +;; Copyright (C) 2015 Jorgen Schaefer <contact@jorgenschaefer.de> + +;; Author: Jorgen Schaefer <contact@jorgenschaefer.de> + +;; 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: + +;; Define functions and variables as needed by Circe to remain +;; compatible with older Emacsen. + +;;; Code: + +(when (not (fboundp 'string-trim)) + (defun string-trim (string) + "Remove leading and trailing whitespace from STRING." + (if (string-match "\\` *\\(.*[^[:space:]]\\) *\\'" string) + (match-string 1 string) + string))) + +(when (not (fboundp 'add-face-text-property)) + (defun add-face-text-property (start end face &optional append object) + (while (/= start end) + (let* ((next (next-single-property-change start 'face object end)) + (prev (get-text-property start 'face object)) + (value (if (listp prev) prev (list prev)))) + (put-text-property start next 'face + (if append + (append value (list face)) + (append (list face) value)) + object) + (setq start next))))) + +(when (not (boundp 'mode-line-misc-info)) + (defvar mode-line-misc-info nil + "Misc info in the mode line.") + (add-to-list 'mode-line-format 'mode-line-misc-info t)) + +(provide 'circe-compat) +;;; circe-compat.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-compat.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-compat.elc new file mode 100644 index 000000000000..bd4554cbacfa --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-compat.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-display-images.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-display-images.el new file mode 100644 index 000000000000..6c9e29a251e8 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-display-images.el @@ -0,0 +1,197 @@ +;;; circe-display-images.el --- Display images in the channel -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Nathan Aclander + +;; Author: Nathan Aclander <nathan.aclander@gmail.com> + +;; This file is part of Circe. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This Circe modules adds the ability to display various image types when +;; they are linked in a channel. Images are inserted on new lines after +;; the message containing the URLs. This module requires ImageMagcik. + +;; To use it, put the following into your .emacs: + +;; (require 'circe-display-images) +;; (enable-circe-display-images) + +;;; Code: + +(require 'circe) +(require 'url) + +;;;###autoload +(defun enable-circe-display-images () + "Enable the Display Images module for Circe. +This module displays various image types when they are linked in a channel" + (interactive) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'circe-channel-mode) + (add-circe-display-images)))) + (add-hook 'circe-channel-mode-hook + 'add-circe-display-images)) + +(defun disable-circe-display-images () + "Disable the Display Images module for Circe. +See `enable-circe-display-images'." + (interactive) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'circe-channel-mode) + (remove-circe-display-images)))) + (remove-hook 'circe-channel-mode-hook + 'add-circe-display-images)) + +(defun add-circe-display-images () + "Add `circe-display-images' to `lui-pre-output-hook'." + (add-hook 'lui-pre-output-hook 'circe-display-images)) + +(defun remove-circe-display-images () + "Remove `circe-display-images' from `lui-pre-output-hook'." + (remove-hook 'lui-pre-output-hook 'circe-display-images)) + +(defgroup circe-display-images nil + "Image display properties for Circe" + :prefix "circe-display-images" + :group 'circe) + +(defcustom circe-display-images-image-regex + "\\(https?:\/\/[^ ]*?\.\\\(?:png\\|jpg\\|jpeg\\|svg\\|gif\\)\\)" + "Regex used to find images in channel messages. This regex needs to be +greedy to match multiple images on the same line." + :group 'circe-display-images) + +(defcustom circe-display-images-max-height 400 + "The image's maximum allowed height. Images will be scaled down if they +are larger than this" + :group 'circe-display-images) + +(defcustom circe-display-images-background nil + "Background used for the images background, if image supports transparency. +Defaults to the frame's background color." + :group 'circe-display-images) + +(defcustom circe-display-images-animate-gifs nil + "Animate any gifs that are displayed. This might slow down Emacs." + :group 'circe-display-images) + +(defvar-local circe-display-images-text-property-map (make-hash-table + :test 'equal) + "A hash map used to manage display transitions. + +The keys are urls, and the values are a plist with an `:image-property', and a +`:display-image-p'. `:image-property' is the display property of the image, and +`:display-image-p' is a flag telling us whether the image is currently visible +or not. This map serves to keep track of display transitions, and as a mapping +between the URL and its downloaded image. + +Unfortunately we can't map from URL to the image position in the buffer +because 1) the lui library can move text around when executing the +`lui-post-output-hooks' and 2) as we toggle images, that also changes other +images' position in the buffer.") + +(defun circe-display-images-toggle-image-at-point () + "Toggle the image corresponding to the url at point. + +This function iterates through all display properties in the buffer. We look +for a match with the display property we got from our property map, with the +url-at-point as the key. When we find a match, we either remove or add back +the image. See `circe-display-images-text-property-map' for more details." + ;; Giant thank you to Malabarba who's S-O answer I slightly modified: + ;; https://emacs.stackexchange.com/a/566 + (interactive) + (let* + ((inhibit-read-only t) + (url (url-get-url-at-point)) + (image-data(gethash url circe-display-images-text-property-map)) + (display-image-p (plist-get image-data :display-image-p)) + (image-property-of-url (plist-get image-data :image-property)) + (from (if display-image-p 'display 'display-backup)) + (to (if display-image-p 'display-backup 'display)) + (current-pos (point-min)) + left current-image-property) + (while (and current-pos (/= current-pos (point-max))) + ;; Find the next image property in the buffer. + (if (get-text-property current-pos from) + (setq left current-pos) + (setq left (next-single-property-change current-pos from))) + (if (or (null left) (= left (point-max))) + (setq current-pos nil) + (setq current-image-property (get-text-property left from)) + (setq current-pos (or (next-single-property-change left from) + (point-max))) + ;; Swap the images if our current image matches the image from the URL. + (when (equal image-property-of-url current-image-property) + (add-text-properties + left current-pos (list from nil to current-image-property))))) + ;; Make sure to invert the :display-image-p flag after processing all + ;; images. + (puthash url `(:image-property ,image-property-of-url + :display-image-p ,(not display-image-p)) + circe-display-images-text-property-map))) + +(defun circe-display-images-insert-image-from-url (url) + "Attempt to download the image from URL, and insert it." + (let ((buffer (url-retrieve-synchronously url))) + (when buffer + (unwind-protect + (let* ((data (with-current-buffer buffer + (goto-char (point-min)) + (search-forward "\n\n") + (buffer-substring (point) (point-max)))) + (img (create-image + data 'imagemagick t + :max-height circe-display-images-max-height + :background circe-display-images-background))) + (when img + (insert-image img) + ;; Store the image so that we can toggle it on and off later. We + ;; know the image is 1 behind us, since we just inserted it. + (let* ((image-property + (get-text-property (- (point) 1) 'display))) + (puthash url + `(:image-property ,image-property :display-image-p t) + circe-display-images-text-property-map)) + ;; This is safely a no-op if the image isn't a gif. + (when circe-display-images-animate-gifs + (image-animate img)))) + (kill-buffer buffer))))) + +(defun circe-display-images-urls-in-body () + "Return all urls that match the circe-display-images-image-regex" + (let (urls) + (while (re-search-forward circe-display-images-image-regex nil t) + (setq urls (cons (match-string-no-properties 1) urls))) + (reverse urls))) + +(defun circe-display-images () + "Replace image link with downloaded image on this lui output line" + (let ((body (text-property-any (point-min) (point-max) + 'lui-format-argument 'body))) + (when body + (goto-char body) + (dolist (url (circe-display-images-urls-in-body)) + (newline) + (circe-display-images-insert-image-from-url url) + (newline))))) + +(provide 'circe-display-images) +;;; circe-display-images.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-display-images.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-display-images.elc new file mode 100644 index 000000000000..4ebbda193bf7 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-display-images.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-lagmon.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-lagmon.el new file mode 100644 index 000000000000..42a37329ca5f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-lagmon.el @@ -0,0 +1,243 @@ +;;; circe-lagmon.el --- Lag Monitor for Circe + +;; Copyright (C) 2011-2012 Jorgen Schaefer + +;; Author: John J Foerch <jjfoerch@earthlink.net>, +;; Jorgen Schaefer + +;; This file is part of Circe. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +;; 02110-1301, USA. + +;;; Commentary: +;;; +;;; Circe-lagmon-mode monitors the amount of lag on your connection to +;;; each server, and displays the lag time in seconds in the mode-line. +;;; It works by managing two timers. Timer1 sends CTCP LAGMON to yourself +;;; on each server every 60 seconds. Each time around, timer1 starts +;;; timer2 to monitor for timeouts of these messages. Timer2 cancels +;;; itself when all of the pings in the round have been answered. +;;; + +;;; Code: + +(require 'circe) + +;;; User variables + +(defgroup circe-lagmon nil + "Lag Monitor for Circe" + :prefix "circe-lagmon-" + :group 'circe) + +(defcustom circe-lagmon-timer-tick 5 + "How often to check for lag. + +Increase this to improve performance at the cost of accuracy." + :type 'number + :group 'circe-lagmon) + +(defcustom circe-lagmon-check-interval 60 + "Interval in seconds at which to send the CTCP message." + :type 'number + :group 'circe-lagmon) + +(defcustom circe-lagmon-reconnect-interval 120 + "Seconds after which to automatically reconnect upon a timeout +of a lag monitor message. A value of nil disables the feature." + :type '(choice (const :tag "Disable auto-reconnect" nil) + number) + :group 'circe-lagmon) + +(defcustom circe-lagmon-mode-line-format-string "lag:%.1f " + "Format string for displaying the lag in the mode-line." + :type 'string + :group 'circe-lagmon) + +(defcustom circe-lagmon-mode-line-unknown-lag-string "lag:? " + "Indicator string for displaying unknown lag in the mode-line." + :type 'string + :group 'circe-lagmon) + +(defvar circe-lagmon-disabled nil + "A boolean value if lagmon should be disabled on this network. + +Don't set this by hand, use `circe-network-options'.") +(make-variable-buffer-local 'circe-lagmon-disabled) + + +;;; Internal variables +;;; +(defvar circe-lagmon-timer nil) + +(defvar circe-lagmon-server-lag nil) +(make-variable-buffer-local 'circe-lagmon-server-lag) + +(defvar circe-lagmon-last-send-time nil) +(make-variable-buffer-local 'circe-lagmon-last-send-time) + +(defvar circe-lagmon-last-receive-time nil) +(make-variable-buffer-local 'circe-lagmon-last-receive-time) + +(defun circe-lagmon-timer-tick () + "Function run periodically to check lag. + +This will call `circe-lagmon-server-check' in every active server +buffer. You can call it yourself if you like to force an update, +there is no harm in running it too often, but it really should be +run sufficiently often with the timer." + (dolist (buffer (circe-server-buffers)) + (with-current-buffer buffer + (when (and (eq major-mode 'circe-server-mode) + circe-server-process + (eq (irc-connection-state circe-server-process) + 'registered) + (not circe-lagmon-disabled)) + (circe-lagmon-server-check))))) + +(defun circe-lagmon-server-check () + "Check the current server for lag. + +This will reconnect if we haven't heard back for too long, or +send a request if it's time for that. See +`circe-lagmon-reconnect-interval' and +`circe-lagmon-check-interval' to configure the behavior.." + (let ((now (float-time))) + (cond + ;; No answer so far... + ((and circe-lagmon-last-send-time + (not circe-lagmon-last-receive-time)) + ;; Count up until the answer comes. + (let ((lag (/ (- now circe-lagmon-last-send-time) 2))) + (when (or (not circe-lagmon-server-lag) + (> lag circe-lagmon-server-lag)) + (setq circe-lagmon-server-lag lag) + (circe-lagmon-force-mode-line-update))) + ;; Check for timeout. + (when (and circe-lagmon-reconnect-interval + (> now + (+ circe-lagmon-last-send-time + circe-lagmon-reconnect-interval))) + (setq circe-lagmon-last-send-time nil + circe-lagmon-last-receive-time nil) + (circe-reconnect))) + ;; Nothing sent so far, or last send was too long ago. + ((or (not circe-lagmon-last-send-time) + (> now + (+ circe-lagmon-last-send-time + circe-lagmon-check-interval))) + (irc-send-raw (circe-server-process) + (format "PRIVMSG %s :\C-aLAGMON %s\C-a" + (circe-nick) now) + :nowait) + (setq circe-lagmon-last-send-time now + circe-lagmon-last-receive-time nil)) + ))) + +(defun circe-lagmon-force-mode-line-update () + "Call force-mode-line-update on a circe server buffer and all +of its chat buffers." + (force-mode-line-update) + (dolist (b (circe-server-chat-buffers)) + (with-current-buffer b + (force-mode-line-update)))) + +(defun circe-lagmon-format-mode-line-entry () + "Format the mode-line entry for displaying the lag." + (let ((buf (cond + ((eq major-mode 'circe-server-mode) + (current-buffer)) + (circe-server-buffer + circe-server-buffer) + (t + nil)))) + (when buf + (with-current-buffer buf + (cond + (circe-lagmon-disabled + nil) + (circe-lagmon-server-lag + (format circe-lagmon-mode-line-format-string + circe-lagmon-server-lag)) + (t + circe-lagmon-mode-line-unknown-lag-string)))))) + +(defun circe-lagmon-init () + "Initialize the values of the lag monitor for one server, and +start the lag monitor if it has not been started." + (setq circe-lagmon-server-lag nil + circe-lagmon-last-send-time nil + circe-lagmon-last-receive-time nil) + (circe-lagmon-force-mode-line-update) + (unless circe-lagmon-timer + (setq circe-lagmon-timer + (run-at-time nil circe-lagmon-timer-tick + 'circe-lagmon-timer-tick)))) + +(defun circe-lagmon--rpl-welcome-handler (conn &rest ignored) + (with-current-buffer (irc-connection-get conn :server-buffer) + (circe-lagmon-init))) + +(defun circe-lagmon--ctcp-lagmon-handler (conn event sender target argument) + (when (irc-current-nick-p conn (irc-userstring-nick sender)) + (with-current-buffer (irc-connection-get conn :server-buffer) + (let* ((now (float-time)) + (lag (/ (- now (string-to-number argument)) + 2))) + (setq circe-lagmon-server-lag lag + circe-lagmon-last-receive-time now) + (circe-lagmon-force-mode-line-update))))) + +(defun circe-lagmon--nick-handler (conn event sender new-nick) + (when (irc-current-nick-p conn (irc-userstring-nick sender)) + (with-current-buffer (irc-connection-get conn :server-buffer) + (setq circe-lagmon-last-send-time nil)))) + +;;;###autoload +(define-minor-mode circe-lagmon-mode + "Circe-lagmon-mode monitors the amount of lag on your +connection to each server, and displays the lag time in seconds +in the mode-line." + :global t + (let ((mode-line-entry '(:eval (circe-lagmon-format-mode-line-entry)))) + (remove-hook 'mode-line-modes mode-line-entry) + (let ((table (circe-irc-handler-table))) + (irc-handler-remove table "001" 'circe-lagmon--rpl-welcome-handler) + (irc-handler-remove table "irc.ctcp.LAGMON" + 'circe-lagmon--ctcp-lagmon-handler) + (irc-handler-remove table "NICK" 'circe-lagmon--nick-handler)) + (circe-set-display-handler "irc.ctcp.LAGMON" nil) + (when circe-lagmon-timer + (cancel-timer circe-lagmon-timer) + (setq circe-lagmon-timer nil)) + (when circe-lagmon-mode + (add-hook 'mode-line-modes mode-line-entry) + (let ((table (circe-irc-handler-table))) + (irc-handler-add table "001" 'circe-lagmon--rpl-welcome-handler) + (irc-handler-add table "irc.ctcp.LAGMON" + 'circe-lagmon--ctcp-lagmon-handler) + (irc-handler-add table "NICK" 'circe-lagmon--nick-handler)) + (circe-set-display-handler "irc.ctcp.LAGMON" 'circe-display-ignore) + (dolist (buffer (circe-server-buffers)) + (with-current-buffer buffer + (setq circe-lagmon-server-lag nil) + (when (and circe-server-process + (eq (irc-connection-state circe-server-process) + 'registered)) + (circe-lagmon-init))))))) + +(provide 'circe-lagmon) +;;; circe-lagmon.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-lagmon.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-lagmon.elc new file mode 100644 index 000000000000..39353b9814f9 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-lagmon.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-new-day-notifier.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-new-day-notifier.el new file mode 100644 index 000000000000..88d9a4b350eb --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-new-day-notifier.el @@ -0,0 +1,86 @@ +;;; circe-new-day-notifier.el --- Send a message every midnight to all +;;; channels + +;; Copyright (C) 2015 Pásztor János + +;; Author: Pásztor János <model87@freemail.hu> + +;; This file is part of Circe. + +;; 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 2 +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This Circe module adds the ability to send a notification to all +;; channels every midnight + +;; Some ideas/code copied from circe-lagmon.el and +;; circe-color-nicks.el + +;; To use it, put the following into your .emacs: + +;; (require 'circe-new-day-notifier) +;; (enable-circe-new-day-notifier) + +;;; Code: + +(require 'circe) + +(defgroup circe-new-day-notifier nil + "Midnight notification to Circe" + :prefix "circe-new-day-notifier-" + :group 'circe) + +(defcustom circe-new-day-notifier-format-message "*** Day changed to {day}" + "The format string which will be printed to the channels. It +should contain {day} to print the date. See `circe-display' for +further documentation" + :type 'string + :group 'circe-new-day-notifier) + +(defcustom circe-new-day-notifier-date-format "%Y-%m-%d, %A" + "The date format, which will be used at +circe-new-day-notifier-format-message. See `format-time-string' for +documentation" + :type 'string + :group 'circe-new-day-notifier) + +(defvar circe-new-day-notifier-timer nil) + +;;;###autoload +(defun enable-circe-new-day-notifier () + (interactive) + (unless circe-new-day-notifier-timer + (setq circe-new-day-notifier-timer + (run-at-time "24:00:00" (* 24 60 60) 'circe-new-day-notification)))) + +;;;###autoload +(defun disable-circe-new-day-notifier () + (interactive) + (when circe-new-day-notifier-timer + (cancel-timer circe-new-day-notifier-timer) + (setq circe-new-day-notifier-timer nil))) + +(defun circe-new-day-notification () + "This function prints the new day notification to each query and chat buffer" + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (derived-mode-p 'circe-chat-mode) + (circe-display 'circe-new-day-notifier-format-message + :day (format-time-string circe-new-day-notifier-date-format)))))) + +(provide 'circe-new-day-notifier) +;;; circe-new-day-notifier.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-new-day-notifier.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-new-day-notifier.elc new file mode 100644 index 000000000000..070093319b4a --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-new-day-notifier.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-pkg.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-pkg.el new file mode 100644 index 000000000000..cf27de48b8b3 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe-pkg.el @@ -0,0 +1,6 @@ +(define-package "circe" "20180525.531" "Client for IRC in Emacs" + '((cl-lib "0.5")) + :url "https://github.com/jorgenschaefer/circe") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe.el new file mode 100644 index 000000000000..721044dd2aff --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe.el @@ -0,0 +1,3602 @@ +;;; circe.el --- Client for IRC in Emacs -*- lexical-binding: t -*- + +;; Copyright (C) 2005 - 2015 Jorgen Schaefer + +;; Version: 2.10 +;; Keywords: IRC, chat +;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; URL: https://github.com/jorgenschaefer/circe + +;; This file is part of Circe. + +;; 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: + +;; Circe is a Client for IRC in Emacs. It integrates well with the rest +;; of the editor, using standard Emacs key bindings and indicating +;; activity in channels in the status bar so it stays out of your way +;; unless you want to use it. + +;;; Code: + +(defvar circe-version "2.10" + "Circe version string.") + +(require 'circe-compat) + +(require 'ring) +(require 'timer) +(require 'lui) +(require 'lui-format) +(require 'lcs) +(require 'irc) + +;; Used to be optional. But sorry, we're in the 21st century already. +(require 'lui-irc-colors) + +;; necessary for inheriting from diff-added and diff-removed faces +(require 'diff-mode) + +(defgroup circe nil + "Yet Another Emacs IRC Client." + :prefix "circe-" + :group 'applications) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Customization Options ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;;;;;;;;;;;;;; +;;;; Faces ;;;; +;;;;;;;;;;;;;;; + +(defface circe-prompt-face + '((t (:weight bold :foreground "Black" :background "LightSeaGreen"))) + "The face for the Circe prompt." + :group 'circe) + +(defface circe-server-face + '((((type tty)) (:foreground "blue" :weight bold)) + (((background dark)) (:foreground "#5095cf")) + (((background light)) (:foreground "#3840b0")) + (t (:foreground "SteelBlue"))) + "The face used to highlight server messages." + :group 'circe) + +(defface circe-highlight-nick-face + '((default (:weight bold)) + (((type tty)) (:foreground "cyan")) + (((background dark)) (:foreground "#82e2ed")) + (((background light)) (:foreground "#0445b7")) + (t (:foreground "CadetBlue3"))) + "The face used to highlight messages directed to us." + :group 'circe) + +(defface circe-my-message-face '((t)) + "The face used to highlight our own messages." + :group 'circe) + +(defface circe-originator-face '((t)) + "The face used to highlight the originator of a message." + :group 'circe) + +(defface circe-topic-diff-new-face '((t (:inherit diff-added))) + "The face used for text added to a topic. +See the {topic-diff} parameter to `circe-format-server-topic'." + :group 'circe) + +(defface circe-topic-diff-removed-face '((t (:inherit diff-removed))) + "The face used for text removed from a topic. +See the {topic-diff} parameter to `circe-format-server-topic'." + :group 'circe) + +(defface circe-fool-face + '((((type tty)) (:foreground "grey40" :bold t)) + (t (:foreground "grey40"))) + "The face used for fools. +See `circe-fool-list'." + :group 'circe) + +;;;;;;;;;;;;;;;;;;; +;;;; Variables ;;;; +;;;;;;;;;;;;;;;;;;; + +(defcustom circe-default-nick (user-login-name) + "The default nick for circe." + :type 'string + :group 'circe) + +(defcustom circe-default-user circe-default-nick + "The default user name for circe." + :type 'string + :group 'circe) + +(defcustom circe-default-realname (if (string= (user-full-name) "") + circe-default-nick + (user-full-name)) + "The default real name for circe." + :type 'string + :group 'circe) + +(defcustom circe-default-ip-family nil + "Default IP family to use. + + 'nil - Use either IPv4 or IPv6. + + 'ipv4 - Use IPv4 + + 'ipv6 - Use IPv6" + :type '(choice (const :tag "Both" nil) + (const :tag "IPv4" ipv4) + (const :tag "IPv6" ipv6)) + :group 'circe) + +(defcustom circe-default-directory "~/" + "The value of `default-directory' for Circe buffers." + :type 'string + :group 'circe) + +(defcustom circe-network-options nil + "Network options. + +This alist maps network names to respective options. + +Common options: + + :pass - The IRC server password to use for this network, or a + function to fetch it. + :nick - The nick name to use (defaults to `circe-default-nick') + :user - The user name to use (defaults to `circe-default-user') + :realname - The real name to use (defaults to `circe-default-realname') + + :channels - A plist of channels to join (see `circe-channels'). + :server-buffer-name - Format to be used for the server buffer name + (see `circe-server-buffer-name') + + :host - The host name of the server to connect to. + :port - The port or service name for the server. + :use-tls - A boolean indicating as to whether to use TLS or + not (defaults to nil). If you set this, you'll likely + have to set :port as well. + :ip-family - Option to enforce a specific IP version + (defaults to `circe-default-ip-family') + + :nickserv-nick - The nick to authenticate with to nickserv, if configured. + (defaults to the value of :nick) + :nickserv-password - The password to use for nickserv + authentication or a function to fetch it. + + :sasl-username - The username for SASL authentication. + :sasl-password - The password for SASL authentication." + :type '(alist :key-type string :value-type plist) + :group 'circe) + +(defvar circe-network-defaults + '(("Freenode" :host "irc.freenode.net" :port (6667 . 6697) + :tls t + :nickserv-mask "^NickServ!NickServ@services\\.$" + :nickserv-identify-challenge "\C-b/msg\\s-NickServ\\s-identify\\s-<password>\C-b" + :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {nick} {password}" + :nickserv-identify-confirmation "^You are now identified for .*\\.$" + :nickserv-ghost-command "PRIVMSG NickServ :GHOST {nick} {password}" + :nickserv-ghost-confirmation "has been ghosted\\.$\\|is not online\\.$" + ) + ("Coldfront" :host "irc.coldfront.net" :port 6667 + :nickserv-mask "^NickServ!services@coldfront\\.net$" + :nickserv-identify-challenge "/msg\\s-NickServ\\s-IDENTIFY\\s-\C-_password\C-_" + :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {password}" + ) + ("Bitlbee" :host "localhost" :port 6667 + :nickserv-mask "\\(bitlbee\\|root\\)!\\(bitlbee\\|root\\)@" + :nickserv-identify-challenge "use the \x02identify\x02 command to identify yourself" + :nickserv-identify-command "PRIVMSG &bitlbee :identify {password}" + :nickserv-identify-confirmation "Password accepted, settings and accounts loaded" + :lagmon-disabled t + ) + ("OFTC" :host "irc.oftc.net" :port (6667 . 6697) + :nickserv-mask "^NickServ!services@services\\.oftc\\.net$" + :nickserv-identify-challenge "This nickname is registered and protected." + :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {password} {nick}" + :nickserv-identify-confirmation "^You are successfully identified as .*\\.$" + ) + ) + "Alist of networks and connection settings. + +See the `circe' command for details of this variable.") + +(defcustom circe-default-quit-message "Using Circe, the loveliest of all IRC clients" + "The default quit message when no other is given. + +This is sent when the server buffer is killed or when /QUIT is +given with no argument." + :type 'string + :group 'circe) + +(defcustom circe-default-part-message "Using Circe, the loveliest of all IRC clients" + "How to part when a channel buffer is killed, or when no +argument is given to /PART." + :type 'string + :group 'circe) + +(defcustom circe-auto-query-max 23 + "The maximum number of queries which are opened automatically. +If more messages arrive - typically in a flood situation - they +are displayed in the server buffer." + :type 'integer + :group 'circe) + +(defcustom circe-use-cycle-completion nil + "Whether Circe should use cycle completion. + +If this is not nil, Circe will set `completion-cycle-threshold' +to t locally in Circe buffers, enabling cycle completion for +nicks no matter what completion style you use in the rest of +Emacs. If you set this to nil, Circe will not touch your default +completion style." + :type 'boolean + :group 'circe) + +(defcustom circe-reduce-lurker-spam nil + "If enabled, Circe will stop showing some messages. + +This means that JOIN, PART, QUIT and NICK messages are not shown +for users on channels that have not spoken yet (\"lurker\"), or +haven't spoken in `circe-active-users-timeout' seconds. When they +speak for the first time, Circe displays their join time." + :type 'boolean + :group 'circe) + +(defcustom circe-active-users-timeout nil + "When non-nil, should be the number of seconds after which +active users are regarded as inactive again after speaking." + :type 'integer + :group 'circe) + +(defcustom circe-prompt-string (concat (propertize ">" + 'face 'circe-prompt-face) + " ") + "The string to initialize the prompt with. +To change the prompt dynamically or just in specific buffers, use +`lui-set-prompt' in the appropriate hooks." + :type 'string + :group 'circe) + +(defcustom circe-extra-nicks nil + "List of other nicks than your current one to highlight." + :type '(repeat string) + :group 'circe) + +(defcustom circe-highlight-nick-type 'sender + "How to highlight occurrences of our own nick. + + 'sender - Highlight the nick of the sender + (messages without a sender and your + own are highlighted with the occurrence + type instead) + 'occurrence - Highlight the occurrences of the nick + 'message - Highlight the message without the sender + 'all - Highlight the whole line" + :type '(choice (const :tag "Sender" sender) + (const :tag "Occurrences" occurrence) + (const :tag "Message" message) + (const :tag "Whole line" all)) + :group 'circe) + +(defcustom circe-inhibit-nick-highlight-function nil + "Function for inhibiting nick highlighting. +If non-nil, its value is called with the respective buffer +selected and point in the line that's about to get highlighted. +A non-nil return value inhibits any highlighting." + :type '(choice (const :tag "None" nil) + function) + :group 'circe) + +(defcustom circe-completion-suffix ": " + "A suffix for completed nicks at the beginning of a line." + :type '(choice (const :tag "The standard suffix" ": ")) + :group 'circe) + +(defcustom circe-ignore-list nil + "List of regular expressions to ignore. + +Each regular expression is matched against nick!user@host." + :type '(repeat regexp) + :group 'circe) + +(defcustom circe-fool-list nil + "List of regular expressions for fools. + +Each regular expression is matched against nick!user@host. + +Messages from such people are still inserted, but not shown. They +can be displayed using \\[lui-fool-toggle-display]." + :type '(repeat regexp) + :group 'circe) + +(defcustom circe-ignore-functions nil + "A list of functions to check whether we should ignore a message. + +These functions get three arguments: NICK, USERHOST, and BODY. If +one of them returns a non-nil value, the message is ignored." + :type 'hook + :group 'circe) + +(defcustom circe-split-line-length 440 + "The maximum length of a single message. +If a message exceeds this size, it is broken into multiple ones. + +IRC allows for lines up to 512 bytes. Two of them are CR LF. +And a typical message looks like this: + + :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello! + +You can limit here the maximum length of the \"Hello!\" part. +Good luck." + :type 'integer + :group 'circe) + +(defcustom circe-server-max-reconnect-attempts 5 + "How often Circe should attempt to reconnect to the server. +If this is 0, Circe will not reconnect at all. If this is nil, +it will try to reconnect forever (not recommended)." + :type '(choice integer + (const :tag "Forever" nil)) + :group 'circe) + +(defcustom circe-netsplit-delay 60 + "The number of seconds a netsplit may be dormant. +If anything happens with a netsplit after this amount of time, +the user is re-notified." + :type 'number + :group 'circe) + +(defcustom circe-server-killed-confirmation 'ask-and-kill-all + "How to ask for confirmation when a server buffer is killed. +This can be one of the following values: + ask - Ask the user for confirmation + ask-and-kill-all - Ask the user, and kill all associated buffers + kill-all - Don't ask the user, and kill all associated buffers + nil - Kill first, ask never" + :type '(choice (const :tag "Ask before killing" ask) + (const :tag "Ask, then kill all associated buffers" + ask-and-kill-all) + (const :tag "Don't ask, then kill all associated buffers" + kill-all) + (const :tag "Don't ask" nil)) + :group 'circe) + +(defcustom circe-channel-killed-confirmation 'ask + "How to ask for confirmation when a channel buffer is killed. +This can be one of the following values: + ask - Ask the user for confirmation + nil - Don't ask, just kill" + :type '(choice (const :tag "Ask before killing" ask) + (const :tag "Don't ask" nil)) + :group 'circe) + +(defcustom circe-track-faces-priorities '(circe-highlight-nick-face + lui-highlight-face + circe-my-message-face + circe-server-face) + "A list of faces which should show up in the tracking. +The first face is kept if the new message has only lower faces, +or faces that don't show up at all." + :type '(repeat face) + :group 'circe) + +(defcustom circe-server-send-unknown-command-p nil + "Non-nil when Circe should just pass on commands it doesn't know. +E.g. /fnord foo bar would then just send \"fnord foo bar\" to the +server." + :type 'boolean + :group 'circe) + +(defcustom circe-server-connected-hook nil + "Hook run when we successfully connected to a server. +This is run from a 001 (RPL_WELCOME) message handler." + :type 'hook + :group 'circe) + +(defcustom circe-server-auto-join-default-type :immediate + "The default auto-join type to use. + +Possible options: + +:immediate - Immediately after registering on the server +:after-auth - After nickserv authentication succeeded +:after-cloak - After we have acquired a cloaked host name +:after-nick - After we regained our preferred nick, or after + nickserv authentication if we don't need to regain + it. See `circe-nickserv-ghost-style'. + +See `circe-channels' for more details." + :type '(choice (const :tag "Immediately" :immediate) + (const :tag "After Authentication" :after-auth) + (const :tag "After Cloaking" :after-cloak) + (const :tag "After Nick Regain" :after-nick)) + :group 'circe) + +;;;;;;;;;;;;;;;;; +;;;; Formats ;;;; +;;;;;;;;;;;;;;;;; + +(defgroup circe-format nil + "Format strings for Circe. +All these formats always allow the {mynick} and {chattarget} format +strings." + :prefix "circe-format-" + :group 'circe) + +(defcustom circe-format-not-tracked + '(circe-format-server-message + circe-format-server-notice + circe--irc-format-server-numeric + circe-format-server-topic + circe-format-server-rejoin + circe-format-server-lurker-activity + circe-format-server-topic-time + circe-format-server-topic-time-for-channel + circe-format-server-netmerge + circe-format-server-join + circe-format-server-join-in-channel + circe-format-server-mode-change + circe-format-server-nick-change-self + circe-format-server-nick-change + circe-format-server-nick-regain + circe-format-server-part + circe-format-server-netsplit + circe-format-server-quit-channel + circe-format-server-quit) + "A list of formats that should not trigger tracking." + :type '(repeat symbol) + :group 'circe-format) + +(defcustom circe-format-server-message "*** {body}" + "The format for generic server messages. +{body} - The body of the message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-self-say "> {body}" + "The format for messages to queries or channels. +{nick} - Your nick. +{body} - The body of the message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-self-action "* {nick} {body}" + "The format for actions to queries or channels. +{nick} - Your nick. +{body} - The body of the action." + :type 'string + :group 'circe-format) + +(defcustom circe-format-self-message "-> *{chattarget}* {body}" + "The format for messages sent to other people outside of queries. +{chattarget} - The target nick. +{body} - The body of the message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-action "* {nick} {body}" + "The format for actions in queries or channels. +{nick} - The nick doing the action. +{body} - The body of the action." + :type 'string + :group 'circe-format) + +(defcustom circe-format-message-action "* *{nick}* {body}" + "The format for actions in messages outside of queries. +{nick} - The nick doing the action. +{body} - The body of the action." + :type 'string + :group 'circe-format) + +(defcustom circe-format-say "<{nick}> {body}" + "The format for normal channel or query talk. +{nick} - The nick talking. +{body} - The message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-message "*{nick}* {body}" + "The format for a message outside of a query. +{nick} - The originator. +{body} - The message." + :type 'string + :group 'circe-format) + +(defcustom circe-format-notice "-{nick}- {body}" + "The format for a notice. +{nick} - The originator. +{body} - The notice." + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-notice "-Server Notice- {body}" + "The format for a server notice. +{body} - The notice." + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-topic "*** Topic change by {nick} ({userhost}): {new-topic}" + "The format for topic changes. + +The following format arguments are available: + + nick - The nick of the user who changed the topic + userhost - The user@host string of that user + channel - Where the topic change happened + new-topic - The new topic + old-topic - The previous topic + topic-diff - A colorized diff of the topics" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-lurker-activity + "*** First activity: {nick} joined {joindelta} ago." + "The format for the first-activity notice of a user. +{nick} - The originator. +{jointime} - The join time of the user (in seconds). +{joindelta} - The duration from joining until now." + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-rejoin + "*** Re-join: {nick} ({userinfo}), left {departuredelta} ago" + "The format for the re-join notice of a user. + +The following format arguments are available: + + nick - The nick of the user who joined + userhost - The user@host string of the user who joined + accountname - The account name, if the server supports this + realname - The real name, if the server supports this + userinfo - A combination of userhost, accountname, and realname + channel - A date string describing this time + departuretime - Time in seconds when the originator had left. + departuredelta - Description of the time delta since the originator left." + :type 'string + :group 'circe-format) + +(defcustom circe-server-buffer-name "{host}:{port}" + "The format for the server buffer name. + +The following format arguments are available: + + network - The name of the network + host - The host name of the server + port - The port number or service name + service - Alias for port" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-whois-idle-with-signon "*** {whois-nick} is {idle-duration} idle (signon on {signon-date}, {signon-ago} ago)" + "Format for RPL_WHOISIDLE messages. + +The following format arguments are available: + + whois-nick - The nick this is about + idle-seconds - The number of seconds this nick has been idle + idle-duration - A textual description of the duration of the idle time + signon-time - The time (in seconds since the epoch) when this user + signed on + signon-date - A date string describing this time + signon-ago - A textual description of the duraction since signon" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-whois-idle "*** {whois-nick} is {idle-duration} idle" + "Format for RPL_WHOISIDLE messages. + +The following format arguments are available: + + whois-nick - The nick this is about + idle-seconds - The number of seconds this nick has been idle + idle-duration - A textual description of the duration of the idle time" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-topic-time "*** Topic set by {setter} on {topic-date}, {topic-ago} ago" + "Format for RPL_TOPICWHOTIME messages for the current channel. + +The following format arguments are available: + + channel - The channel the topic is for + setter - The nick of the person who set the topic + setter-userhost - The user@host string of the person who set the topic + topic-time - The time the topic was set, in seconds since the epoch + topic-date - A date string describing this time + topic-ago - A textual description of the duration since the topic + was set" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-topic-time-for-channel "*** Topic for {channel} set by {setter} on {topic-date}, {topic-ago} ago" + "Format for RPL_TOPICWHOTIME messages for a channel we are not on. + +The following format arguments are available: + + channel - The channel the topic is for + setter - The nick of the person who set the topic + setter-userhost - The user@host string of the person who set the topic + topic-time - The time the topic was set, in seconds since the epoch + topic-date - A date string describing this time + topic-ago - A textual description of the duration since the topic + was set" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-channel-creation-time "*** Channel {channel} created on {date}, {ago} ago" + "Format for RPL_CREATIONTIME messages for the current channel. + +The following format arguments are available: + + channel - The channel the topic is for + date - A date string describing this time + ago - A textual description of the duration since the channel + was created" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-ctcp-ping "*** CTCP PING request from {nick} ({userhost}) to {target}: {body} ({ago} ago)" + "Format for CTCP PING requests. + +The following format arguments are available: + + nick - The nick of the user who sent this PING request + userhost - The user@host string of the user who sent this request + target - The target of the message, usually us, but can be a channel + body - The argument of the PING request, usually a number + ago - A textual description of the duration since the request + was sent, if parseable" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-ctcp-ping-reply "*** CTCP PING reply from {nick} ({userhost}) to {target}: {ago} ago ({body})" + "Format for CTCP PING replies. + +The following format arguments are available: + + nick - The nick of the user who sent this PING request + userhost - The user@host string of the user who sent this request + target - The target of the message, usually us, but can be a channel + body - The argument of the PING request, usually a number + ago - A textual description of the duration since the request + was sent, if parseable" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-ctcp "*** CTCP {command} request from {nick} ({userhost}) to {target}: {body}" + "Format for CTCP requests. + +The following format arguments are available: + + nick - The nick of the user who sent this PING request + userhost - The user@host string of the user who sent this request + target - The target of the message, usually us, but can be a channel + command - The CTCP command used + body - The argument of the PING request, usually a number" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-netsplit "*** Netsplit: {split} (Use /WL to see who left)" + "Format for netsplit notifications. + +The following format arguments are available: + + split - The name of the split, usually describing the servers involved" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-netmerge "*** Netmerge: {split}, split {ago} ago (Use /WL to see who's still missing)" + "Format for netmerge notifications. + +The following format arguments are available: + + split - The name of the split, usually describing the servers involved + time - The time when this split happened, in seconds + date - A date string describing this time + ago - A textual description of the duration since the split happened" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-join "*** Join: {nick} ({userinfo})" + "Format for join messages in a channel buffer. + +The following format arguments are available: + + nick - The nick of the user joining + userhost - The user@host string for the user + accountname - The account name, if the server supports this + realname - The real name, if the server supports this + userinfo - A combination of userhost, accountname, and realname + channel - The channel this user is joining" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-join-in-channel "*** Join: {nick} ({userinfo}) joined {channel}" + "Format for join messages in query buffers of the joining user. + +The following format arguments are available: + + nick - The nick of the user joining + userhost - The user@host string for the user + accountname - The account name, if the server supports this + realname - The real name, if the server supports this + userinfo - A combination of userhost, accountname, and realname + channel - The channel this user is joining" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-mode-change "*** Mode change: {change} on {target} by {setter} ({userhost})" + "Format for mode changes. + +The following format arguments are available: + + setter - The name of the split, usually describing the servers involved + userhost - The user@host string for the user + target - The target of this mode change + change - The actual changed modes" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-nick-change-self "*** Nick change: You are now known as {new-nick}" + "Format for nick changes of the current user. + +The following format arguments are available: + + old-nick - The old nick this change was from + new-nick - The new nick this change was to + userhost - The user@host string for the user" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-nick-change "*** Nick change: {old-nick} ({userhost}) is now known as {new-nick}" + "Format for nick changes of the current user. + +The following format arguments are available: + + old-nick - The old nick this change was from + new-nick - The new nick this change was to + userhost - The user@host string for the user" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-nick-regain "*** Nick regain: {old-nick} ({userhost}) is now known as {new-nick}" + "Format for nick changes of the current user. + +The following format arguments are available: + + old-nick - The old nick this change was from + new-nick - The new nick this change was to + userhost - The user@host string for the user" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-part "*** Part: {nick} ({userhost}) left {channel}: {reason}" + "Format for users parting a channel. + +The following format arguments are available: + + nick - The nick of the user who left + userhost - The user@host string for this user + channel - The channel they left + reason - The reason they gave for leaving" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-quit-channel "*** Quit: {nick} ({userhost}) left {channel}: {reason}" + "Format for users quitting from a channel. + +The following format arguments are available: + + nick - The nick of the user who left + userhost - The user@host string for this user + channel - The channel they left + reason - The reason they gave for leaving" + :type 'string + :group 'circe-format) + +(defcustom circe-format-server-quit "*** Quit: {nick} ({userhost}) left IRC: {reason}" + "Format for users quitting. + +The following format arguments are available: + + nick - The nick of the user who left + userhost - The user@host string for this user + reason - The reason they gave for leaving" + :type 'string + :group 'circe-format) + +;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Private variables ;;; +;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar circe-source-url "https://github.com/jorgenschaefer/circe" + "URL to Circe's source repository") + +(defvar circe-host nil + "The name of the server we're currently connected to.") +(make-variable-buffer-local 'circe-host) + +(defvar circe-port nil + "The port number or service name of the server.") +(make-variable-buffer-local 'circe-host) + +(defvar circe-network nil + "The network name of the server we're currently connected to.") +(make-variable-buffer-local 'circe-network) + +(defvar circe-ip-family nil + "The IP family in use. +See `make-network-process' and :family for valid values.") +(make-variable-buffer-local 'circe-ip-family) + +(defvar circe-nick nil + "Our current nick.") +(make-variable-buffer-local 'circe-nick) + +(defvar circe-user nil + "The current user name.") +(make-variable-buffer-local 'circe-user) + +(defvar circe-realname nil + "The current real name.") +(make-variable-buffer-local 'circe-realname) + +(defvar circe-pass nil + "The password for the current server or a function to recall it. + +If a function is set it will be called with the value of `circe-host'.") +(make-variable-buffer-local 'circe-pass) + +(defvar circe-sasl-username nil + "The username for SASL authentication.") +(make-variable-buffer-local 'circe-sasl-username) + +(defvar circe-sasl-password nil + "The password for SASL authentication. + +If a function is set it will be called with the value of +`circe-host'.") +(make-variable-buffer-local 'circe-sasl-password) + +(defvar circe-use-tls nil + "If non-nil, use `open-tls-stream' to connect to the server.") +(make-variable-buffer-local 'circe-use-tls) + +(defvar circe-server-process nil + "The process of the server connection.") +(make-variable-buffer-local 'circe-server-process) + +(defvar circe-server-last-active-buffer nil + "The last active circe buffer.") +(make-variable-buffer-local 'circe-server-last-active-buffer) + +(defvar circe-display-table nil + "A hash table mapping commands to their display functions.") + +(defvar circe-server-inhibit-auto-reconnect-p nil + "Non-nil when Circe should not reconnect. + +This can be set from commands to avoid reconnecting when the +server disconnects.") +(make-variable-buffer-local 'circe-server-inhibit-auto-reconnect-p) + +(defvar circe-chat-calling-server-buffer-and-target nil + "Internal variable to pass the server buffer and target to chat modes.") + +(defvar circe-chat-target nil + "The current target for the buffer. +This is either a channel or a nick name.") +(make-variable-buffer-local 'circe-chat-target) + +(defvar circe-nick-syntax-table + (let ((table (make-syntax-table text-mode-syntax-table)) + (special (string-to-list "[]\`_^{}|-"))) + (dolist (char special) + (modify-syntax-entry char "w" table)) + table) + "Syntax table to treat nicks as words. +This is not entirely accurate, as exact chars constituting a nick +can vary between networks.") + +(defvar circe-nickserv-mask nil + "The regular expression to identify the nickserv on this network. + +Matched against nick!user@host.") +(make-variable-buffer-local 'circe-nickserv-mask) + +(defvar circe-nickserv-identify-challenge nil + "A regular expression matching the nickserv challenge to identify.") +(make-variable-buffer-local 'circe-nickserv-identify-challenge) + +(defvar circe-nickserv-identify-command nil + "The IRC command to send to identify with nickserv. + +This must be a full IRC command. It accepts the following +formatting options: + + {nick} - The nick to identify as + {password} - The configured nickserv password") +(make-variable-buffer-local 'circe-nickserv-identify-command) + +(defvar circe-nickserv-identify-confirmation nil + "A regular expression matching a confirmation of authentication.") +(make-variable-buffer-local 'circe-nickserv-identify-confirmation) + +(defvar circe-nickserv-ghost-command nil + "The IRC command to send to regain/ghost your nick. + +This must be a full IRC command. It accepts the following +formatting options: + + {nick} - The nick to ghost + {password} - The configured nickserv password") +(make-variable-buffer-local 'circe-nickserv-ghost-command) + +(defvar circe-nickserv-ghost-confirmation nil + "A regular expression matching a confirmation for the GHOST command. + +This is used to know when we can set our nick to the regained one +Leave nil if regaining automatically sets your nick") +(make-variable-buffer-local 'circe-nickserv-ghost-confirmation) + +(defvar circe-nickserv-nick nil + "The nick we are registered with for nickserv. + +Do not set this variable directly. Use `circe-network-options' or +pass an argument to the `circe' function for this.") +(make-variable-buffer-local 'circe-nickserv-nick) + +(defvar circe-nickserv-password nil + "The password we use for nickserv on this network. + +Can be either a string or a unary function of the nick returning +a string. + +Do not set this variable directly. Use `circe-network-options' or +pass an argument to the `circe' function for this.") +(make-variable-buffer-local 'circe-nickserv-password) + +(defvar circe-channels nil + "The default channels to join on this server. + +Don't set this variable by hand, use `circe-network-options'. + +The value should be a list of channels to join, with optional +keywords to configure the behavior of the following channels. + +Best explained in an example: + +\(\"#emacs\" :after-auth \"#channel\" \"#channel2\") + +Possible keyword options are: + +:immediate - Immediately after registering on the server +:after-auth - After nickserv authentication succeeded +:after-cloak - After we have acquired a cloaked host name +:after-nick - After we regained our preferred nick, or after + nickserv authentication if we don't need to regain + it. See `circe-nickserv-ghost-style'. + +The default is set in `circe-server-auto-join-default-type'. + +A keyword in the first position of the channels list overrides +`circe-server-auto-join-default-type' for re-joining manually +joined channels.") +(make-variable-buffer-local 'circe-channels) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Server Buffer Management ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Every Circe buffer has an associated server buffer (which might be +;; the buffer itself). Circe buffers should set the +;; `circe-server-buffer' variable to the associated server buffer. + +(defun circe-server-buffer () + "Return the server buffer for the current buffer." + (let ((buf (if (eq major-mode 'circe-server-mode) + (current-buffer) + circe-server-buffer))) + (cond + ((not buf) + (error "Not in a Circe buffer")) + ((not (buffer-live-p buf)) + (error "The server buffer died, functionality is limited")) + (t + buf)))) + +(defmacro with-circe-server-buffer (&rest body) + "Run BODY with the current buffer being the current server buffer." + (declare (indent 0)) + `(with-current-buffer (circe-server-buffer) + ,@body)) + +;;;;;;;;;;;;;;;;;;;;;;; +;;; Editor Commands ;;; +;;;;;;;;;;;;;;;;;;;;;;; + +;;;###autoload +(defun circe-version () + "Display Circe's version." + (interactive) + (message "Circe %s" (circe--version))) + +(defun circe--version () + "Return Circe's version" + (let ((circe-git-version (circe--git-version))) + (if circe-git-version + (format "%s-%s" circe-version circe-git-version) + (format "%s" circe-version)))) + +(defun circe--git-version () + (let ((current-file-path (or load-file-name buffer-file-name))) + (when (or (not current-file-path) + (not (equal (file-name-nondirectory current-file-path) + "circe.el"))) + (setq current-file-path (locate-library "circe.el"))) + (let ((vcs-path (locate-dominating-file current-file-path ".git"))) + (when vcs-path + (let ((default-directory vcs-path)) + ;; chop off the trailing newline + (substring (shell-command-to-string "git rev-parse --short HEAD") + 0 -1)))))) + +;;;###autoload +(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)) + (pop-to-buffer-same-window buffer))) + +(defun circe--read-network-and-options () + "Read a host or network name with completion. + +If it's not a network, also read some extra options. + +This uses `circe-network-defaults' and `circe-network-options' for +network names." + (let ((default-network (if (null circe-network-options) + (caar circe-network-defaults) + (caar circe-network-options))) + (networks nil) + (completion-ignore-case t) + network-or-host) + (dolist (network-spec (append circe-network-options + circe-network-defaults)) + (when (not (member (car network-spec) networks)) + (push (car network-spec) networks))) + (setq networks (sort networks 'string-lessp)) + (setq network-or-host (completing-read "Network or host: " + networks + nil nil nil nil + default-network)) + (dolist (network-name networks) + (when (equal (downcase network-or-host) + (downcase network-name)) + (setq network-or-host network-name))) + (if (member network-or-host networks) + (list network-or-host) + (list network-or-host + :host network-or-host + :port (read-number "Port: " 6667))))) + +(defun circe--server-get-network-options (network server-options) + "Combine server and network options with network defaults. + +See `circe-network-options' and `circe-network-defaults'." + (let ((options (mapcar 'circe--translate-option-names + (append server-options + (cdr (assoc network circe-network-options)) + (cdr (assoc network circe-network-defaults)) + (list :network network))))) + (when (not (plist-get options :host)) + (plist-put options :host network)) + (let ((port (plist-get options :port)) + (use-tls (plist-get options :use-tls))) + (when (consp port) + (if use-tls + (plist-put options :port (cdr port)) + (plist-put options :port (car port))))) + (dolist (required-option '(:host :port)) + (when (not (plist-get options required-option)) + (error (format "Network option %s not specified" required-option)))) + options)) + +(defun circe--translate-option-names (option) + "Translate option names to make them unique. + +Some options have multiple names, mainly for historical reasons. +Unify them here." + (cond + ((eq option :service) :port) + ((eq option :tls) :use-tls) + ((eq option :family) :ip-family) + (t option))) + +(defun circe--server-generate-buffer (options) + "Return the server buffer for the connection described in OPTIONS." + (let* ((network (plist-get options :network)) + (host (plist-get options :host)) + (port (plist-get options :port)) + (buffer-name (lui-format (or (plist-get options :server-buffer-name) + circe-server-buffer-name) + :network network + :host host + :port port + :service port))) + (generate-new-buffer buffer-name))) + +(defun circe--server-set-variables (options) + "Set buffer-local variables described in OPTIONS. + +OPTIONS is a plist as passed to `circe'. All options therein are +set as buffer-local variables. Only the first occurrence of each +variable is set." + (setq circe-nick circe-default-nick + circe-user circe-default-user + circe-realname circe-default-realname + circe-ip-family circe-default-ip-family) + (let ((done nil) + (todo options)) + (while todo + (when (not (memq (car todo) done)) + (push (car todo) done) + (let ((var (intern (format "circe-%s" + (substring (symbol-name (car todo)) 1)))) + (val (cadr todo))) + (if (boundp var) + (set (make-local-variable var) val) + (warn "Unknown option %s, ignored" (car todo))))) + (setq todo (cddr todo))))) + +(defvar circe-server-reconnect-attempts 0 + "The number of reconnect attempts that Circe has done so far. +See `circe-server-max-reconnect-attempts'.") +(make-variable-buffer-local 'circe-server-reconnect-attempts) + +(defun circe-reconnect () + "Reconnect the current server." + (interactive) + (with-circe-server-buffer + (when (or (called-interactively-p 'any) + (circe--reconnect-p)) + (setq circe-server-inhibit-auto-reconnect-p t + circe-server-reconnect-attempts (+ circe-server-reconnect-attempts + 1)) + (unwind-protect + (circe-reconnect--internal) + (setq circe-server-inhibit-auto-reconnect-p nil))))) + +(defun circe--reconnect-p () + (cond + (circe-server-inhibit-auto-reconnect-p + nil) + ((not circe-server-max-reconnect-attempts) + t) + ((<= circe-server-reconnect-attempts + circe-server-max-reconnect-attempts) + t) + (t + nil))) + +(defun circe-reconnect--internal () + "The internal function called for reconnecting unconditionally. + +Do not use this directly, use `circe-reconnect'" + (when (and circe-server-process + (process-live-p circe-server-process)) + (delete-process circe-server-process)) + (circe-display-server-message "Connecting...") + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (circe-display-server-message "Connecting..."))) + (setq circe-server-process + (irc-connect + :host circe-host + :service circe-port + :tls circe-use-tls + :ip-family circe-ip-family + :handler-table (circe-irc-handler-table) + :server-buffer (current-buffer) + :nick circe-nick + :nick-alternatives (list (circe--nick-next circe-nick) + (circe--nick-next + (circe--nick-next circe-nick))) + :user circe-user + :mode 8 + :realname circe-realname + :pass (if (functionp circe-pass) + (funcall circe-pass circe-host) + circe-pass) + :cap-req (append (when (and circe-sasl-username + circe-sasl-password) + '("sasl")) + '("extended-join")) + :nickserv-nick (or circe-nickserv-nick + circe-nick) + :nickserv-password (if (functionp circe-nickserv-password) + (funcall circe-nickserv-password circe-host) + circe-nickserv-password) + :nickserv-mask circe-nickserv-mask + :nickserv-identify-challenge circe-nickserv-identify-challenge + :nickserv-identify-command circe-nickserv-identify-command + :nickserv-identify-confirmation + circe-nickserv-identify-confirmation + :nickserv-ghost-command circe-nickserv-ghost-command + :nickserv-ghost-confirmation circe-nickserv-ghost-confirmation + :sasl-username circe-sasl-username + :sasl-password (if (functionp circe-sasl-password) + (funcall circe-sasl-password + circe-host) + circe-sasl-password) + :ctcp-version (format "Circe: Client for IRC in Emacs, version %s" + circe-version) + :ctcp-source circe-source-url + :ctcp-clientinfo "CLIENTINFO PING SOURCE TIME VERSION" + :auto-join-after-registration + (append (circe--auto-join-channel-buffers) + (circe--auto-join-list :immediate)) + :auto-join-after-host-hiding + (circe--auto-join-list :after-cloak) + :auto-join-after-nick-acquisition + (circe--auto-join-list :after-nick) + :auto-join-after-nickserv-identification + (circe--auto-join-list :after-auth) + :auto-join-after-sasl-login + (circe--auto-join-list :after-auth)))) + +(defun circe-reconnect-all () + "Reconnect all Circe connections." + (interactive) + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (if (called-interactively-p 'any) + (call-interactively 'circe-reconnect) + (circe-reconnect))))) + +(defun circe--auto-join-list (type) + "Return the list of channels to join for type TYPE." + (let ((result nil) + (current-type circe-server-auto-join-default-type)) + (dolist (channel circe-channels) + (cond + ((keywordp channel) + (setq current-type channel)) + ((eq current-type type) + (push channel result)))) + (nreverse result))) + +(defun circe--auto-join-channel-buffers () + "Return a list of channels to join based on channel buffers. + +This includes all channel buffers of the current server, but +excludes and channel that is already listed in +`circe-channels'." + (let ((channels nil)) + (dolist (buf (circe-server-chat-buffers)) + (let ((name (with-current-buffer buf + (when (derived-mode-p 'circe-channel-mode) + circe-chat-target)))) + (when (and name + (not (member name circe-channels))) + (push name channels)))) + channels)) + +;;;;;;;;;;;;;;;;; +;;; Base Mode ;;; +;;;;;;;;;;;;;;;;; + +(defvar circe-mode-hook nil + "Hook run for any Circe mode.") + +(defvar circe-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-j") 'circe-command-JOIN) + (define-key map (kbd "C-c C-r") 'circe-reconnect) + map) + "The base keymap for all Circe modes (server, channel, query)") + +(defvar circe-server-buffer nil + "The buffer of the server associated with the current chat buffer.") +(make-variable-buffer-local 'circe-server-buffer) + +(define-derived-mode circe-mode lui-mode "Circe" + "Base mode for all Circe buffers. + +A buffer should never be in this mode directly, but rather in +modes that derive from this. + +The mode inheritance hierarchy looks like this: + +lui-mode +`-circe-mode + `-circe-server-mode + `-circe-chat-mode + `-circe-channel-mode + `-circe-query-mode" + (add-hook 'lui-pre-output-hook 'lui-irc-colors + t t) + (add-hook 'lui-pre-output-hook 'circe--output-highlight-nick + t t) + (add-hook 'completion-at-point-functions 'circe--completion-at-point + nil t) + (lui-set-prompt circe-prompt-string) + (goto-char (point-max)) + (setq lui-input-function 'circe--input + default-directory (expand-file-name circe-default-directory) + circe-server-last-active-buffer (current-buffer) + flyspell-generic-check-word-p 'circe--flyspell-check-word-p) + (when circe-use-cycle-completion + (set (make-local-variable 'completion-cycle-threshold) + t)) + ;; Tab completion should be case-insensitive + (set (make-local-variable 'completion-ignore-case) + t) + (set (make-local-variable 'tracking-faces-priorities) + circe-track-faces-priorities)) + +;;;;;;;;;;;;;;;;;;;; +;;;; Displaying ;;;; +;;;;;;;;;;;;;;;;;;;; + +(defun circe-display (format &rest keywords) + "Display FORMAT formatted with KEYWORDS in the current Circe buffer. +See `lui-format' for a description of the format. + +If FORMAT contains the word server, the resulting string receives +a `circe-server-face'. If FORMAT contains the word self, the +whole string receives a `circe-my-message-face'. If FORMAT is in +`circe-format-not-tracked', a message of this type is never +tracked by Lui. + +Keywords with the name :nick receive a `circe-originator-face'. + +It is always possible to use the mynick or target formats." + (when (not (circe--display-ignored-p format keywords)) + (let* ((name (symbol-name format)) + (face (cond + ((string-match "\\<server\\>" name) + 'circe-server-face) + ((string-match "\\<self\\>" name) + 'circe-my-message-face))) + (keywords (append `(:mynick ,(circe-nick) + :chattarget ,circe-chat-target) + (circe--display-add-nick-property + (if (and (not (null keywords)) + (null (cdr keywords))) + (car keywords) + keywords)))) + (text (lui-format format keywords))) + (when (circe--display-fool-p format keywords) + (add-face-text-property 0 (length text) + 'circe-fool-face t text) + (put-text-property 0 (length text) + 'lui-fool t + text)) + (when face + (add-face-text-property 0 (length text) + face t text)) + (lui-insert text + (memq format circe-format-not-tracked))))) + +(defun circe-display-server-message (message) + "Display MESSAGE as a server message." + (circe-display 'circe-format-server-message + :body message)) + +(defun circe--display-add-nick-property (keywords) + "Add a face to the value of the :nick property in KEYWORDS." + (let ((keyword nil)) + (mapcar (lambda (entry) + (cond + ((or (eq keyword :nick) + (eq keyword 'nick)) + (setq keyword nil) + (propertize entry 'face 'circe-originator-face)) + (t + (setq keyword entry) + entry))) + keywords))) + +(defun circe--display-ignored-p (_format keywords) + (let ((nick (plist-get keywords :nick)) + (userhost (plist-get keywords :userhost)) + (body (plist-get keywords :body))) + (circe--ignored-p nick userhost body))) + +(defun circe--display-fool-p (_format keywords) + (let ((nick (plist-get keywords :nick)) + (userhost (plist-get keywords :userhost)) + (body (plist-get keywords :body))) + (circe--fool-p nick userhost body))) + +(defun circe--ignored-p (nick userhost body) + "True if this user or message is being ignored. + +See `circe-ignore-functions' and `circe-ignore-list'. + +NICK, USER and HOST should be the sender of a the command +COMMAND, which had the arguments ARGS." + (or (run-hook-with-args-until-success 'circe-ignore-functions + nick userhost body) + (circe--ignore-matches-p nick userhost body circe-ignore-list))) + +(defun circe--fool-p (nick userhost body) + "True if this user or message is a fool. + +See `circe-fool-list'. + +NICK, USER and HOST should be the sender of a the command +COMMAND, which had the arguments ARGS." + (circe--ignore-matches-p nick userhost body circe-fool-list)) + +(defun circe--ignore-matches-p (nick userhost body patterns) + "Check if a given command does match an ignore pattern. + +A pattern matches if it either matches the user NICK!USER@HOST, +or if it matches the first word in BODY. + +PATTERNS should be the list of regular expressions." + (let ((string (format "%s!%s" nick userhost)) + (target (when (and body + (string-match "^\\([^ ]*\\)[:,]" body)) + (match-string 1 body)))) + (catch 'return + (dolist (regex patterns) + (when (string-match regex string) + (throw 'return t)) + (when (and (stringp target) + (string-match regex target)) + (throw 'return t))) + nil))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Nick Highlighting ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun circe--output-highlight-nick () + "Highlight the nick of the user in the buffer. + +This is used in `lui-pre-output-hook'." + (goto-char (or (text-property-any (point-min) (point-max) + 'lui-format-argument 'body) + (point-min))) + (when (or (not circe-inhibit-nick-highlight-function) + (not (funcall circe-inhibit-nick-highlight-function))) + (let* ((nick (circe-nick)) + (nicks (append (and nick (list nick)) + circe-extra-nicks))) + (when nicks + ;; Can't use \<...\> because that won't match for \<forcer-\> We + ;; might eventually use \_< ... \_> if we define symbols to be + ;; nicks \\= is necessary, because it might be found right where we + ;; are, and that might not be the beginning of a line... (We start + ;; searching from the beginning of the body) + (let ((nick-regex (concat "\\(?:^\\|\\W\\|\\=\\)" + "\\(" (regexp-opt nicks) "\\)" + "\\(?:$\\|\\W\\)"))) + (cond + ((eq circe-highlight-nick-type 'sender) + (if (text-property-any (point-min) + (point-max) + 'face 'circe-originator-face) + (when (re-search-forward nick-regex nil t) + (circe--extend-text-having-face + (point-min) (point-max) + 'circe-originator-face + 'circe-highlight-nick-face)) + (let ((circe-highlight-nick-type 'occurrence)) + (circe--output-highlight-nick)))) + ((eq circe-highlight-nick-type 'occurrence) + (while (re-search-forward nick-regex nil t) + (add-face-text-property (match-beginning 1) + (match-end 1) + 'circe-highlight-nick-face))) + ((eq circe-highlight-nick-type 'message) + (when (re-search-forward nick-regex nil t) + (let* ((start (text-property-any (point-min) + (point-max) + 'lui-format-argument 'body)) + (end (when start + (next-single-property-change start + 'lui-format-argument)))) + (when (and start end) + (add-face-text-property start end + 'circe-highlight-nick-face))))) + ((eq circe-highlight-nick-type 'all) + (when (re-search-forward nick-regex nil t) + (add-face-text-property (point-min) (point-max) + 'circe-highlight-nick-face))))))))) + +(defun circe--extend-text-having-face (from to existing new) + "Extend property values. + +In the text between FROM and TO, find any text that has its face +property set to EXISTING, and prepend NEW to the value of its +face property, when necessary by turning it into a list." + (let ((beg (text-property-any from to 'face existing))) + (while beg + (let ((end (next-single-property-change beg 'face))) + (add-face-text-property beg end new) + (setq beg (text-property-any end to 'face existing)))))) + +;;;;;;;;;;;;;;; +;;;; Input ;;;; +;;;;;;;;;;;;;;; + +(defun circe--input (str) + "Process STR as input. + +This detects commands and interprets them, or sends the input +using the /SAY command." + (set-text-properties 0 (length str) nil str) + (cond + ((string= str "") + nil) + ;; Ignore commands in multiline input + ((and (not (string-match "\n" str)) + (string-match "\\`/\\([^/ ][^ ]*\\|[^/ ]*\\) ?\\([^\n]*\\)\\'" str)) + (let* ((command (match-string 1 str)) + (args (match-string 2 str)) + (handler (intern-soft (format "circe-command-%s" + (upcase command))))) + (cond + ((string= command "") + (circe-command-SAY args)) + (handler + (funcall handler args)) + (circe-server-send-unknown-command-p + (irc-send-raw (circe-server-process) + (format "%s %s" + (upcase command) + args))) + (t + (circe-display-server-message (format "Unknown command: %s" + command)))))) + (t + (mapc #'circe-command-SAY + (circe--list-drop-right (split-string str "\n") + "^ *$"))))) + +;;;;;;;;;;;;;;;;;; +;;;; Flyspell ;;;; +;;;;;;;;;;;;;;;;;; + +(defun circe--flyspell-check-word-p () + "Return a true value if flyspell check the word before point. + +This is a suitable value for `flyspell-generic-check-word-p'. It +will also call `lui-flyspell-check-word-p'." + (cond + ((not (lui-flyspell-check-word-p)) + nil) + ((circe-channel-user-p (circe--flyspell-nick-before-point)) + nil) + (t + t))) + +(defun circe--flyspell-nick-before-point () + "Return the IRC nick before point" + (with-syntax-table circe-nick-syntax-table + (let (beg end) + (save-excursion + (forward-word -1) + (setq beg (point)) + (forward-word 1) + (setq end (point))) + (buffer-substring beg end)))) + +;;;;;;;;;;;;;;;;;;;; +;;;; Completion ;;;; +;;;;;;;;;;;;;;;;;;;; + +(defun circe--completion-at-point () + "Return a list of possible completions for the current buffer. + +This is used in `completion-at-point-functions'." + ;; Use markers so they move when input happens + (let ((start (make-marker)) + (end (make-marker))) + (set-marker end (point)) + (set-marker start + (save-excursion + (when (or (looking-back (regexp-quote + circe-completion-suffix) + (length circe-completion-suffix)) + (looking-back " " 1)) + (goto-char (match-beginning 0))) + (cond + ((<= (point) lui-input-marker) + lui-input-marker) + ((re-search-backward "\\s-" lui-input-marker t) + (1+ (point))) + (t + lui-input-marker)))) + (list start end 'circe--completion-table))) + +(defun circe--completion-table (string pred action) + "Completion table to use for Circe buffers. + +See `minibuffer-completion-table' for details." + (cond + ;; Best completion of STRING + ((eq action nil) + (try-completion string + (circe--completion-candidates + (if (= (- (point) (length string)) + lui-input-marker) + circe-completion-suffix + " ")) + pred)) + ;; A list of possible completions of STRING + ((eq action t) + (all-completions string + (circe--completion-candidates + (if (= (- (point) (length string)) + lui-input-marker) + circe-completion-suffix + " ")) + pred)) + ;; t iff STRING is a valid completion as it stands + ((eq action 'lambda) + (test-completion string + (circe--completion-candidates + (if (= (- (point) (length string)) + lui-input-marker) + circe-completion-suffix + " ")) + pred)) + ;; Boundaries + ((eq (car-safe action) 'boundaries) + `(boundaries 0 . ,(length (cdr action)))) + ;; Metadata + ((eq action 'metadata) + '(metadata (cycle-sort-function . circe--completion-sort))))) + +(defun circe--completion-clean-nick (string) + (with-temp-buffer + (insert string) + (goto-char (point-max)) + (when (or (looking-back circe-completion-suffix nil) + (looking-back " " nil)) + (replace-match "")) + (buffer-string))) + +(defun circe--completion-sort (collection) + "Sort the COLLECTION by channel activity for nicks." + (let* ((proc (circe-server-process)) + (channel (when (and circe-chat-target proc) + (irc-connection-channel proc circe-chat-target))) + (decorated (mapcar (lambda (entry) + (let* ((nick (circe--completion-clean-nick + entry)) + (user (when channel + (irc-channel-user channel nick)))) + (list (when user + (irc-user-last-activity-time user)) + (length entry) + entry))) + collection)) + (sorted (sort decorated + (lambda (a b) + (cond + ((and (car a) + (car b)) + (> (car a) + (car b))) + ((and (not (car a)) + (not (car b))) + (< (cadr a) + (cadr b))) + ((car a) + t) + (t + nil)))))) + (mapcar (lambda (entry) + (nth 2 entry)) + sorted))) + +;; FIXME: I do not know why this is here. +(defvar circe--completion-old-completion-all-sorted-completions nil + "Variable to know if we can return a cached result.") +(make-variable-buffer-local + 'circe--completion-old-completion-all-sorted-completions) +(defvar circe--completion-cache nil + "The results we can cache.") +(make-variable-buffer-local 'circe--completion-cache) + +(defun circe--completion-candidates (nick-suffix) + (if (and circe--completion-old-completion-all-sorted-completions + (eq completion-all-sorted-completions + circe--completion-old-completion-all-sorted-completions)) + circe--completion-cache + (let ((completions (append (circe--commands-list) + (mapcar (lambda (buf) + (with-current-buffer buf + circe-chat-target)) + (circe-server-channel-buffers))))) + (cond + ;; In a server buffer, complete all nicks in all channels + ((eq major-mode 'circe-server-mode) + (dolist (buf (circe-server-channel-buffers)) + (with-current-buffer buf + (dolist (nick (circe-channel-nicks)) + (setq completions (cons (concat nick nick-suffix) + completions)))))) + ;; In a channel buffer, only complete nicks in this channel + ((eq major-mode 'circe-channel-mode) + (setq completions (append (delete (concat (circe-nick) + nick-suffix) + (mapcar (lambda (nick) + (concat nick nick-suffix)) + (circe-channel-nicks))) + completions))) + ;; In a query buffer, only complete this query partner + ((eq major-mode 'circe-query-mode) + (setq completions (cons (concat circe-chat-target nick-suffix) + completions))) + ;; Else, we're doing something wrong + (t + (error "`circe-possible-completions' called outside of Circe"))) + (setq circe--completion-old-completion-all-sorted-completions + completion-all-sorted-completions + circe--completion-cache completions) + completions))) + +(defun circe--commands-list () + "Return a list of possible Circe commands." + (mapcar (lambda (symbol) + (let ((str (symbol-name symbol))) + (if (string-match "^circe-command-\\(.*\\)" str) + (concat "/" (match-string 1 str) " ") + str))) + (apropos-internal "^circe-command-"))) + +;;;;;;;;;;;;;;;;;;; +;;; Server Mode ;;; +;;;;;;;;;;;;;;;;;;; + +(defvar circe-server-mode-hook nil + "Hook run when a new Circe server buffer is created.") + +(defvar circe-server-mode-map (make-sparse-keymap) + "The key map for server mode buffers.") + +(define-derived-mode circe-server-mode circe-mode "Circe Server" + "The mode for circe server buffers. + +This buffer represents a server connection. When you kill it, the +server connection is closed. This will make all associated +buffers unusable. Be sure to use \\[circe-reconnect] if you want +to reconnect to the server. + +\\{circe-server-mode-map}" + (add-hook 'kill-buffer-hook 'circe-server-killed nil t)) + +(defun circe-server-killed () + "Run when the server buffer got killed. + +This will IRC, and ask the user whether to kill all of the +server's chat buffers." + (when circe-server-killed-confirmation + (when (not (y-or-n-p + (if (eq circe-server-killed-confirmation 'ask-and-kill-all) + "Really kill all buffers of this server? (if not, try `circe-reconnect') " + "Really kill the IRC connection? (if not, try `circe-reconnect') "))) + (error "Buffer not killed as per user request"))) + (setq circe-server-inhibit-auto-reconnect-p t) + (ignore-errors + (irc-send-QUIT circe-server-process circe-default-quit-message)) + (ignore-errors + (delete-process circe-server-process)) + (when (or (eq circe-server-killed-confirmation 'ask-and-kill-all) + (eq circe-server-killed-confirmation 'kill-all)) + (dolist (buf (circe-server-chat-buffers)) + (let ((circe-channel-killed-confirmation nil)) + (kill-buffer buf))))) + +(defun circe-server-buffers () + "Return a list of all server buffers in this Emacs instance." + (let ((result nil)) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'circe-server-mode) + (setq result (cons buf result))))) + (nreverse result))) + +(defun circe-server-process () + "Return the current server process." + (with-circe-server-buffer + circe-server-process)) + +(defun circe-server-my-nick-p (nick) + "Return non-nil when NICK is our current nick." + (let ((proc (circe-server-process))) + (when proc + (irc-current-nick-p proc nick)))) + +(defun circe-nick () + "Return our current nick." + (let ((proc (circe-server-process))) + (when proc + (irc-current-nick proc)))) + +(defun circe-server-last-active-buffer () + "Return the last active buffer of this server." + (with-circe-server-buffer + (if (and circe-server-last-active-buffer + (bufferp circe-server-last-active-buffer) + (buffer-live-p circe-server-last-active-buffer)) + circe-server-last-active-buffer + (current-buffer)))) + +;; There really ought to be a hook for this +(defadvice select-window (after circe-server-track-select-window + (window &optional norecord)) + "Remember the current buffer as the last active buffer. +This is used by Circe to know where to put spurious messages." + (with-current-buffer (window-buffer window) + (when (derived-mode-p 'circe-mode) + (let ((buf (current-buffer))) + (ignore-errors + (with-circe-server-buffer + (setq circe-server-last-active-buffer buf))))))) +(ad-activate 'select-window) + +(defun circe-reduce-lurker-spam () + "Return the value of `circe-reduce-lurker-spam'. + +This uses a buffer-local value first, then the one in the server +buffer. + +Use this instead of accessing the variable directly to enable +setting the variable through network options." + (if (local-variable-p 'circe-reduce-lurker-spam) + circe-reduce-lurker-spam + (with-circe-server-buffer + circe-reduce-lurker-spam))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Chat Buffer Management ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Server buffers keep track of associated chat buffers. This enables +;; us to not rely on buffer names staying the same, as well as keeping +;; buffers from different servers and even server connections apart +;; cleanly. + +(defvar circe-server-chat-buffer-table nil + "A hash table of chat buffers associated with this server.") +(make-variable-buffer-local 'circe-server-chat-buffer-table) + +(defun circe-server-get-chat-buffer (target) + "Return the chat buffer addressing TARGET, or nil if none." + (with-circe-server-buffer + (when circe-server-chat-buffer-table + (let* ((target-name (irc-isupport--case-fold (circe-server-process) + target)) + (buf (gethash target-name circe-server-chat-buffer-table))) + (if (buffer-live-p buf) + buf + (remhash target-name circe-server-chat-buffer-table) + nil))))) + +(defun circe-server-create-chat-buffer (target chat-mode) + "Return a new buffer addressing TARGET in CHAT-MODE." + (with-circe-server-buffer + (let* ((target-name (irc-isupport--case-fold (circe-server-process) + target)) + (chat-buffer (generate-new-buffer target)) + (server-buffer (current-buffer)) + (circe-chat-calling-server-buffer-and-target (cons server-buffer + target-name))) + (when (not circe-server-chat-buffer-table) + (setq circe-server-chat-buffer-table (make-hash-table :test 'equal))) + (puthash target-name chat-buffer circe-server-chat-buffer-table) + (with-current-buffer chat-buffer + (funcall chat-mode)) + chat-buffer))) + +(defun circe-server-get-or-create-chat-buffer (target chat-mode) + "Return a buffer addressing TARGET; create one in CHAT-MODE if none exists." + (let ((buf (circe-server-get-chat-buffer target))) + (if buf + buf + (circe-server-create-chat-buffer target chat-mode)))) + +(defun circe-server-remove-chat-buffer (target-or-buffer) + "Remove the buffer addressing TARGET-OR-BUFFER." + (with-circe-server-buffer + (let* ((target (if (bufferp target-or-buffer) + (circe-server-chat-buffer-target target-or-buffer) + target-or-buffer)) + (target-name (irc-isupport--case-fold (circe-server-process) + target))) + (remhash target-name circe-server-chat-buffer-table)))) + +(defun circe-server-rename-chat-buffer (old-name new-name) + "Note that the chat buffer addressing OLD-NAME now addresses NEW-NAME." + (with-circe-server-buffer + (let* ((old-target-name (irc-isupport--case-fold (circe-server-process) + old-name)) + (new-target-name (irc-isupport--case-fold (circe-server-process) + new-name)) + (buf (gethash old-target-name circe-server-chat-buffer-table))) + (when buf + (remhash old-target-name circe-server-chat-buffer-table) + (puthash new-target-name buf circe-server-chat-buffer-table) + (with-current-buffer buf + (setq circe-chat-target new-name) + (rename-buffer new-name t)))))) + +(defun circe-server-chat-buffer-target (&optional buffer) + "Return the chat target of BUFFER, or the current buffer if none." + (if buffer + (with-current-buffer buffer + circe-chat-target) + circe-chat-target)) + +(defun circe-server-chat-buffers () + "Return the list of chat buffers on this server." + (with-circe-server-buffer + (when circe-server-chat-buffer-table + (let ((buffer-list nil)) + (maphash (lambda (target-name buffer) + (if (buffer-live-p buffer) + (push buffer buffer-list) + (remhash target-name circe-server-chat-buffer-table))) + circe-server-chat-buffer-table) + buffer-list)))) + +(defun circe-server-channel-buffers () + "Return a list of all channel buffers of this server." + (let ((result nil)) + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (when (eq major-mode 'circe-channel-mode) + (setq result (cons buf result))))) + (nreverse result))) + +;;;;;;;;;;;;;;;;; +;;; Chat Mode ;;; +;;;;;;;;;;;;;;;;; + +(defvar circe-chat-mode-hook nil + "Hook run when a new chat buffer (channel or query) is created.") + +(defvar circe-chat-mode-map (make-sparse-keymap) + "Base key map for all Circe chat buffers (channel, query).") + +;; Defined here as we use it, but do not necessarily want to use the +;; full module. +(defvar lui-logging-format-arguments nil + "A list of arguments to be passed to `lui-format'. +This can be used to extend the formatting possibilities of the +file name for lui applications.") +(make-variable-buffer-local 'lui-logging-format-arguments) + +(define-derived-mode circe-chat-mode circe-mode "Circe Chat" + "The circe chat major mode. + +This is the common mode used for both queries and channels. +It should not be used directly. +TARGET is the default target to send data to. +SERVER-BUFFER is the server buffer of this chat buffer." + (setq circe-server-buffer (car circe-chat-calling-server-buffer-and-target) + circe-chat-target (cdr circe-chat-calling-server-buffer-and-target)) + (let ((network (with-circe-server-buffer + circe-network))) + (make-local-variable 'mode-line-buffer-identification) + (setq mode-line-buffer-identification + (list (format "%%b@%-8s" network))) + (setq lui-logging-format-arguments + `(:target ,circe-chat-target :network ,network))) + (when (equal circe-chat-target "#emacs-circe") + (set (make-local-variable 'lui-button-issue-tracker) + "https://github.com/jorgenschaefer/circe/issues/%s"))) + +(defun circe-chat-disconnected () + "The current buffer got disconnected." + (circe-display-server-message "Disconnected")) + +;;;;;;;;;;;;;;;;;;;; +;;; Channel Mode ;;; +;;;;;;;;;;;;;;;;;;;; + +(defvar circe-channel-mode-hook nil + "Hook run in a new channel buffer.") + +(defvar circe-channel-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-n") 'circe-command-NAMES) + (define-key map (kbd "C-c C-t") 'circe-command-CHTOPIC) + map) + "The key map for channel mode buffers.") + +(define-derived-mode circe-channel-mode circe-chat-mode "Circe Channel" + "The circe channel chat major mode. +This mode represents a channel you are talking in. + +TARGET is the default target to send data to. +SERVER-BUFFER is the server buffer of this chat buffer. + +\\{circe-channel-mode-map}" + (add-hook 'kill-buffer-hook 'circe-channel-killed nil t)) + +(defun circe-channel-killed () + "Called when the channel buffer got killed. + +If we are not on the channel being killed, do nothing. Otherwise, +if the server is live, and the user wants to kill the buffer, +send PART to the server and clean up the channel's remaining +state." + (when (buffer-live-p circe-server-buffer) + (when (and circe-channel-killed-confirmation + (not (y-or-n-p "Really leave this channel? "))) + (error "Channel not left.")) + (ignore-errors + (irc-send-PART (circe-server-process) + circe-chat-target + circe-default-part-message)) + (ignore-errors + (circe-server-remove-chat-buffer circe-chat-target)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Channel User Tracking ;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Channel mode buffers provide some utility functions to check if a +;; given user is idle or not. + +(defun circe-channel-user-nick-regain-p (_old new) + "Return true if a nick change from OLD to NEW constitutes a nick regain. + +A nick was regained if the NEW nick was also a recent user." + (let ((channel (irc-connection-channel (circe-server-process) + circe-chat-target))) + (when channel + (irc-channel-recent-user channel new)))) + +(defun circe-channel-user-p (nick) + "Return non-nil when NICK belongs to a channel user." + (cond + ((eq major-mode 'circe-query-mode) + (irc-string-equal-p (circe-server-process) + nick + circe-chat-target)) + ((eq major-mode 'circe-channel-mode) + (let ((channel (irc-connection-channel (circe-server-process) + circe-chat-target))) + (when channel + (if (irc-channel-user channel nick) + t + nil)))))) + +(defun circe-channel-nicks () + "Return a list of nicks in the current channel." + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (nicks nil)) + (when channel + (maphash (lambda (_folded-nick user) + (push (irc-user-nick user) nicks)) + (irc-channel-users channel))) + nicks)) + +(defun circe-user-channels (nick) + "Return a list of channel buffers for the user named NICK." + (let* ((result nil)) + (dolist (channel (irc-connection-channel-list (circe-server-process))) + (when (irc-channel-user channel nick) + (let* ((name (irc-channel-name channel)) + (buf (circe-server-get-chat-buffer name))) + (when buf + (push buf result))))) + result)) + +(defun circe-lurker-p (nick) + "Return a true value if this nick is regarded inactive." + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (user (when channel + (irc-channel-user channel nick))) + (recent-user (when channel + (irc-channel-recent-user channel nick))) + (last-active (cond + (user + (irc-user-last-activity-time user)) + (recent-user + (irc-user-last-activity-time recent-user))))) + (cond + ;; If we do not track lurkers, no one is ever a lurker. + ((not (circe-reduce-lurker-spam)) + nil) + ;; We ourselves are never lurkers (in this sense). + ((circe-server-my-nick-p nick) + nil) + ;; Someone who isn't even on the channel (e.g. NickServ) isn't a + ;; lurker, either. + ((and (not user) + (not recent-user)) + nil) + ;; If someone has never been active, they most definitely *are* a + ;; lurker. + ((not last-active) + t) + ;; But if someone has been active, and we mark active users + ;; inactive again after a timeout ... + (circe-active-users-timeout + ;; They are still lurkers if their activity has been too long + ;; ago. + (> (- (float-time) + last-active) + circe-active-users-timeout)) + ;; Otherwise, they have been active and we don't mark active + ;; users inactive again, so nope, not a lurker. + (t + nil)))) + +(defun circe-lurker-rejoin-p (nick channel) + "Return true if NICK is rejoining CHANNEL. + +A user is considered to be rejoining if they were on the channel +shortly before, and were active then." + (let* ((channel (irc-connection-channel (circe-server-process) + channel)) + (user (when channel + (irc-channel-recent-user channel nick)))) + (when user + (irc-user-last-activity-time user)))) + +(defun circe-lurker-display-active (nick userhost) + "Show that this user is active if they are a lurker." + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (user (when channel + (irc-channel-user channel nick))) + (join-time (when user + (irc-user-join-time user)))) + (when (and (circe-lurker-p nick) + ;; If we saw them when we joined the channel, no need to + ;; say "they're suddenly active!!111one". + join-time) + (circe-display 'circe-format-server-lurker-activity + :nick nick + :userhost (or userhost "server") + :jointime join-time + :joindelta (circe-duration-string + (- (float-time) + join-time)))))) + +;;;;;;;;;;;;;;;;;; +;;; Query Mode ;;; +;;;;;;;;;;;;;;;;;; + +(defvar circe-query-mode-hook nil + "Hook run when query mode is activated.") + +(defvar circe-query-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map circe-chat-mode-map) + map) + "The key map for query mode buffers.") + +(define-derived-mode circe-query-mode circe-chat-mode "Circe Query" + "The circe query chat major mode. +This mode represents a query you are talking in. + +TARGET is the default target to send data to. +SERVER-BUFFER is the server buffer of this chat buffer. + +\\{circe-query-mode-map}" + (add-hook 'kill-buffer-hook 'circe-query-killed nil t)) + +(defun circe-query-killed () + "Called when the query buffer got killed." + (ignore-errors + (circe-server-remove-chat-buffer circe-chat-target))) + +(defun circe-query-auto-query-buffer (who) + "Return a buffer for a query with `WHO'. + +This adheres to `circe-auto-query-max'." + (or (circe-server-get-chat-buffer who) + (when (< (circe--query-count) + circe-auto-query-max) + (circe-server-get-or-create-chat-buffer who 'circe-query-mode)))) + +(defun circe--query-count () + "Return the number of queries on the current server." + (let ((num 0)) + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (when (eq major-mode 'circe-query-mode) + (setq num (+ num 1))))) + num)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; IRC Protocol Handling ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar circe--irc-handler-table nil + "The handler table for Circe's IRC connections. + +Do not use this directly. Instead, call `circe-irc-handler-table'.") + +(defun circe-irc-handler-table () + (when (not circe--irc-handler-table) + (let ((table (irc-handler-table))) + (irc-handler-add table "irc.registered" #'circe--irc-conn-registered) + (irc-handler-add table "conn.disconnected" #'circe--irc-conn-disconnected) + (irc-handler-add table nil #'circe--irc-display-event) + (irc-handle-registration table) + (irc-handle-ping-pong table) + (irc-handle-isupport table) + (irc-handle-initial-nick-acquisition table) + (irc-handle-ctcp table) + (irc-handle-state-tracking table) + (irc-handle-nickserv table) + (irc-handle-auto-join table) + (setq circe--irc-handler-table table))) + circe--irc-handler-table) + +(defun circe--irc-conn-registered (conn _event _nick) + (with-current-buffer (irc-connection-get conn :server-buffer) + (setq circe-server-reconnect-attempts 0) + (run-hooks 'circe-server-connected-hook))) + +(defun circe--irc-conn-disconnected (conn _event) + (with-current-buffer (irc-connection-get conn :server-buffer) + (dolist (buf (circe-server-chat-buffers)) + (with-current-buffer buf + (circe-chat-disconnected))) + + (circe-reconnect))) + +(defun circe--irc-display-event (conn event &optional sender &rest args) + "Display an IRC message. + +NICK, USER and HOST specify the originator of COMMAND with ARGS +as arguments." + (with-current-buffer (irc-connection-get conn :server-buffer) + (let* ((display (circe-get-display-handler event)) + (nick (when sender + (irc-userstring-nick sender))) + (userhost (when sender + (irc-userstring-userhost sender)))) + (cond + ;; Functions get called + ((functionp display) + (apply display nick userhost event args)) + ;; Lists describe patterns + ((consp display) + (circe--irc-display-format (elt display 1) + (elt display 0) + nick userhost event args)) + ;; No configured display handler, show a default + (t + (circe--irc-display-default nick userhost event args)))))) + +(defvar circe--irc-format-server-numeric "*** %s" + "The format to use for server messages. Do not set this.") + +(defun circe--irc-display-format (format target nick userhost event args) + (let* ((target+name (circe--irc-display-target target nick args)) + (target (car target+name)) + (name (cdr target+name)) + (origin (if userhost + (format "%s (%s)" nick userhost) + (format "%s" nick)))) + (with-current-buffer (or target + (circe-server-last-active-buffer)) + (let ((circe--irc-format-server-numeric + (if target + (format "*** %s" format) + (format "*** [%s] %s" name format)))) + (circe-display 'circe--irc-format-server-numeric + :nick (or nick "(unknown)") + :userhost (or userhost "server") + :origin origin + :event event + :command event + :target name + :indexed-args args))))) + +(defun circe--irc-display-target (target nick args) + "Return the target buffer and name. +The buffer might be nil if it is not alive. + +See `circe-set-display-handler' for a description of target. + +NICK and USERHOST are the originator of COMMAND which had ARGS as +arguments." + (cond + ((eq target 'nick) + (cons (circe-server-get-chat-buffer nick) + nick)) + ((numberp target) + (let ((name (nth target + args))) + (cons (circe-server-get-chat-buffer name) + name))) + ((eq target 'active) + (let ((buf (circe-server-last-active-buffer))) + (cons buf + (buffer-name buf)))) + ((eq target 'server) + (cons (current-buffer) (buffer-name))) + (t + (error "Bad target in format string: %s" target)))) + +(defun circe--irc-display-default (nick userhost event args) + (with-current-buffer (circe-server-last-active-buffer) + (let ((target (if (circe-server-my-nick-p (car args)) + "" + (format " to %s" (car args))))) + (cond + ((string-match "\\`irc.ctcpreply.\\(.*\\)\\'" event) + (circe-display-server-message + (format "CTCP %s reply from %s (%s)%s: %s" + (match-string 1 event) nick userhost target (cadr args)))) + ((string-match "\\`irc.ctcp.\\(.*\\)\\'" event) + (circe-display-server-message + (format "Unknown CTCP request %s from %s (%s)%s: %s" + (match-string 1 event) nick userhost target (cadr args)))) + (t + (circe-display-server-message + (format "[%s from %s%s] %s" + event + nick + (if userhost + (format " (%s)" userhost) + "") + (mapconcat #'identity args " ")))))))) + +(defun circe-set-display-handler (command handler) + "Set the display handler for COMMAND to HANDLER. + +A handler is either a function or a list. + +A function gets called in the server buffer with at least three +arguments, but possibly more. There's at least NICK and USERHOST +of the sender, which can be nil, and COMMAND, which is the event +which triggered this. Further arguments are arguments to the +event. + +Alternatively, the handler can be a list of two elements: + + target - The target of this message + format - The format for this string + +The target can be any of: + + 'active - The last active buffer of this server + 'nick - The nick who sent this message + 'server - The server buffer for this server + number - The index of the argument of the target + +The format is passed to `lui-format'. Possible format string +substitutions are {mynick}, {target}, {nick}, {userhost}, +{origin}, {command}, {target}, and indexed arguments for the +arguments to the IRC message." + (when (not circe-display-table) + (setq circe-display-table (make-hash-table :test 'equal))) + (puthash command handler circe-display-table)) + +(defun circe-get-display-handler (command) + "Return the display handler for COMMAND. + +See `circe-set-display-handler' for more information." + (when circe-display-table + (gethash command circe-display-table))) + +;;;;;;;;;;;;;;;; +;;; Commands ;;; +;;;;;;;;;;;;;;;; + +(defun circe-command-AWAY (reason) + "Set yourself away with REASON." + (interactive "sReason: ") + (irc-send-AWAY (circe-server-process) reason)) + +(defun circe-command-BACK (&optional ignored) + "Mark yourself not away anymore. + +Arguments are IGNORED." + (interactive) + (irc-send-AWAY (circe-server-process))) + +(defun circe-command-CHTOPIC (&optional ignored) + "Insert the topic of the current channel. + +Arguments are IGNORED." + (interactive) + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (topic (when channel + (irc-channel-topic channel)))) + (lui-replace-input (format "/TOPIC %s %s" + circe-chat-target (or topic "")))) + (goto-char (point-max)))) + +(defun circe-command-CLEAR (&optional ignored) + "Delete all buffer contents before the lui prompt." + (let ((inhibit-read-only t)) + (delete-region (point-min) lui-output-marker))) + +(defun circe-command-CTCP (who &optional command argument) + "Send a CTCP message to WHO containing COMMAND with ARGUMENT. +If COMMAND is not given, WHO is parsed to contain all of who, +command and argument. +If ARGUMENT is nil, it is interpreted as no argument." + (when (not command) + (if (string-match "^\\([^ ]*\\) *\\([^ ]*\\) *\\(.*\\)" who) + (setq command (upcase (match-string 2 who)) + argument (match-string 3 who) + who (match-string 1 who)) + (circe-display-server-message "Usage: /CTCP <who> <what>"))) + (when (not (string= "" command)) + (irc-send-ctcp (circe-server-process) + who + command + (if (and argument (not (equal argument ""))) + argument + nil)))) + +(defun circe-command-FOOL (line) + "Add the regex on LINE to the `circe-fool-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (add-to-list 'circe-fool-list regex) + (circe-display-server-message (format "Recognizing %s as a fool" + regex)))) + ((not circe-fool-list) + (circe-display-server-message "Your do not know any fools")) + (t + (circe-display-server-message "Your list of fools:") + (dolist (regex circe-fool-list) + (circe-display-server-message (format "- %s" regex))))))) + +(defun circe-command-GAWAY (reason) + "Set yourself away on all servers with reason REASON." + (interactive "sReason: ") + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (irc-send-AWAY circe-server-process reason)))) + +(defun circe-command-GQUIT (reason) + "Quit all servers with reason REASON." + (interactive "sReason: ") + (dolist (buf (circe-server-buffers)) + (with-current-buffer buf + (when (eq (process-status circe-server-process) + 'open) + (irc-send-QUIT circe-server-process reason))))) + +(defun circe-command-HELP (&optional ignored) + "Display a list of recognized commands, nicely formatted." + (circe-display-server-message + (concat "Recognized commands are: " + (mapconcat (lambda (s) s) (circe--commands-list) "")))) + +(defun circe-command-IGNORE (line) + "Add the regex on LINE to the `circe-ignore-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (add-to-list 'circe-ignore-list regex) + (circe-display-server-message (format "Ignore list, meet %s" + regex)))) + ((not circe-ignore-list) + (circe-display-server-message "Your ignore list is empty")) + (t + (circe-display-server-message "Your ignore list:") + (dolist (regex circe-ignore-list) + (circe-display-server-message (format "- %s" regex))))))) + +(defun circe-command-INVITE (nick &optional channel) + "Invite NICK to CHANNEL. +When CHANNEL is not given, NICK is assumed to be a string +consisting of two words, the nick and the channel." + (interactive "sInvite who: \nsWhere: ") + (when (not channel) + (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)" nick) + (setq channel (match-string 2 nick) + nick (match-string 1 nick)) + (when (or (string= "" nick) (null nick)) + (circe-display-server-message "Usage: /INVITE <nick> <channel>")))) + (irc-send-INVITE (circe-server-process) + nick + (if (and (null channel) + (not (null nick))) + circe-chat-target + channel))) + +(defun circe-command-JOIN (channel) + "Join CHANNEL. This can also contain a key." + (interactive "sChannel: ") + (let (channels keys) + (when (string-match "^\\s-*\\([^ ]+\\)\\(:? \\([^ ]+\\)\\)?$" channel) + (setq channels (match-string 1 channel) + keys (match-string 3 channel)) + (dolist (channel (split-string channels ",")) + (pop-to-buffer + (circe-server-get-or-create-chat-buffer channel + 'circe-channel-mode))) + (irc-send-JOIN (circe-server-process) channels keys)))) + +(defun circe-command-ME (line) + "Send LINE to IRC as an action." + (interactive "sAction: ") + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (circe-display 'circe-format-self-action + :body line + :nick (circe-nick)) + (irc-send-ctcp (circe-server-process) + circe-chat-target + "ACTION" line))) + +(defun circe-command-MSG (who &optional what) + "Send a message. + +Send WHO a message containing WHAT. + +If WHAT is not given, WHO should contain both the nick and the +message separated by a space." + (when (not what) + (if (string-match "^\\([^ ]*\\) \\(.*\\)" who) + (setq what (match-string 2 who) + who (match-string 1 who)) + (circe-display-server-message "Usage: /MSG <who> <what>"))) + (when what + (let ((buf (circe-query-auto-query-buffer who))) + (if buf + (with-current-buffer buf + (circe-command-SAY what) + (lui-add-input what)) + (with-current-buffer (circe-server-last-active-buffer) + (irc-send-PRIVMSG (circe-server-process) + who what) + (circe-display 'circe-format-self-message + :target who + :body what)))))) + +(defun circe-command-NAMES (&optional channel) + "List the names of the current channel or CHANNEL." + (interactive) + (let ((target (when channel + (string-trim channel)))) + (when (or (not target) + (equal target "")) + (setq target circe-chat-target)) + (if (not target) + (circe-display-server-message "No target for current buffer") + (irc-send-NAMES (circe-server-process) + target)))) + +(defun circe-command-NICK (newnick) + "Change nick to NEWNICK." + (interactive "sNew nick: ") + (let ((newnick (string-trim newnick))) + (irc-send-NICK (circe-server-process) newnick))) + +(defun circe-command-PART (reason) + "Part the current channel because of REASON." + (interactive "sReason: ") + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (irc-send-PART (circe-server-process) + circe-chat-target + (if (equal "" reason) + circe-default-part-message + reason)))) + +(defun circe-command-PING (target) + "Send a CTCP PING request to TARGET." + (interactive "sWho: ") + (let ((target (string-trim target))) + (irc-send-ctcp (circe-server-process) + target + "PING" (format "%s" (float-time))))) + +(defun circe-command-QUERY (arg) + "Open a query with WHO." + ;; Eventually, this should probably be just the same as + ;; circe-command-MSG + (interactive "sQuery with: ") + (let* (who what) + (if (string-match "\\`\\s-*\\(\\S-+\\)\\s-\\(\\s-*\\S-.*\\)\\'" arg) + (setq who (match-string 1 arg) + what (match-string 2 arg)) + (setq who (string-trim arg))) + (when (string= who "") + (circe-display-server-message "Usage: /query <nick> [something to say]")) + (pop-to-buffer + (circe-server-get-or-create-chat-buffer who 'circe-query-mode)) + (when what + (circe-command-SAY what) + (lui-add-input what)))) + +(defun circe-command-QUIT (reason) + "Quit the current server giving REASON." + (interactive "sReason: ") + (with-circe-server-buffer + (setq circe-server-inhibit-auto-reconnect-p t) + (irc-send-QUIT (circe-server-process) + (if (equal "" reason) + circe-default-quit-message + reason)))) + +(defun circe-command-QUOTE (line) + "Send LINE verbatim to the server." + (interactive "Line: ") + (irc-send-raw (circe-server-process) line) + (with-current-buffer (circe-server-last-active-buffer) + (circe-display-server-message (format "Sent to server: %s" + line)))) + +(defun circe-command-SAY (line) + "Say LINE to the current target." + (interactive "sSay: ") + (if (not circe-chat-target) + (circe-display-server-message "No target for current buffer") + (dolist (line (circe--split-line line)) + (circe-display 'circe-format-self-say + :body line + :nick (circe-nick)) + (irc-send-PRIVMSG (circe-server-process) + circe-chat-target + ;; Some IRC servers give an error if there is + ;; no text at all. + (if (string= line "") + " " + line))))) + +(defun circe--split-line (longline) + "Splits LONGLINE into smaller components. + +IRC silently truncates long lines. This splits a long line into +parts that each are not longer than `circe-split-line-length'." + (if (< (length longline) + circe-split-line-length) + (list longline) + (with-temp-buffer + (insert longline) + (let ((fill-column circe-split-line-length)) + (fill-region (point-min) (point-max) + nil t)) + (split-string (buffer-string) "\n")))) + +(defun circe-command-SV (&optional ignored) + "Tell the current channel about your client and Emacs version. + +Arguments are IGNORED." + (interactive) + (circe-command-SAY (format (concat "I'm using Circe version %s " + "with %s %s (of %s)") + (circe--version) + "GNU Emacs" + emacs-version + (format-time-string "%Y-%m-%d" + emacs-build-time)))) + +(defun circe-command-TOPIC (channel &optional newtopic) + "Change the topic of CHANNEL to NEWTOPIC." + (interactive "sChannel: \nsNew topic: ") + (when (string-match "^\\s-*$" channel) + (setq channel nil)) + (when (and channel + (not newtopic) + (string-match "^\\s-*\\(\\S-+\\)\\( \\(.*\\)\\)?" channel)) + (setq newtopic (match-string 3 channel) + channel (match-string 1 channel))) + (cond + ((and channel newtopic) + (irc-send-TOPIC (circe-server-process) channel newtopic)) + (channel + (irc-send-TOPIC (circe-server-process) channel)) + (circe-chat-target + (irc-send-TOPIC (circe-server-process) circe-chat-target)) + (t + (circe-display-server-message "No channel given, and no default target.")))) + +(defun circe-command-UNFOOL (line) + "Remove the entry LINE from `circe-fool-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (setq circe-fool-list (delete regex circe-fool-list)) + (circe-display-server-message (format "Assuming %s is not a fool anymore" + regex)))) + (t + (circe-display-server-message + "No one is not a fool anymore? UNFOOL requires one argument"))))) + +(defun circe-command-UNIGNORE (line) + "Remove the entry LINE from `circe-ignore-list'." + (with-current-buffer (circe-server-last-active-buffer) + (cond + ((string-match "\\S-+" line) + (let ((regex (match-string 0 line))) + (setq circe-ignore-list (delete regex circe-ignore-list)) + (circe-display-server-message (format "Ignore list forgot about %s" + regex)))) + (t + (circe-display-server-message + "Who do you want to unignore? UNIGNORE requires one argument"))))) + +(defun circe-command-WHOAMI (&optional ignored) + "Request WHOIS information about yourself. + +Arguments are IGNORED." + (interactive) + (irc-send-WHOIS (circe-server-process) + (circe-nick))) + +(defun circe-command-WHOIS (whom) + "Request WHOIS information about WHOM." + (interactive "sWhois: ") + (let* ((whom-server-name (split-string whom)) + (whom (car whom-server-name)) + (server-or-name (cadr whom-server-name))) + (irc-send-WHOIS (circe-server-process) whom server-or-name))) + +(defun circe-command-WHOWAS (whom) + "Request WHOWAS information about WHOM." + (interactive "sWhois: ") + (let ((whom (string-trim whom))) + (irc-send-WHOWAS (circe-server-process) whom))) + +(defun circe-command-STATS (query) + "Request statistics from a server." + (interactive) + ;; Split string into query and server if we can + (let ((query (split-string query))) + (irc-send-STATS (circe-server-process) (car query) (cadr query)))) + +(defun circe-command-WL (&optional split) + "Show the people who left in a netsplit. +Without any arguments, shows shows the current netsplits and how +many people are missing. With an argument SPLIT, which must be a +number, it shows the missing people due to that split." + (let ((circe-netsplit-list (with-circe-server-buffer + circe-netsplit-list))) + (if (or (not split) + (and (stringp split) + (string= split ""))) + (if (null circe-netsplit-list) + (circe-display-server-message "No net split at the moment") + (let ((n 0)) + (dolist (entry circe-netsplit-list) + (circe-display-server-message (format "(%d) Missing %d people due to %s" + n + (hash-table-count (nth 3 entry)) + (car entry))) + (setq n (+ n 1))))) + (let* ((index (if (numberp split) + split + (string-to-number split))) + (entry (nth index circe-netsplit-list))) + (if (not entry) + (circe-display-server-message (format "No split number %s - use /WL to see a list" + split)) + (let ((missing nil)) + (maphash (lambda (_key value) + (setq missing (cons value missing))) + (nth 3 entry)) + (circe-display-server-message + (format "Missing people due to %s: %s" + (car entry) + (mapconcat 'identity + (sort missing + (lambda (a b) + (string< (downcase a) + (downcase b)))) + ", "))))))))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;;; Display Handlers ;;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defun circe-display-ignore (_nick _userhost _command &rest _args) + "Don't show a this message. + +NICK and USERHOST are the originator of COMMAND which had ARGS as +arguments." + 'noop) + +(circe-set-display-handler "317" 'circe-display-317) +(defun circe-display-317 (_sender ignored _numeric _target nick + idletime &optional signon-time body) + "Show a 317 numeric (RPL_WHOISIDLE). + +Arguments are either of the two: + +:<server> 317 <ournick> <nick> <idle> :seconds idle +:<server> 317 <ournick> <nick> <idle> <signon> :seconds idle, signon time" + (with-current-buffer (circe-server-last-active-buffer) + (let ((seconds-idle (string-to-number idletime)) + (signon-time (when body + (string-to-number signon-time)))) + (if signon-time + (circe-display 'circe-format-server-whois-idle-with-signon + :whois-nick nick + :idle-seconds seconds-idle + :idle-duration (circe-duration-string seconds-idle) + :signon-time signon-time + :signon-date (current-time-string + (seconds-to-time signon-time)) + :signon-ago (circe-duration-string (- (float-time) + signon-time))) + (circe-display 'circe-format-server-whois-idle + :whois-nick nick + :idle-seconds seconds-idle + :idle-duration (circe-duration-string seconds-idle)))))) + +(circe-set-display-handler "329" 'circe-display-329) +(defun circe-display-329 (_server ignored _numeric _target channel timestamp) + "Show a 329 numeric (RPL_CREATIONTIME)." + (with-current-buffer (or (circe-server-get-chat-buffer channel) + (circe-server-last-active-buffer)) + (let ((creation-time (string-to-number timestamp))) + (circe-display 'circe-format-server-channel-creation-time + :channel channel + :date (current-time-string + (seconds-to-time creation-time)) + :ago (circe-duration-string (- (float-time) + creation-time)))))) + +(circe-set-display-handler "333" 'circe-display-333) +(defun circe-display-333 (_server ignored _numeric target + channel setter topic-time) + "Show a 333 numeric (RPL_TOPICWHOTIME). + +Arguments are either of the two: + +:<server> 333 <target> <channel> <nick> 1434996762 +:<server> 333 <target> <channel> <nick>!<user>@<host> 1434996803" + (let ((channel-buffer (circe-server-get-chat-buffer channel)) + (topic-time (string-to-number topic-time))) + (with-current-buffer (or channel-buffer + (circe-server-last-active-buffer)) + (circe-display (if channel-buffer + 'circe-format-server-topic-time + 'circe-format-server-topic-time-for-channel) + :nick target + :channel channel + :setter (irc-userstring-nick setter) + :setter-userhost (or (irc-userstring-userhost setter) + "(unknown)") + :topic-time topic-time + :topic-date (current-time-string + (seconds-to-time topic-time)) + :topic-ago (circe-duration-string (- (float-time) + topic-time)))))) + +(circe-set-display-handler "AUTHENTICATE" 'circe-display-ignore) +(circe-set-display-handler "CAP" 'circe-display-ignore) +(circe-set-display-handler "conn.connected" 'circe-display-ignore) +(circe-set-display-handler "conn.disconnected" 'circe-display-ignore) + +(circe-set-display-handler "irc.ctcp" 'circe-display-ignore) +(circe-set-display-handler "irc.ctcpreply" 'circe-display-ignore) + +(circe-set-display-handler "irc.ctcp.ACTION" 'circe-display-ctcp-action) +(defun circe-display-ctcp-action (nick userhost _command target text) + "Show an ACTION." + (cond + ;; Query + ((circe-server-my-nick-p target) + (let ((query-buffer (circe-query-auto-query-buffer nick))) + (with-current-buffer (or query-buffer + (circe-server-last-active-buffer)) + (circe-display (if query-buffer + 'circe-format-action + 'circe-format-message-action) + :nick nick + :userhost (or userhost "server") + :body text)))) + ;; Channel + (t + (with-current-buffer (circe-server-get-or-create-chat-buffer + target 'circe-channel-mode) + (circe-lurker-display-active nick userhost) + (circe-display 'circe-format-action + :nick nick + :userhost (or userhost "server") + :body text))))) + +(circe-set-display-handler "irc.ctcp.CLIENTINFO" 'circe-display-ctcp) + +(circe-set-display-handler "irc.ctcp.PING" 'circe-display-ctcp-ping) +(defun circe-display-ctcp-ping (nick userhost _command target text) + "Show a CTCP PING request." + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-ctcp-ping + :nick nick + :userhost (or userhost "server") + :target target + :body (or text "") + :ago (let ((time (when text + (string-to-number text)))) + (if time + (format "%.2f seconds" (- (float-time) time)) + "unknown seconds"))))) + +(circe-set-display-handler "irc.ctcpreply.PING" 'circe-display-ctcp-ping-reply) +(defun circe-display-ctcp-ping-reply (nick userhost _command target text) + "Show a CTCP PING reply." + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-ctcp-ping-reply + :nick nick + :userhost (or userhost "server") + :target target + :body text + :ago (let ((time (string-to-number text))) + (if time + (format "%.2f seconds" (- (float-time) time)) + "unknown seconds"))))) + +(circe-set-display-handler "irc.ctcp.SOURCE" 'circe-display-ctcp) +(circe-set-display-handler "irc.ctcp.TIME" 'circe-display-ctcp) +(circe-set-display-handler "irc.ctcp.VERSION" 'circe-display-ctcp) +(defun circe-display-ctcp (nick userhost command target text) + "Show a CTCP request that does not require special handling." + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-ctcp + :nick nick + :userhost (or userhost "server") + :target target + :command (substring command 9) + :body (or text "")))) + +(circe-set-display-handler "irc.registered" 'circe-display-ignore) + +(circe-set-display-handler "JOIN" 'circe-display-JOIN) +(defun circe-display-JOIN (nick userhost _command channel + &optional accountname realname) + "Show a JOIN message. + +The command receives an extra argument, the account name, on some +IRC servers." + (let* ((accountname (if (equal accountname "*") + "(unauthenticated)" + accountname)) + (userinfo (if accountname + (format "%s, %s: %s" userhost accountname realname) + userhost)) + (split (circe--netsplit-join nick))) + ;; First, update the channel + (with-current-buffer (circe-server-get-or-create-chat-buffer + channel 'circe-channel-mode) + (cond + (split + (let ((split-time (cadr split))) + (when (< (+ split-time circe-netsplit-delay) + (float-time)) + (circe-display 'circe-format-server-netmerge + :split (car split) + :time (cadr split) + :date (current-time-string + (seconds-to-time (cadr split))) + :ago (circe-duration-string + (- (float-time) (cadr split))))))) + ((and (circe-reduce-lurker-spam) + (circe-lurker-rejoin-p nick circe-chat-target)) + (let* ((channel (irc-connection-channel (circe-server-process) + circe-chat-target)) + (user (when channel + (irc-channel-recent-user channel nick))) + (departed (when user + (irc-user-part-time user)))) + (circe-display 'circe-format-server-rejoin + :nick nick + :userhost (or userhost "server") + :accountname accountname + :realname realname + :userinfo userinfo + :departuretime departed + :departuredelta (circe-duration-string + (- (float-time) + departed))))) + ((not (circe-reduce-lurker-spam)) + (circe-display 'circe-format-server-join + :nick nick + :userhost (or userhost "server") + :accountname accountname + :realname realname + :userinfo userinfo + :channel circe-chat-target)))) + ;; Next, a possible query buffer. We do this even when the message + ;; should be ignored by a netsplit, since this can't flood. + (let ((buf (circe-server-get-chat-buffer nick))) + (when buf + (with-current-buffer buf + (circe-display 'circe-format-server-join-in-channel + :nick nick + :userhost (or userhost "server") + :accountname accountname + :realname realname + :userinfo userinfo + :channel circe-chat-target)))))) + +(circe-set-display-handler "MODE" 'circe-display-MODE) +(defun circe-display-MODE (setter userhost _command target &rest modes) + "Show a MODE message." + (with-current-buffer (or (circe-server-get-chat-buffer target) + (circe-server-last-active-buffer)) + (circe-display 'circe-format-server-mode-change + :setter setter + :userhost (or userhost "server") + :target target + :change (mapconcat #'identity modes " ")))) + +(circe-set-display-handler "NICK" 'circe-display-NICK) +(defun circe-display-NICK (old-nick userhost _command new-nick) + "Show a nick change." + (if (circe-server-my-nick-p new-nick) + (dolist (buf (cons (or circe-server-buffer + (current-buffer)) + (circe-server-chat-buffers))) + (with-current-buffer buf + (circe-display 'circe-format-server-nick-change-self + :old-nick old-nick + :userhost (or userhost "server") + :new-nick new-nick))) + (let ((query-buffer (circe-server-get-chat-buffer old-nick))) + (when query-buffer + (with-current-buffer query-buffer + (circe-server-rename-chat-buffer old-nick new-nick) + (circe-display 'circe-format-server-nick-change + :old-nick old-nick + :new-nick new-nick + :userhost (or userhost "server"))))) + (dolist (buf (circe-user-channels new-nick)) + (with-current-buffer buf + (cond + ((and (circe-reduce-lurker-spam) + (circe-lurker-p new-nick)) + nil) + ((circe-channel-user-nick-regain-p old-nick new-nick) + (circe-display 'circe-format-server-nick-regain + :old-nick old-nick + :new-nick new-nick + :userhost (or userhost "server"))) + (t + (circe-display 'circe-format-server-nick-change + :old-nick old-nick + :new-nick new-nick + :userhost (or userhost "server")))))))) + +(circe-set-display-handler "nickserv.identified" 'circe-display-ignore) + +;; NOTICE is also used to encode CTCP replies. irc.el will send +;; irc.notice events for NOTICEs without CTCP replies, so we show +;; that, not the raw notice. +(circe-set-display-handler "NOTICE" 'circe-display-ignore) +(circe-set-display-handler "irc.notice" 'circe-display-NOTICE) +(defun circe-display-NOTICE (nick userhost _command target text) + "Show a NOTICE message." + (cond + ((not userhost) + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-server-notice + :server nick + :body text))) + ((circe-server-my-nick-p target) + (with-current-buffer (or (circe-server-get-chat-buffer nick) + (circe-server-last-active-buffer)) + (circe-display 'circe-format-notice + :nick nick + :userhost (or userhost "server") + :body text))) + (t + (with-current-buffer (or (circe-server-get-chat-buffer target) + (circe-server-last-active-buffer)) + (circe-display 'circe-format-notice + :nick nick + :userhost (or userhost "server") + :body text))))) + +(circe-set-display-handler "PART" 'circe-display-PART) +(defun circe-display-PART (nick userhost _command channel &optional reason) + "Show a PART message." + (with-current-buffer (or (circe-server-get-chat-buffer channel) + (circe-server-last-active-buffer)) + (when (or (not circe-chat-target) + (not (circe-lurker-p nick))) + (circe-display 'circe-format-server-part + :nick nick + :userhost (or userhost "server") + :channel channel + :reason (or reason "[No reason given]"))))) + +(circe-set-display-handler "PING" 'circe-display-ignore) +(circe-set-display-handler "PONG" 'circe-display-ignore) + +;; PRIVMSG is also used to encode CTCP requests. irc.el will send +;; irc.message events for PRIVMSGs without CTCP messages, so we show +;; that, not the raw message. +(circe-set-display-handler "PRIVMSG" 'circe-display-ignore) +(circe-set-display-handler "irc.message" 'circe-display-PRIVMSG) +(defun circe-display-PRIVMSG (nick userhost _command target text) + "Show a PRIVMSG message." + (cond + ((circe-server-my-nick-p target) + (let ((buf (circe-query-auto-query-buffer nick))) + (if buf + (with-current-buffer buf + (circe-display 'circe-format-say + :nick nick + :userhost (or userhost "server") + :body text)) + (with-current-buffer (circe-server-last-active-buffer) + (circe-display 'circe-format-message + :nick nick + :userhost (or userhost "server") + :body text))))) + (t + (with-current-buffer (circe-server-get-or-create-chat-buffer + target 'circe-channel-mode) + (circe-lurker-display-active nick userhost) + (circe-display 'circe-format-say + :nick nick + :userhost (or userhost "server") + :body text))))) + +(circe-set-display-handler "TOPIC" 'circe-display-topic) +(defun circe-display-topic (nick userhost _command channel new-topic) + "Show a TOPIC change." + (with-current-buffer (circe-server-get-or-create-chat-buffer + channel 'circe-channel-mode) + (let* ((channel-obj (irc-connection-channel (circe-server-process) + channel)) + (old-topic (or (when channel + (irc-channel-last-topic channel-obj)) + ""))) + (circe-display 'circe-format-server-topic + :nick nick + :userhost (or userhost "server") + :channel channel + :new-topic new-topic + :old-topic old-topic + :topic-diff (circe--topic-diff old-topic new-topic))))) + +(defun circe--topic-diff (old new) + "Return a colored topic diff between OLD and NEW." + (mapconcat (lambda (elt) + (cond + ((eq '+ (car elt)) + (let ((s (cadr elt))) + (add-face-text-property 0 (length s) + 'circe-topic-diff-new-face nil s) + s)) + ((eq '- (car elt)) + (let ((s (cadr elt))) + (add-face-text-property 0 (length s) + 'circe-topic-diff-removed-face nil s) + s)) + (t + (cadr elt)))) + (lcs-unified-diff (circe--topic-diff-split old) + (circe--topic-diff-split new) + 'string=) + "")) + +(defun circe--topic-diff-split (str) + "Split STR into a list of components. +The list consists of words and spaces." + (let ((lis nil)) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (while (< (point) + (point-max)) + (if (or (looking-at "\\w+\\W*") + (looking-at ".\\s-*")) + (progn + (setq lis (cons (match-string 0) + lis)) + (replace-match "")) + (error "Can't happen")))) + (nreverse lis))) + +(circe-set-display-handler "channel.quit" 'circe-display-channel-quit) +(defun circe-display-channel-quit (nick userhost _command channel + &optional reason) + "Show a QUIT message." + (let ((split (circe--netsplit-quit reason nick))) + (with-current-buffer (circe-server-get-or-create-chat-buffer + channel 'circe-channel-mode) + (cond + (split + (when (< (+ split circe-netsplit-delay) + (float-time)) + (circe-display 'circe-format-server-netsplit + :split reason))) + ((not (circe-lurker-p nick)) + (circe-display 'circe-format-server-quit-channel + :nick nick + :userhost (or userhost "server") + :channel channel + :reason (or reason "[no reason given]"))))))) + +(circe-set-display-handler "QUIT" 'circe-display-QUIT) +(defun circe-display-QUIT (nick userhost _command &optional reason) + "Show a QUIT message. + +Channel quits are shown already, so just show quits in queries." + (let ((buf (circe-server-get-chat-buffer nick))) + (when buf + (with-current-buffer buf + (circe-display 'circe-format-server-quit + :nick nick + :userhost (or userhost "server") + :reason (or reason "[no reason given]")))))) + +(defvar circe-netsplit-list nil + "A list of recorded netsplits. +Every item is a list with four elements: +- The quit message for this split. +- The time when last we heard about a join in this split +- The time when last we heard about a quit in this split +- A hash table noting which nicks did leave") +(make-variable-buffer-local 'circe-netsplit-list) + +(defun circe--netsplit-join (nick) + "Search for NICK in the netsplit lists. +This either returns a pair whose car is the quit message of this +split, and the cadr the time we last heard anything of the split +of that user. If the NICK isn't split, this returns nil." + (with-circe-server-buffer + (catch 'return + (dolist (entry circe-netsplit-list) + (let ((table (nth 3 entry))) + (when (gethash nick table) + (let ((name (nth 0 entry)) + (time (nth 1 entry))) + (remhash nick table) + (when (= 0 (hash-table-count table)) + (setq circe-netsplit-list + (delq entry circe-netsplit-list))) + (setcar (cdr entry) + (float-time)) + (throw 'return (list name time)))))) + nil))) + +(defun circe--netsplit-quit (reason nick) + "If REASON indicates a netsplit, mark NICK as splitted. +This either returns the time when last we heard about this split, +or nil when this isn't a split." + (when (circe--netsplit-reason-p reason) + (with-circe-server-buffer + (let ((entry (assoc reason circe-netsplit-list))) + (if entry + (let ((time (nth 2 entry)) + (table (nth 3 entry))) + (setcar (cddr entry) + (float-time)) + (puthash nick nick table) + time) + ;; New split! + (let ((table (make-hash-table :test 'equal))) + (puthash nick nick table) + (setq circe-netsplit-list + (cons (list reason 0 (float-time) table) + circe-netsplit-list)) + 0)))))) + +(defun circe--netsplit-reason-p (reason) + "Return non-nil if REASON is the quit message of a netsplit. +This is true when it contains exactly two hosts, with a single +space in between them. The hosts must include at least one dot, +and must not include colons or slashes (else they might be +URLs). (Thanks to irssi for this criteria list)" + (if (string-match "^[^ :/]+\\.[^ :/]* [^ :/]+\\.[^ :/]*$" + reason) + t + nil)) + +(let ((simple-format-specifiers + '(("INVITE" active "Invite: {origin} invites you to {1}") + ("KICK" 0 "Kick: {1} kicked by {origin}: {2}") + ("ERROR" active "Error: {0-}") + ("001" server "{1}") + ("002" server "{1}") + ("003" server "{1}") + ("004" server "{1-}") + ("005" server "{1-}") + ;; IRCnet: * Please wait while we process your connection. + ("020" server "{0-}") + ;; IRCnet + ("042" server "Your unique ID is {1}") + ("200" active "{1-}") + ("201" active "{1-}") + ("203" active "{1-}") + ("204" active "{1-}") + ("205" active "{1-}") + ("206" active "{1-}") + ("207" active "{1-}") + ("208" active "{1-}") + ("209" active "{1-}") + ("211" active "{1-}") + ("212" active "{1-}") + ("219" active "{1-}") + ("221" active "User mode: {1-}") + ("234" active "Service: {1-}") + ("235" active "{1-}") + ("242" active "{1}") + ("243" active "{1-}") + ("250" server "{1}") + ("251" server "{1}") + ("252" server "{1-}") + ("253" server "{1-}") + ("254" server "{1-}") + ("255" server "{1}") + ("256" active "{1-}") + ("257" active "{1}") + ("258" active "{1}") + ("259" active "{1}") + ("261" active "{1-}") + ("262" active "{1-}") + ("263" active "{1-}") + ("265" server "{1-}") + ("266" server "{1-}") + ;; This is returned on both WHOIS and PRIVMSG. It + ;; should go to the active window for the former, and + ;; the query window for the latter. Oh well. + ("301" active "User away: {1}") + ("302" active "User hosts: {1}") + ("303" active "Users online: {1}") + ("305" active "{1}") + ("306" active "{1}") + ("307" active "{1-}") + ;; Coldfront: 310 <nick> is available for help. + ("310" active "{1-}") + ("311" active "{1} is {2}@{3} ({5})") + ("312" active "{1} is on {2} ({3})") + ("313" active "{1} {2}") + ("314" active "{1} was {2}@{3} ({5})") + ("315" active "{2}") + ("318" active "{2}") + ("319" active "{1} is on {2}") + ("320" active "{1-}") + ("322" active "{1-}") + ("323" active "{1-}") + ("324" 1 "Channel mode for {1}: {2-}") + ("325" 1 "Unique operator on {1} is {2}") + ("328" 1 "Channel homepage for {1}: {2-}") + ("330" active "{1} is logged in as {2}") + ("331" 1 "No topic for {1} set") + ("332" 1 "Topic for {1}: {2}") + ("341" active "Inviting {1} to {2}") + ("346" 1 "Invite mask: {2}") + ("347" 1 "{2}") + ("348" 1 "Except mask: {2}") + ("349" 1 "{2}") + ("351" active "{1-}") + ("352" active "{5} ({2}@{3}) in {1} on {4}: {6-}") + ("353" 2 "Names: {3}") + ("364" active "{1-}") + ("365" active "{1-}") + ("366" 1 "{2}") + ("367" 1 "Ban mask: {2}") + ("368" 1 "{2}") + ("369" active "{1} {2}") + ("371" active "{1}") + ("372" server "{1}") + ("374" active "{1}") + ("375" server "{1}") + ("376" server "{1}") + ("378" active "{1-}") + ("381" active "{1}") + ("382" active "{1-}") + ("391" active "Time on {1}: {2}") + ("401" active "No such nick: {1}") + ("402" active "No such server: {1}") + ("403" active "No such channel: {1}") + ("404" 1 "Can not send to channel {1}") + ("405" active "Can not join {1}: {2}") + ("406" active "{1-}") + ("407" active "{1-}") + ("408" active "No such service: {1}") + ("422" active "{1}") + ("432" active "Erroneous nick name: {1}") + ("433" active "Nick name in use: {1}") + ("437" active "Nick/channel is temporarily unavailable: {1}") + ("441" 2 "User not on channel: {1}") + ("442" active "You are not on {1}") + ("443" 2 "User {1} is already on channel {2}") + ;; Coldfront: 451 * :You have not registered + ("451" active "{1-}") + ("467" 1 "{2}") + ("470" 1 "{1} made you join {2}: {3-}") + ("471" 1 "{2}") + ("472" active "{1-}") + ("473" active "{1-}") + ("474" active "{1-}") + ("475" active "{1-}") + ("476" active "{1-}") + ("477" active "{1-}") + ("481" 1 "{2-}") + ("484" active "{1-}") + ;; Coldfront: 671 <nick> is using a Secure Connection + ("671" active "{1-}") + ("728" 1 "Quiet mask: {3}") + ("729" 1 "{3-}") + ;; Freenode SASL auth + ("900" active "SASL: {3-}") + ("903" active "{1-}")))) + (dolist (fmt simple-format-specifiers) + (circe-set-display-handler (car fmt) (cdr fmt)))) + +(defun circe-set-message-target (command target) + "Set the target of COMMAND to TARGET. + +This can be used to change format-based display handlers more +easily." + (let ((handler (circe-get-display-handler command))) + (when (not (consp handler)) + (error "Handler of command %s is not a list" command)) + (setcar handler target))) + +;;;;;;;;;;;;;;;;;;;;;;;; +;;; Helper Functions ;;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defun circe--list-drop-right (list pattern) + "Drop elements from the right of LIST that match PATTERN. + +LIST should be a list of strings, and PATTERN is used as a +regular expression." + (let ((list (reverse list))) + (while (and list + (string-match pattern (car list))) + (setq list (cdr list))) + (nreverse list))) + +(defun circe--nick-next (oldnick) + "Return a new nick to try for OLDNICK." + (cond + ;; If the nick ends with -+, replace those with _ + ((string-match "^\\(.*[^-]\\)\\(-+\\)$" oldnick) + (concat (match-string 1 oldnick) + (make-string (- (match-end 2) + (match-beginning 2)) + ?_))) + ;; If the nick is 9 chars long, take prefix and rotate. + ((>= (length oldnick) + 9) + (when (string-match "^\\(.*[^-_]\\)[-_]*$" oldnick) + (let ((nick (match-string 1 oldnick))) + (concat (substring nick 1) + (string (aref nick 0)))))) + ;; If the nick ends with _+ replace those with - and add one + ((string-match "^\\(.*[^_]\\)\\(_+\\)$" oldnick) + (concat (match-string 1 oldnick) + (make-string (- (match-end 2) + (match-beginning 2)) + ?-) + "-")) + ;; Else, just append - + (t + (concat oldnick "-")))) + +(defun circe-duration-string (duration) + "Return a description of a DURATION in seconds." + (let ((parts `((,(* 12 30 24 60 60) "year") + (,(* 30 24 60 60) "month") + (,(* 24 60 60) "day") + (,(* 60 60) "hour") + (60 "minute") + (1 "second"))) + (duration (round duration)) + (result nil)) + (dolist (part parts) + (let* ((seconds-per-part (car part)) + (description (cadr part)) + (count (/ duration seconds-per-part))) + (when (not (zerop count)) + (setq result (cons (format "%d %s%s" + count description + (if (= count 1) "" "s")) + result))) + (setq duration (- duration (* count seconds-per-part))))) + (if result + (mapconcat #'identity + (nreverse result) + " ") + "a moment"))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Deprecated functions and variables + +(define-obsolete-function-alias 'circe-server-nick 'circe-nick + "Circe 2.0") + +(define-obsolete-function-alias 'circe-server-message + 'circe-display-server-message + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-networks 'circe-network-defaults + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-name 'circe-host + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-service 'circe-port + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-network 'circe-network + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-ip-family 'circe-ip-family + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-nick 'circe-nick + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-user 'circe-user + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-pass 'circe-pass + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-realname 'circe-realname + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-use-tls 'circe-use-tls + "Circe 2.0") + +(define-obsolete-variable-alias 'circe-server-auto-join-channels + 'circe-channels + "Circe 2.0") + +(provide 'circe) +;;; circe.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe.elc new file mode 100644 index 000000000000..110eafbad7cc --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/circe.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/irc.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/irc.el new file mode 100644 index 000000000000..04b260c75a43 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/irc.el @@ -0,0 +1,1413 @@ +;;; irc.el --- Library to handle IRC connections -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Jorgen Schaefer <contact@jorgenschaefer.de> + +;; Author: Jorgen Schaefer <contact@jorgenschaefer.de> +;; URL: https://github.com/jorgenschaefer/circe + +;; 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: + +;; The main entry function is `irc-connect'. This creates a new +;; connection to an IRC server, and also takes an event handler table +;; which is used to run various event handlers. Handlers receive a +;; connection object which can be used for other API calls. + +;; IRC connection objects also accept connection options. These can be +;; queried using `irc-connection-get', and are set by `irc-connect' or +;; later using `irc-connection-put'. + +;; Event handler tables are simple maps of names to functions. See +;; `irc-handler-table', `irc-handler-add' and `irc-handler-run' for +;; the API. + +;; To send commands to the server, use `irc-send-raw' or +;; `irc-send-command'. + +;; The rest of the library are handler packs that add support for +;; various IRC features. + +;;; Code: + +(require 'cl-lib) +(require 'make-tls-process) + +(defvar irc-debug-log nil + "Emit protocol debug info if this is non-nil.") + +;;;;;;;;;;;;;;;;;;;;;;; +;;; Connection function + +(defun irc-connect (&rest keywords) + "Connect to an IRC server. + +Supported keyword arguments: + +:name NAME -- The name for the process +:host HOST -- The host to connect to +:service SERVICE -- The service or port to connect to +:tls BOOL -- Whether to use TLS +:family IP-FAMILY -- Force using of ipv4 or ipv6 +:handler-table HANDLER -- The event handler table to send events to. + +The following events are supported: + +conn.connected conn -- The connection was established +conn.failed conn -- The connection could not be established +conn.disconnected conn -- A previously established connection was lost + +NNN conn sender args... -- A numeric reply from IRC was received +COMMAND conn sender args... -- An IRC command message was received" + (let ((proc (funcall (if (plist-get keywords :tls) + #'make-tls-process + #'make-network-process) + :name (or (plist-get keywords :name) + (plist-get keywords :host)) + :host (or (plist-get keywords :host) + (error "Must specify a :host to connect to")) + :service (or (plist-get keywords :service) + (error "Must specify a :service to connect to")) + :family (plist-get keywords :family) + :coding 'no-conversion + :nowait (featurep 'make-network-process '(:nowait t)) + :noquery t + :filter #'irc--filter + :sentinel #'irc--sentinel + :plist keywords + :keepalive t))) + ;; When we used `make-network-process' without :nowait, the + ;; sentinel is not called with the open event, so we do this + ;; manually. + (when (eq (process-status proc) 'open) + (irc--sentinel proc "open manually")) + proc)) + +(defun irc-connection-get (conn propname) + "Return the value of CONN's PROPNAME property." + (process-get conn propname)) + +(defun irc-connection-put (conn propname value) + "Change CONN's PROPNAME property to VALUE." + (process-put conn propname value)) + +(defun irc--sentinel (proc event) + (cond + ((string-match "\\`failed" event) + (irc-event-emit proc "conn.failed")) + ((string-match "\\`open" event) + (irc-event-emit proc "conn.connected")) + ((string-match "\\`\\(connection broken\\|finished\\|exited abnormally\\)" + event) + (irc-event-emit proc "conn.disconnected")) + ((string-match "\\`\\(deleted\\|killed\\)" event) + nil) + (t + (error "Unknown event in IRC sentinel: %S" event)))) + +(defvar irc--filter-running-p nil + "Non-nil when we're currently processing a message. + +Yep, this is a mutex. Why would one need a mutex in Emacs, a +single-threaded application, you ask? Easy! + +When, during the execution of a process filter, any piece of code +waits for process output - e.g. because they started a some +external program - Emacs will process any input from external +processes. Including the one for the filter that is currently +running. + +If that process does emit output, the filter is run again, while +it is already running. If the filter is not careful, this can +cause data to arrive out of order, or get lost.") + +(defun irc--filter (proc data) + "Handle data from the process." + (irc-connection-put proc :conn-data + (concat (or (irc-connection-get proc :conn-data) + "") + data)) + (when (not irc--filter-running-p) + (let ((irc--filter-running-p t) + (data (irc-connection-get proc :conn-data))) + (while (string-match "\r?\n" data) + (let ((line (substring data 0 (match-beginning 0)))) + (setq data (substring data (match-end 0))) + (irc-connection-put proc :conn-data data) + (irc--handle-line proc line) + (setq data (irc-connection-get proc :conn-data))))))) + +(defun irc--handle-line (proc line) + "Handle a single line from the IRC server. + +The command is simply passed to the event handler of the IRC +connection." + (irc-debug-out proc "S: %s" line) + (let* ((parsed (irc--parse line)) + (sender (car parsed)) + (command (cadr parsed)) + (args (cddr parsed))) + (apply #'irc-event-emit proc command sender args))) + +(defun irc--parse (line) + "Parse a line from IRC. + +Returns a list: (sender command args...) + +A line from IRC is a space-separated list of arguments. If the +first word starts with a colon, that's the sender. The first or +second word is the command. All further words are arguments. The +first word to start with a colon ends the argument list. + +Examples: + +COMMAND +COMMAND arg +COMMAND arg1 arg2 +COMMAND arg1 arg2 :arg3 still arg3 +:sender COMMAND arg1 arg2 :arg3 still arg3" + (with-temp-buffer + (insert line) + (goto-char (point-min)) + (let ((sender nil) + (args nil)) + ;; Optional sender. + (when (looking-at ":\\([^ ]+\\) ") + (setq sender (decode-coding-string + (match-string 1) + 'undecided)) + (goto-char (match-end 0))) + + ;; COMMAND. + (unless (looking-at "\\([^ ]+\\)") + (error "Invalid message: %s" line)) + (push (decode-coding-string (match-string 1) 'undecided) + args) + (goto-char (match-end 0)) + + ;; Arguments. + (while (re-search-forward " :\\(.*\\)\\| \\([^ ]*\\)" nil t) + (push (decode-coding-string + (or (match-string 1) + (match-string 2)) + 'undecided) + args)) + + (cons sender (nreverse args))))) + +(defun irc-userstring-nick (userstring) + "Return the nick in a given USERSTRING. + +USERSTRING is a typical nick!user@host prefix as used by IRC." + (if (string-match "\\`\\([^!]+\\)!\\([^@]+\\)@\\(.*\\)\\'" userstring) + (match-string 1 userstring) + userstring)) + +(defun irc-userstring-userhost (userstring) + "Return the nick in a given USERSTRING. + +USERSTRING is a typical nick!user@host prefix as used by IRC." + (if (string-match "\\`\\([^!]+\\)!\\([^@]+@.*\\)\\'" userstring) + (match-string 2 userstring) + nil)) + +(defun irc-event-emit (conn event &rest args) + "Run the event handlers for EVENT in CONN with ARGS." + (irc-debug-out conn + "E: %S %s" + event + (mapconcat (lambda (elt) (format "%S" elt)) + args + " ")) + (let ((handler-table (irc-connection-get conn :handler-table))) + (when handler-table + (apply #'irc-handler-run handler-table event conn event args) + (apply #'irc-handler-run handler-table nil conn event args)))) + +;;;;;;;;;;;;;;;;;;;;;;; +;;; Event handler table + +(defun irc-handler-table () + "Return a new event handler table." + (make-hash-table :test 'equal)) + +(defun irc-handler-add (table event handler) + "Add HANDLER for EVENT to the event handler table TABLE." + (puthash event + (append (gethash event table) + (list handler)) + table)) + +(defun irc-handler-remove (table event handler) + "Remove HANDLER for EVENT to the event handler table TABLE." + (puthash event + (delete handler + (gethash event table)) + table)) + +(defun irc-handler-run (table event &rest args) + "Run the handlers for EVENT in TABLE, passing ARGS to each." + (dolist (handler (gethash event table)) + (if debug-on-error + (apply handler args) + (condition-case err + (apply handler args) + (error + (message "Error running event %S handler %S: %S (args were %S)" + event handler err args)))))) + +;;;;;;;;;;; +;;; Sending + +(defun irc-send-raw (conn line &optional flood-handling) + "Send a line LINE to the IRC connection CONN. + +LINE should not include the trailing newline. + +FLOOD-HANDLING defines how to handle the situation when we are +sending too much data. It can have three values: + +nil -- Add the message to a queue and send it later +:nowait -- Send the message immediately, circumventing flood protection +:drop -- Send the message only if we are not flooding, and drop it if + we have queued up messages. + +The flood protection algorithm works like the one detailed in RFC +2813, section 5.8 \"Flood control of clients\". + + * If `flood-last-message' is less than the current + time, set it equal. + * While `flood-last-message' is less than `flood-margin' + seconds ahead of the current time, send a message, and + increase `flood-last-message' by `flood-penalty'." + (cond + ((null flood-handling) + (irc-connection-put conn + :flood-queue + (append (irc-connection-get conn :flood-queue) + (list line))) + (irc-send--queue conn)) + ((eq flood-handling :nowait) + (irc-send--internal conn line)) + ((eq flood-handling :drop) + (let ((queue (irc-connection-get conn :flood-queue))) + (when (not queue) + (irc-connection-put conn :flood-queue (list line)) + (irc-send--queue conn)))))) + +(defun irc-send--queue (conn) + "Send messages from the flood queue in CONN. + +See `irc-send-raw' for the algorithm." + (let ((queue (irc-connection-get conn :flood-queue)) + (last-message (or (irc-connection-get conn :flood-last-message) + 0)) + (margin (or (irc-connection-get conn :flood-margin) + 10)) + (penalty (or (irc-connection-get conn :flood-penalty) + 3)) + (now (float-time))) + (when (< last-message now) + (setq last-message now)) + (while (and queue + (< last-message (+ now margin))) + (irc-send--internal conn (car queue)) + (setq queue (cdr queue) + last-message (+ last-message penalty))) + (irc-connection-put conn :flood-queue queue) + (irc-connection-put conn :flood-last-message last-message) + (let ((timer (irc-connection-get conn :flood-timer))) + (when timer + (cancel-timer timer) + (irc-connection-put conn :flood-timer nil)) + (when queue + (irc-connection-put conn + :flood-timer + (run-at-time 1 nil #'irc-send--queue conn)))))) + +(defun irc-send--internal (conn line) + "Send LINE to CONN." + (irc-debug-out conn "C: %s" line) + (process-send-string conn + (concat (encode-coding-string line 'utf-8) + "\r\n"))) + +(defun irc-send-command (conn command &rest args) + "Send COMMAND with ARGS to IRC connection CONN." + (irc-send-raw conn (apply #'irc--format-command command args))) + +(defun irc--format-command (command &rest args) + "Format COMMAND and ARGS for IRC. + +The last value in ARGS will be escaped with a leading colon if it +contains a space. All other arguments are checked to make sure +they do not contain a space." + (dolist (arg (cons command args)) + (when (not (stringp arg)) + (error "Argument must be a string"))) + (let* ((prefix (cons command (butlast args))) + (last (last args))) + (dolist (arg prefix) + (when (string-match " " arg) + (error "IRC protocol error: Argument %S must not contain space" + arg))) + (when (and last (or (string-match " " (car last)) + (string-match "^:" (car last)) + (equal "" (car last)))) + (setcar last (concat ":" (car last)))) + (mapconcat #'identity + (append prefix last) + " "))) + +(defun irc-send-AUTHENTICATE (conn arg) + "Send an AUTHENTICATE message with ARG. + +See https://github.com/atheme/charybdis/blob/master/doc/sasl.txt +for details." + (irc-send-command conn "AUTHENTICATE" arg)) + +(defun irc-send-AWAY (conn &optional reason) + "Mark yourself as AWAY with reason REASON, or back if reason is nil." + (if reason + (irc-send-command conn "AWAY" reason) + (irc-send-command conn "AWAY"))) + +(defun irc-send-CAP (conn &rest args) + "Send a CAP message. + +See https://tools.ietf.org/html/draft-mitchell-irc-capabilities-01 +for details." + (apply #'irc-send-command conn "CAP" args)) + +(defun irc-send-INVITE (conn nick channel) + "Invite NICK to CHANNEL." + (irc-send-command conn "INVITE" nick channel)) + +(defun irc-send-JOIN (conn channel &optional key) + "Join CHANNEL. + +If KEY is given, use it to join the password-protected channel." + (if key + (irc-send-command conn "JOIN" channel key) + (irc-send-command conn "JOIN" channel))) + +(defun irc-send-NAMES (conn &optional channel) + "Retrieve user names from the server, optionally limited to CHANNEL." + (if channel + (irc-send-command conn "NAMES" channel) + (irc-send-command conn "NAMES"))) + +(defun irc-send-NICK (conn nick) + "Change your own nick to NICK." + (irc-send-command conn "NICK" nick)) + +(defun irc-send-NOTICE (conn msgtarget text-to-be-sent) + "Send a private notice containing TEXT-TO-BE-SENT to MSGTARGET. + +MSGTARGET can be either a nick or a channel." + (irc-send-command conn "NOTICE" msgtarget text-to-be-sent)) + +(defun irc-send-PART (conn channel reason) + "Leave CHANNEL with reason REASON." + (irc-send-command conn "PART" channel reason)) + +(defun irc-send-PASS (conn password) + "Authenticate to the server using PASSWORD." + (irc-send-command conn "PASS" password)) + +(defun irc-send-PONG (conn server) + "Respond to a PING message." + (irc-send-raw conn + (irc--format-command "PONG" server) + :nowait)) + +(defun irc-send-PRIVMSG (conn msgtarget text-to-be-sent) + "Send a private message containing TEXT-TO-BE-SENT to MSGTARGET. + +MSGTARGET can be either a nick or a channel." + (irc-send-command conn "PRIVMSG" msgtarget text-to-be-sent)) + +(defun irc-send-QUIT (conn reason) + "Leave IRC with reason REASON." + (irc-send-command conn "QUIT" reason)) + +(defun irc-send-TOPIC (conn channel &optional new-topic) + "Retrieve or set the topic of CHANNEL + +If NEW-TOPIC is given, set this as the new topic. If it is +omitted, retrieve the current topic." + (if new-topic + (irc-send-command conn "TOPIC" channel new-topic) + (irc-send-command conn "TOPIC" channel))) + +(defun irc-send-USER (conn user mode realname) + "Send a USER message for registration. + +MODE should be an integer as per RFC 2812" + (irc-send-command conn "USER" user (format "%s" mode) "*" realname)) + +(defun irc-send-WHOIS (conn target &optional server-or-name) + "Retrieve current whois information on TARGET." + (if server-or-name + (irc-send-command conn "WHOIS" target server-or-name) + (irc-send-command conn "WHOIS" target))) + +(defun irc-send-WHOWAS (conn target) + "Retrieve past whois information on TARGET." + (irc-send-command conn "WHOWAS" target)) + +(defun irc-send-STATS (conn query &optional server) + "Return statistics on current server, or SERVER if it is specified." + (if server + (irc-send-command conn "STATS" query server) + (irc-send-command conn "STATS" query))) + +;;;;;;;;;;;;;;; +;;; Debug stuff + +(defun irc-debug-out (conn fmt &rest args) + (when irc-debug-log + (let ((name (format "*IRC Protocol %s:%s*" + (irc-connection-get conn :host) + (irc-connection-get conn :service)))) + (with-current-buffer (get-buffer-create name) + (save-excursion + (goto-char (point-max)) + (insert (apply #'format fmt args) "\n")))))) + +;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Handler: Registration + +(defun irc-handle-registration (table) + "Add command handlers to TABLE to handle registration. + +This will send the usual startup messages after we are connected. + +Events emitted: + +\"irc.registered\" current-nick -- We have successfully + registered with the IRC server. Most commands can be used now. + In particular, joining channels is only possible now. + +\"sasl.login\" nick!user@host account -- SASL log in was + successful. + +Connection options used: + +:nick -- The nick to use to register with the server +:user -- The user name to use +:mode -- The initial mode to use; an integer. See RFC 2812 for + the meaning. +:realname -- The realname to use for the registration +:pass -- The server password to send +:cap-req -- CAP protocol capabilities to request, if available +:sasl-username -- The SASL username to send, if sasl is available +:sasl-password -- The SASL password to send, if sasl is available + +Connection options set: + +:connection-state -- One of nil, connected, registered, disconnected + See `irc-connection-state' for an interface to this. +:cap-supported-p -- Non-nil if the server supports the CAP protocol +:cap-ack -- The list of active capabilities negotiated with the server" + (irc-handler-add table "conn.connected" + #'irc-handle-registration--connected) + (irc-handler-add table "conn.disconnected" + #'irc-handle-registration--disconnected) + (irc-handler-add table "001" ;; RPL_WELCOME + #'irc-handle-registration--rpl-welcome) + (irc-handler-add table "CAP" + #'irc-handle-registration--cap) + (irc-handler-add table "AUTHENTICATE" + #'irc-handle-registration--authenticate) + (irc-handler-add table "900" ;; RPL_LOGGEDIN + #'irc-handle-registration--logged-in)) + +(defun irc-handle-registration--connected (conn _event) + (irc-connection-put conn :connection-state 'connected) + (when (irc-connection-get conn :cap-req) + (irc-send-CAP conn "LS")) + (let ((password (irc-connection-get conn :pass))) + (when password + (irc-send-PASS conn password))) + (irc-send-NICK conn (irc-connection-get conn :nick)) + (irc-send-USER conn + (irc-connection-get conn :user) + (irc-connection-get conn :mode) + (irc-connection-get conn :realname))) + +(defun irc-handle-registration--disconnected (conn _event) + (irc-connection-put conn :connection-state 'disconnected)) + +(defun irc-handle-registration--rpl-welcome (conn _event _sender target + &rest ignored) + (irc-connection-put conn :connection-state 'registered) + (irc-event-emit conn "irc.registered" target)) + +(defun irc-handle-registration--cap (conn _event _sender _target + subcommand arg) + (cond + ((equal subcommand "LS") + (let ((supported (split-string arg)) + (wanted nil)) + (dolist (cap (irc-connection-get conn :cap-req)) + (when (member cap supported) + (setq wanted (append wanted (list cap))))) + (if wanted + (irc-send-CAP conn "REQ" (mapconcat #'identity wanted " ")) + (irc-send-CAP conn "END")))) + ((equal subcommand "ACK") + (let ((acked (split-string arg))) + (irc-connection-put conn :cap-ack acked) + (if (and (member "sasl" acked) + (irc-connection-get conn :sasl-username) + (irc-connection-get conn :sasl-password)) + (irc-send-AUTHENTICATE conn "PLAIN") + (irc-send-CAP conn "END")))) + (t + (message "Unknown CAP response from server: %s %s" subcommand arg)))) + +(defun irc-handle-registration--authenticate (conn _event _sender arg) + (if (equal arg "+") + (let ((username (irc-connection-get conn :sasl-username)) + (password (irc-connection-get conn :sasl-password))) + (irc-send-AUTHENTICATE conn (base64-encode-string + (format "%s\x00%s\x00%s" + username username password))) + (irc-send-CAP conn "END")) + (message "Unknown AUTHENTICATE response from server: %s" arg))) + +(defun irc-handle-registration--logged-in (conn _event _sender _target + userhost account _message) + (irc-event-emit conn "sasl.login" userhost account)) + +(defun irc-connection-state (conn) + "connecting connected registered disconnected" + (let ((state (irc-connection-get conn :connection-state))) + (if (null state) + 'connecting + state))) + +;;;;;;;;;;;;;;;;;;;;;; +;;; Handler: Ping-Pong + +(defun irc-handle-ping-pong (table) + "Add command handlers to respond to PING requests." + (irc-handler-add table "PING" #'irc-handle-ping-pong--ping)) + +(defun irc-handle-ping-pong--ping (conn _event _sender argument) + (irc-send-PONG conn argument)) + +;;;;;;;;;;;;;;;;;;;;; +;;; Handler: ISUPPORT + +(defun irc-handle-isupport (table) + "Add command handlers to track 005 RPL_ISUPPORT capabilities." + (irc-handler-add table "005" #'irc-handle-isupport--005)) + +(defun irc-handle-isupport--005 (conn _event _sender _target &rest args) + (irc-connection-put + conn :isupport + (append (irc-connection-get conn :isupport) + (irc-handle-isupport--capabilities-to-alist args)))) + +(defun irc-handle-isupport--capabilities-to-alist (capabilities) + (mapcar (lambda (cap) + (if (string-match "\\`\\([^=]+\\)=\\(.*\\)\\'" cap) + (cons (match-string 1 cap) + (match-string 2 cap)) + (cons cap t))) + capabilities)) + +(defun irc-isupport (conn capability) + "Return the value of CAPABILITY of CONN. + +These capabilities are set when the server sends a 005 +RPL_ISUPPORT message. The return value is either the value of the +capability, or t if it is a boolean capability that is present. +If the capability is not present, the return value is nil." + (cdr (assoc capability + (irc-connection-get conn :isupport)))) + +(defun irc-string-equal-p (conn s1 s2) + "Compare S1 to S2 case-insensitively. + +What case means is defined by the server of CONN." + (equal (irc-isupport--case-fold conn s1) + (irc-isupport--case-fold conn s2))) + +(defvar irc-isupport--ascii-table + (let ((table (make-string 128 0)) + (char 0)) + (while (<= char 127) + (if (and (<= ?A char) + (<= char ?Z)) + (aset table char (+ char (- ?a ?A))) + (aset table char char)) + (setq char (1+ char))) + table) + "A case mapping table for the ascii CASEMAPPING.") + +(defvar irc-isupport--rfc1459-table + (let ((table (concat irc-isupport--ascii-table))) ; copy string + (aset table ?\[ ?\{) + (aset table ?\] ?\}) + (aset table ?\\ ?\|) + (aset table ?^ ?\~) + table) + "A case mapping table for the rfc1459 CASEMAPPING.") + +(defvar irc-isupport--rfc1459-strict-table + (let ((table (concat irc-isupport--ascii-table))) ; copy string + (aset table ?\[ ?\{) + (aset table ?\] ?\}) + (aset table ?\\ ?\|) + table) + "A case mapping table for the rfc1459-strict CASEMAPPING.") + +(defun irc-isupport--case-fold (conn s) + "Translate S to be a lower-case. + +This uses the case mapping defined by the IRC server for CONN." + (with-temp-buffer + (insert s) + (let ((mapping (or (irc-isupport conn "CASEMAPPING") + "rfc1459"))) + (cond + ((equal mapping "rfc1459") + (translate-region (point-min) + (point-max) + irc-isupport--rfc1459-table)) + ((equal mapping "ascii") + (translate-region (point-min) + (point-max) + irc-isupport--ascii-table)) + ((equal mapping "rfc1459-strict") + (translate-region (point-min) + (point-max) + irc-isupport--rfc1459-strict-table)))) + (buffer-string))) + +(defun irc-channel-name-p (conn string) + "True iff STRING is a valid channel name for CONN. + +This depends on the CHANTYPES setting set by the server of CONN." + (let ((chantypes (string-to-list + (or (irc-isupport conn "CHANTYPES") + "#")))) + (if (and (> (length string) 0) + (member (aref string 0) chantypes)) + t + nil))) + +(defun irc-nick-without-prefix (conn nick) + "Return NICK without any mode prefixes. + +For example, a user with op status might be shown as @Nick. This +function would return Nick without the prefix. This uses the 005 +RPL_ISUPPORT setting of PREFIX set by the IRC server for CONN." + (let ((prefixes (irc-connection-get conn :nick-prefixes))) + (when (not prefixes) + (let ((prefix-string (or (irc-isupport conn "PREFIX") + "(qaohv)~&@%+"))) + (setq prefixes (string-to-list + (if (string-match "(.*)\\(.*\\)" prefix-string) + (match-string 1 prefix-string) + "~&@%+"))) + (irc-connection-put conn :nick-prefixes prefixes))) + (while (and (> (length nick) 0) + (member (aref nick 0) prefixes)) + (setq nick (substring nick 1))) + nick)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Handler: Initial nick acquisition + +(defun irc-handle-initial-nick-acquisition (table) + "Track the current nick of the user. + +Connection options used: + +:nick-alternatives -- A list of nicks to try if the first attempt + does not succeed." + (irc-handler-add table "432" ;; ERR_ERRONEUSNICKNAME + #'irc-handle-initial-nick-acquisition--get-initial-nick) + (irc-handler-add table "433" ;; ERR_NICKNAMEINUSE + #'irc-handle-initial-nick-acquisition--get-initial-nick) + (irc-handler-add table "437" ;; ERR_UNAVAILRESOURCE + #'irc-handle-initial-nick-acquisition--get-initial-nick)) + +(defun irc-handle-initial-nick-acquisition--get-initial-nick + (conn _event _sender current-nick _attempted-nick _reason) + (when (equal current-nick "*") + (let ((alternatives (irc-connection-get conn :nick-alternatives))) + (if (not alternatives) + (irc-send-NICK conn (irc-generate-nick)) + (irc-connection-put conn :nick-alternatives (cdr alternatives)) + (irc-send-NICK conn (car alternatives)))))) + +(defun irc-generate-nick () + "Return a random, valid IRC nick name. + +Valid nick names are at least (RFC 1459): + +<nick> ::= <letter> { <letter> | <number> | <special> } +<special> ::= '-' | '[' | ']' | '\' | '`' | '^' | '{' | '}'" + (let ((chars "abcdefghijklmnopqrstuvwxyz")) + (mapconcat (lambda (_) + (make-string 1 (aref chars (random (length chars))))) + (make-string 9 0) + ""))) + +;;;;;;;;;;;;;;;;; +;;; Handler: CTCP + +(defun irc-handle-ctcp (table) + "Add command handlers to TABLE to handle the CTCP protocol. + +Connection options used: + +:ctcp-version -- The response to a CTCP VERSION request. +:ctcp-clientinfo -- The response to a CTCP CLIENTINFO request. +:ctcp-source -- The response to a CTCP SOURCE request. + +Events emitted: + +\"irc.message\" sender target body -- A non-CTCP PRIVMSG +\"irc.notice\" sender target body -- A non-CTCP NOTICE +\"irc.ctcp\" sender target verb argument -- A CTCP request. ARGUMENT + can be nil if there was no argument, or the empty string if the + argument was empty. +\"irc.ctcpreply\" sender target verb argument -- A CTCP reply. + ARGUMENT is similar to above. +\"irc.ctcp.VERB\" sender target argument -- A CTCP request of + this specific type. +\"irc.ctcpreply.VERB\" sender target argument -- A CTCP reply of + this specific type." + (irc-handler-add table "PRIVMSG" + #'irc-handle-ctcp--privmsg) + (irc-handler-add table "irc.ctcp" + #'irc-handle-ctcp--ctcp) + (irc-handler-add table "NOTICE" + #'irc-handle-ctcp--notice) + (irc-handler-add table "irc.ctcpreply" + #'irc-handle-ctcp--ctcpreply) + (irc-handler-add table "irc.ctcp.VERSION" + #'irc-handle-ctcp--ctcp-version) + (irc-handler-add table "irc.ctcp.CLIENTINFO" + #'irc-handle-ctcp--ctcp-clientinfo) + (irc-handler-add table "irc.ctcp.SOURCE" + #'irc-handle-ctcp--ctcp-source) + (irc-handler-add table "irc.ctcp.PING" + #'irc-handle-ctcp--ctcp-ping) + (irc-handler-add table "irc.ctcp.TIME" + #'irc-handle-ctcp--ctcp-time) + ) + +(defun irc-handle-ctcp--privmsg (conn _event sender target body) + (if (string-match "\\`\x01\\([^ ]+\\)\\(?: \\(.*\\)\\)?\x01\\'" + body) + (irc-event-emit conn "irc.ctcp" sender target + (match-string 1 body) + (match-string 2 body)) + (irc-event-emit conn "irc.message" sender target body))) + +(defun irc-handle-ctcp--ctcp (conn _event sender target verb argument) + (irc-event-emit conn + (format "irc.ctcp.%s" (upcase verb)) + sender + target + argument)) + +(defun irc-handle-ctcp--notice (conn _event sender target body) + (if (string-match "\\`\x01\\([^ ]+\\)\\(?: \\(.*\\)\\)?\x01\\'" + body) + (irc-event-emit conn "irc.ctcpreply" sender target + (match-string 1 body) + (match-string 2 body)) + (irc-event-emit conn "irc.notice" sender target body))) + +(defun irc-handle-ctcp--ctcpreply (conn _event sender target verb argument) + (irc-event-emit conn + (format "irc.ctcpreply.%s" (upcase verb)) + sender + target + argument)) + +(defun irc-handle-ctcp--ctcp-version (conn _event sender _target _argument) + (let ((version (irc-connection-get conn :ctcp-version))) + (when version + (irc-send-ctcpreply conn + (irc-userstring-nick sender) + "VERSION" + version)))) + +(defun irc-handle-ctcp--ctcp-clientinfo (conn _event sender _target _argument) + (let ((clientinfo (irc-connection-get conn :ctcp-clientinfo))) + (when clientinfo + (irc-send-ctcpreply conn + (irc-userstring-nick sender) + "CLIENTINFO" + clientinfo)))) + +(defun irc-handle-ctcp--ctcp-source (conn _event sender _target _argument) + (let ((source (irc-connection-get conn :ctcp-source))) + (when source + (irc-send-ctcpreply conn + (irc-userstring-nick sender) + "SOURCE" + source)))) + +(defun irc-handle-ctcp--ctcp-ping (conn _event sender _target argument) + (when argument + (irc-send-ctcpreply conn + (irc-userstring-nick sender) + "PING" + argument))) + +(defun irc-handle-ctcp--ctcp-time (conn _event sender _target _argument) + (irc-send-ctcpreply conn + (irc-userstring-nick sender) + "TIME" + (current-time-string))) + +(defun irc-send-ctcp (conn target verb &optional argument) + "Send a CTCP VERB request to TARGET, optionally with ARGUMENT." + (irc-send-PRIVMSG conn + target + (format "\x01%s%s\x01" + verb + (if argument + (concat " " argument) + "")))) + +(defun irc-send-ctcpreply (conn target verb &optional argument) + "Send a CTCP VERB reply to TARGET, optionally with ARGUMENT." + (irc-send-raw conn + (irc--format-command "NOTICE" + target + (format "\x01%s%s\x01" + verb + (if argument + (concat " " argument) + ""))) + :drop)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Handler: State tracking + +(defun irc-handle-state-tracking (table) + "Add command handlers to TABLE to track the IRC state. + +Connection options used: + +:current-nick -- The current nick, or nil if not known/set yet. + +Use helper functions to access the information tracked by this +handler: + +- `irc-current-nick' +- `irc-current-nick-p' + +Events emitted: + +\"channel.quit\" sender channel reason -- A user quit IRC and + left this channel that way." + (irc-handler-add table "001" ;; RPL_WELCOME + #'irc-handle-state-tracking--rpl-welcome) + (irc-handler-add table "JOIN" + #'irc-handle-state-tracking--JOIN) + (irc-handler-add table "PART" + #'irc-handle-state-tracking--PART) + (irc-handler-add table "KICK" + #'irc-handle-state-tracking--KICK) + (irc-handler-add table "QUIT" + #'irc-handle-state-tracking--QUIT) + (irc-handler-add table "NICK" + #'irc-handle-state-tracking--NICK) + (irc-handler-add table "PRIVMSG" + #'irc-handle-state-tracking--PRIVMSG) + (irc-handler-add table "353" ;; RPL_NAMREPLY + #'irc-handle-state-tracking--rpl-namreply) + (irc-handler-add table "366" ;; RPL_ENDOFNAMES + #'irc-handle-state-tracking--rpl-endofnames) + + (irc-handler-add table "TOPIC" + #'irc-handle-state-tracking--TOPIC) + (irc-handler-add table "331" ;; RPL_NOTOPIC + #'irc-handle-state-tracking--rpl-notopic) + (irc-handler-add table "332" ;; RPL_TOPIC + #'irc-handle-state-tracking--rpl-topic) + ) + +(cl-defstruct irc-channel + name + topic + last-topic + folded-name + users + recent-users + receiving-names + connection) + +(defun irc-channel-from-name (conn name) + "Create a new IRC channel object on CONN, named NAME." + (make-irc-channel :name name + :folded-name (irc-isupport--case-fold conn name) + :users (make-hash-table :test 'equal) + :recent-users (make-hash-table :test 'equal) + :connection conn)) + +(defun irc-connection-channel (conn channel-name) + "Return the channel object for CHANNEL-NAME on CONN." + (let ((channel-table (irc--connection-channel-table conn)) + (folded-name (irc-isupport--case-fold conn channel-name))) + (gethash folded-name channel-table))) + +(defun irc-connection-channel-list (conn) + "Return the list of channel object on CONN." + (let ((channel-list nil)) + (maphash (lambda (_folded-name channel) + (push channel channel-list)) + (irc--connection-channel-table conn)) + channel-list)) + +(defun irc-connection-add-channel (conn channel-name) + "Add CHANNEL-NAME to the channel table of CONN." + (let* ((channel-table (irc--connection-channel-table conn)) + (channel (irc-channel-from-name conn channel-name)) + (folded-name (irc-channel-folded-name channel))) + (when (not (gethash folded-name channel-table)) + (puthash folded-name channel channel-table)))) + +(defun irc-connection-remove-channel (conn channel-name) + "Remove CHANNEL-NAME from the channel table of CONN." + (let* ((channel-table (irc--connection-channel-table conn)) + (folded-name (irc-isupport--case-fold conn channel-name))) + (remhash folded-name channel-table))) + +(defun irc-current-nick (conn) + "Return the current nick on IRC connection CONN, or nil if not set yet." + (irc-connection-get conn :current-nick)) + +(defun irc-current-nick-p (conn nick) + "Return t if NICK is our current nick on IRC connection CONN." + (let ((current-nick (irc-current-nick conn))) + (if (and (stringp nick) + (stringp current-nick)) + (irc-string-equal-p conn current-nick nick) + nil))) + +(defun irc--connection-channel-table (conn) + (let ((table (irc-connection-get conn :channel-table))) + (when (not table) + (setq table (make-hash-table :test 'equal)) + (irc-connection-put conn :channel-table table)) + table)) + +(cl-defstruct irc-user + nick + folded-nick + userhost + join-time + last-activity-time + part-time + connection) + +(defun irc-user-from-userstring (conn userstring) + "Create an irc-user struct on CONN from USERSTRING. + +USERSTRING should be a s tring of the form \"nick!user@host\"." + (let ((nick (irc-userstring-nick userstring))) + (make-irc-user :nick nick + :folded-nick (irc-isupport--case-fold conn nick) + :userhost (let ((nick-len (length nick))) + (if (>= nick-len (length userstring)) + nil + (substring userstring (1+ nick-len)))) + :connection conn))) + +(defun irc-channel-user (channel nick) + "Return a user named NICK on channel CHANNEL." + (let ((user-table (irc-channel-users channel)) + (folded-nick (irc-isupport--case-fold (irc-channel-connection channel) + nick))) + (gethash folded-nick user-table))) + +(defun irc-channel-recent-user (channel nick) + "Return a recent user named NICK on channel CHANNEL." + (let ((user-table (irc-channel-recent-users channel)) + (folded-nick (irc-isupport--case-fold (irc-channel-connection channel) + nick))) + (gethash folded-nick user-table))) + +(defun irc-channel-add-user (channel userstring) + "Add USER to CHANNEL." + (let* ((user-table (irc-channel-users channel)) + (user (irc-user-from-userstring (irc-channel-connection channel) + userstring)) + (folded-nick (irc-user-folded-nick user)) + (recent-user (irc-channel-recent-user channel (irc-user-nick user)))) + (when (not (gethash folded-nick user-table)) + (when (and recent-user + (equal (irc-user-userhost recent-user) + (irc-user-userhost user))) + (setf (irc-user-last-activity-time user) + (irc-user-last-activity-time recent-user))) + (puthash folded-nick user user-table) + user))) + +(defun irc-channel-remove-user (channel nick) + "Remove NICK from CHANNEL." + (let* ((user-table (irc-channel-users channel)) + (recent-user-table (irc-channel-recent-users channel)) + (folded-nick (irc-isupport--case-fold (irc-channel-connection channel) + nick)) + (user (gethash folded-nick user-table))) + (remhash folded-nick user-table) + (when user + (setf (irc-user-part-time user) (float-time)) + (puthash folded-nick user recent-user-table) + (maphash (lambda (folded-nick user) + (when (< (irc-user-part-time user) + (- (float-time) + (* 60 60))) + (remhash folded-nick recent-user-table))) + recent-user-table)))) + +(defun irc-channel-rename-user (channel oldnick newnick) + "Update CHANNEL so that the user with nick OLDNICK now has nick NEWNICK." + (let ((user-table (irc-channel-users channel)) + (user (irc-channel-user channel oldnick)) + (newnick-folded (irc-isupport--case-fold + (irc-channel-connection channel) + newnick)) + (recent-user (irc-channel-recent-user channel newnick))) + (when user + (when (and recent-user + (equal (irc-user-userhost recent-user) + (irc-user-userhost user))) + (setf (irc-user-last-activity-time user) + (irc-user-last-activity-time recent-user))) + (remhash (irc-user-folded-nick user) user-table) + (setf (irc-user-nick user) newnick) + (setf (irc-user-folded-nick user) newnick-folded) + (puthash (irc-user-folded-nick user) user user-table)))) + +(defun irc-handle-state-tracking--rpl-welcome (conn _event _sender target + &rest ignored) + (irc-connection-put conn :current-nick target)) + +(defun irc-handle-state-tracking--JOIN (conn _event sender target + &optional _account _realname) + (let ((nick (irc-userstring-nick sender))) + (cond + ((irc-current-nick-p conn nick) + (irc-connection-add-channel conn target)) + (t + (let ((channel (irc-connection-channel conn target))) + (when channel + (let ((user (irc-channel-add-user channel sender))) + (when user + (setf (irc-user-join-time user) (float-time)))))))))) + +(defun irc-handle-state-tracking--PART (conn _event sender target + &optional _reason) + (let ((nick (irc-userstring-nick sender))) + (cond + ((irc-current-nick-p conn nick) + (irc-connection-remove-channel conn target)) + (t + (let ((channel (irc-connection-channel conn target))) + (when channel + (irc-channel-remove-user channel nick))))))) + +(defun irc-handle-state-tracking--KICK (conn _event _sender target nick + &optional _reason) + (cond + ((irc-current-nick-p conn nick) + (irc-connection-remove-channel conn target)) + (t + (let ((channel (irc-connection-channel conn target))) + (when channel + (irc-channel-remove-user channel nick)))))) + +(defun irc-handle-state-tracking--QUIT (conn _event sender + &optional reason) + (let ((nick (irc-userstring-nick sender))) + (if (irc-current-nick-p conn nick) + (dolist (channel (irc-connection-channel-list conn)) + (irc-connection-remove-channel conn + (irc-channel-folded-name channel))) + (dolist (channel (irc-connection-channel-list conn)) + (when (irc-channel-user channel nick) + (irc-event-emit conn "channel.quit" + sender + (irc-channel-name channel) + reason)) + (irc-channel-remove-user channel nick))))) + +(defun irc-handle-state-tracking--NICK (conn _event sender new-nick) + ;; Update channels + (let ((nick (irc-userstring-nick sender))) + (dolist (channel (irc-connection-channel-list conn)) + (irc-channel-rename-user channel nick new-nick))) + ;; Update our own nick + (when (irc-current-nick-p conn (irc-userstring-nick sender)) + (irc-connection-put conn :current-nick new-nick))) + +(defun irc-handle-state-tracking--PRIVMSG (conn _event sender target _message) + (let ((channel (irc-connection-channel conn target)) + (nick (irc-userstring-nick sender))) + (when channel + (let ((user (irc-channel-user channel nick))) + (when user + (setf (irc-user-last-activity-time user) (float-time))))))) + +(defun irc-handle-state-tracking--rpl-namreply + (conn _event _sender _current-nick _channel-type channel-name nicks) + (let ((channel (irc-connection-channel conn channel-name))) + (when channel + (setf (irc-channel-receiving-names channel) + (append (irc-channel-receiving-names channel) + (mapcar (lambda (nick) + (irc-nick-without-prefix + conn + (string-trim nick))) + (split-string nicks))))))) + +(defun irc-handle-state-tracking--rpl-endofnames + (conn _event _sender _current-nick channel-name _description) + (let ((channel (irc-connection-channel conn channel-name))) + (when channel + (irc-channel--synchronize-nicks channel + (irc-channel-receiving-names channel)) + (setf (irc-channel-receiving-names channel) nil)))) + +(defun irc-channel--synchronize-nicks (channel nicks) + "Update the user list of CHANNEL to match NICKS." + (let ((have (irc-channel-users channel)) + (want (make-hash-table :test 'equal))) + (dolist (nick nicks) + (puthash (irc-isupport--case-fold (irc-channel-connection channel) + nick) + nick + want)) + (maphash (lambda (nick-folded user) + (when (not (gethash nick-folded want)) + (irc-channel-remove-user channel + (irc-user-nick user)))) + have) + (maphash (lambda (_nick-folded nick) + (irc-channel-add-user channel nick)) + want))) + +(defun irc-handle-state-tracking--TOPIC (conn _event _sender channel new-topic) + (let ((channel (irc-connection-channel conn channel))) + (when channel + (setf (irc-channel-last-topic channel) + (irc-channel-topic channel)) + (setf (irc-channel-topic channel) new-topic)))) + +(defun irc-handle-state-tracking--rpl-notopic (conn _event _sender + _current-nick channel + _no-topic-desc) + (let ((channel (irc-connection-channel conn channel))) + (when channel + (setf (irc-channel-topic channel) nil)))) + +(defun irc-handle-state-tracking--rpl-topic (conn _event _sender _current-nick + channel topic) + (let ((channel (irc-connection-channel conn channel))) + (when channel + (setf (irc-channel-topic channel) topic)))) + +;;;;;;;;;;;;;;,;;;;;; +;;; Handler: NickServ + +(defun irc-handle-nickserv (table) + "Add command handlers to TABLE to deal with NickServ. + +Connection options used: + +:nickserv-nick -- The nick to register as + +:nickserv-password -- The password for nickserv; can be a function and + is then called with the IRC connection as its sole argument + +:nickserv-mask -- A regular expression matching the correct NickServ's + nick!user@host string to avoid fakes + +:nickserv-identify-challenge -- A regular expression matching the + challenge sent by NickServ to request identification + +:nickserv-identify-command -- The raw IRC command to send to identify; + expands {nick} and {password} when present + +:nickserv-identify-confirmation -- A regular expression matching the + confirmation message from NickServ after successful identification + +:nickserv-ghost-command -- The raw IRC comment to ghost your + original nick; expands {nick} and {password}. Set this to nil + to disable ghosting and nick regaining. + +:nickserv-ghost-confirmation -- A regular expression matching the + confirmation message that the nick was ghosted + +Events emitted: + +\"nickserv.identified\" -- We have successfully identified with nickserv. + +\"nickserv.ghosted\" -- We have ghosted a nick." + (irc-handler-add table "irc.registered" #'irc-handle-nickserv--registered) + (irc-handler-add table "NOTICE" #'irc-handle-nickserv--NOTICE) + (irc-handler-add table "PRIVMSG" #'irc-handle-nickserv--NOTICE) + (irc-handler-add table "NICK" #'irc-handle-nickserv--NICK)) + +(defun irc-handle-nickserv--password (conn) + (let ((password (irc-connection-get conn :nickserv-password))) + (if (functionp password) + (funcall password conn) + password))) + +(defun irc-handle-nickserv--registered (conn _event current-nick) + (let ((ghost-command (irc-connection-get conn :nickserv-ghost-command)) + (wanted-nick (irc-connection-get conn :nickserv-nick)) + (password (irc-handle-nickserv--password conn))) + (when (and ghost-command + wanted-nick + password + (not (irc-string-equal-p conn current-nick wanted-nick))) + (irc-send-raw conn + (irc-format ghost-command + 'nick wanted-nick + 'password password))))) + +(defun irc-handle-nickserv--NOTICE (conn _event sender _target message) + (let ((nickserv-mask (irc-connection-get conn :nickserv-mask)) + identify-challenge identify-command identify-confirmation + ghost-confirmation + nickserv-nick nickserv-password) + (when (and nickserv-mask (string-match nickserv-mask sender)) + (setq identify-challenge + (irc-connection-get conn :nickserv-identify-challenge)) + (setq identify-command + (irc-connection-get conn :nickserv-identify-command)) + (setq identify-confirmation + (irc-connection-get conn :nickserv-identify-confirmation)) + (setq ghost-confirmation + (irc-connection-get conn :nickserv-ghost-confirmation)) + (setq nickserv-nick (irc-connection-get conn :nickserv-nick)) + (setq nickserv-password (irc-handle-nickserv--password conn)) + (cond + ;; Identify + ((and identify-challenge + identify-command + nickserv-nick + nickserv-password + (string-match identify-challenge message)) + (irc-send-raw conn + (irc-format identify-command + 'nick nickserv-nick + 'password nickserv-password))) + ;; Identification confirmed + ((and identify-confirmation + (string-match identify-confirmation message)) + (irc-event-emit conn "nickserv.identified")) + ;; Ghosting confirmed + ((and ghost-confirmation + (string-match ghost-confirmation message)) + (irc-event-emit conn "nickserv.ghosted") + (irc-connection-put conn :nickserv-regaining-nick t) + (when nickserv-nick + (irc-send-NICK conn nickserv-nick))))))) + +(defun irc-handle-nickserv--NICK (conn _event _sender new-nick) + (when (and (irc-connection-get conn :nickserv-regaining-nick) + (irc-string-equal-p conn new-nick + (irc-connection-get conn :nickserv-nick))) + (irc-connection-put conn :nickserv-regaining-nick nil) + (irc-event-emit conn "nickserv.regained"))) + +(defun irc-format (format &rest args) + "Return a formatted version of FORMAT, using substitutions from ARGS. + +The substitutions are identified by braces ('{' and '}')." + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (re-search-forward "{\\([^}]*\\)}" nil t) + (replace-match (format "%s" (plist-get args (intern (match-string 1)))) + t t)) + (buffer-string))) + +;;;;;;;;;;;;;;;;;;;;;; +;;; Handler: Auto-Join + +(defun irc-handle-auto-join (table) + "Add command handlers to TABLE to deal with NickServ. + +Connection options used: + +:auto-join-after-registration -- List of channels to join + immediately after registration with the server + +:auto-join-after-host-hiding -- List of channels to join + after our host was hidden + +:auto-join-after-nick-acquisition -- List of channels to join + after we gained our desired nick + +:auto-join-after-nickserv-identification -- List of channels + to join after we identified successfully with NickServ" + (irc-handler-add table "irc.registered" #'irc-handle-auto-join--registered) + (irc-handler-add table "396" ;; RPL_HOSTHIDDEN + #'irc-handle-auto-join--rpl-hosthidden) + (irc-handler-add table "nickserv.regained" + #'irc-handle-auto-join--nickserv-regained) + (irc-handler-add table "nickserv.identified" + #'irc-handle-auto-join--nickserv-identified) + (irc-handler-add table "sasl.login" + #'irc-handle-auto-join--sasl-login)) + +(defun irc-handle-auto-join--registered (conn _event _current-nick) + (dolist (channel (irc-connection-get conn :auto-join-after-registration)) + (irc-send-JOIN conn channel))) + +(defun irc-handle-auto-join--rpl-hosthidden (conn _event _sender _target _host + _description) + (dolist (channel (irc-connection-get conn :auto-join-after-host-hiding)) + (irc-send-JOIN conn channel))) + +(defun irc-handle-auto-join--nickserv-regained (conn _event) + (dolist (channel (irc-connection-get + conn :auto-join-after-nick-acquisition)) + (irc-send-JOIN conn channel))) + +(defun irc-handle-auto-join--nickserv-identified (conn event) + (dolist (channel (irc-connection-get + conn :auto-join-after-nickserv-identification)) + (irc-send-JOIN conn channel)) + (if (irc-string-equal-p conn + (irc-connection-get conn :nick) + (irc-connection-get conn :nickserv-nick)) + (irc-handle-auto-join--nickserv-regained conn event))) + +(defun irc-handle-auto-join--sasl-login (conn _event &rest ignored) + (dolist (channel (irc-connection-get + conn :auto-join-after-sasl-login)) + (irc-send-JOIN conn channel))) + +(provide 'irc) +;;; irc.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/irc.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/irc.elc new file mode 100644 index 000000000000..9c9cd1508ce8 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/irc.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lcs.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lcs.el new file mode 100644 index 000000000000..b5beb12ef145 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lcs.el @@ -0,0 +1,202 @@ +;;; lcs.el --- find out the longest common sequence + +;; Copyright (c) 2002-2003 by Alex Shinn, All rights reserved. +;; Copyright (c) 2002-2003 by Shiro Kawai, All rights reserved. +;; Copyright (c) 2006, 2012 by Jorgen Schaefer, All rights reserved. + +;; Authors: Alex Shinn, Shiro Kawai +;; Maintainer: Jorgen Schaefer <forcer@forcix.cx> +;; URL: https://github.com/jorgenschaefer/circe/wiki/lcs + +;; Redistribution and use in source and binary forms, with or without +;; modification, are permitted provided that the following conditions +;; are met: + +;; 1. Redistributions of source code must retain the above copyright +;; notice, this list of conditions and the following disclaimer. + +;; 2. Redistributions in binary form must reproduce the above copyright +;; notice, this list of conditions and the following disclaimer in the +;; documentation and/or other materials provided with the distribution. + +;; 3. Neither the name of the authors nor the names of its contributors +;; may be used to endorse or promote products derived from this +;; software without specific prior written permission. + +;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +;;; Commentary: + +;; lcs.el is a library for other Emacs Lisp programs not useful by +;; itself. + +;; This library provides functions to find the Longest Common Sequence +;; (LCS) of two sequences. This is used to create a unified diff of to +;; two lists. See `lcs-unified-diff' for a useful function to be +;; called. + +;; The code is more or less a literal translation of (part of) +;; Gauche's util/lcs.scm module to Emacs Lisp. + +;;; Code: + +(put 'lcs-for 'lisp-indent-function 4) +(defmacro lcs-for (var from to step &rest body) + "A simple FOR loop macro. +Count VAR from FROM to TO by stepsize STEP. Evaluate BODY in each +iteration." + (let ((sto (make-symbol "to")) + (sstep (make-symbol "step"))) + `(let ((,var ,from) + (,sto ,to) + (,sstep ,step)) + (while (<= ,var ,sto) + (progn + ,@body) + (setq ,var (+ ,var ,sstep)))))) + +(defun lcs-split-at (lis pos) + "Return a cons cell of the first POS elements of LIS and the rest." + (let ((head nil)) + (while (> pos 0) + (setq head (cons (car lis) + head) + pos (- pos 1) + lis (cdr lis))) + (cons (reverse head) + lis))) + +(defun lcs-finish (M+N V_l vl V_r vr) + "Finalize the LCS algorithm. +Should be used only by `lcs-with-positions'." + (let ((maxl 0) + (r '())) + (lcs-for i (- M+N) M+N 1 + (when (> (funcall vl i) + maxl) + (setq maxl (funcall vl i) + r (funcall vr i)))) + (list maxl (reverse r)))) + +(defun lcs-with-positions (a-ls b-ls &optional equalp) + "Return the longest common subsequence (LCS) of A-LS and B-LS. +EQUALP can be any procedure which returns non-nil when two +elements should be considered equal." + (let* ((A (vconcat a-ls)) + (B (vconcat b-ls)) + (N (length A)) + (M (length B)) + (M+N (+ M N)) + (V_d (make-vector (+ 1 (* 2 M+N)) + 0)) + (V_r (make-vector (+ 1 (* 2 M+N)) + nil)) + (V_l (make-vector (+ 1 (* 2 M+N)) + 0)) + (vd (lambda (i &optional x) + (if x + (aset V_d (+ i M+N) x) + (aref V_d (+ i M+N))))) + (vr (lambda (i &optional x) + (if x + (aset V_r (+ i M+N) x) + (aref V_r (+ i M+N))))) + (vl (lambda (i &optional x) + (if x + (aset V_l (+ i M+N) x) + (aref V_l (+ i M+N)))))) + (when (not equalp) + (setq equalp 'equal)) + (catch 'return + (if (= M+N 0) + (throw 'return '(0 ())) + (lcs-for d 0 M+N 1 + (lcs-for k (- d) d 2 + (let ((x nil) + (y nil) + (l nil) + (r nil)) + (if (or (= k (- d)) + (and (not (= k d)) + (< (funcall vd (- k 1)) + (funcall vd (+ k 1))))) + (setq x (funcall vd (+ k 1)) + l (funcall vl (+ k 1)) + r (funcall vr (+ k 1))) + (setq x (+ 1 (funcall vd (- k 1))) + l (funcall vl (- k 1)) + r (funcall vr (- k 1)))) + (setq y (- x k)) + (while (and (< x N) + (< y M) + (funcall equalp (aref A x) (aref B y))) + (setq r (cons (list (aref A x) x y) + r) + x (+ x 1) + y (+ y 1) + l (+ l 1))) + (funcall vd k x) + (funcall vr k r) + (funcall vl k l) + (when (and (>= x N) + (>= y M)) + (throw 'return(lcs-finish M+N V_l vl V_r vr))))))) + (error "Can't happen")))) + +(defun lcs-unified-diff (a b &optional equalp) + "Return a unified diff of the lists A and B. +EQUALP should can be a procedure that returns non-nil when two +elements of A and B should be considered equal. It's `equal' by +default." + (let ((common (cadr (lcs-with-positions a b equalp))) + (a a) + (a-pos 0) + (b b) + (b-pos 0) + (diff '())) + (while common + (let* ((elt (car common)) + (a-off (nth 1 elt)) + (a-skip (- a-off a-pos)) + (b-off (nth 2 elt)) + (b-skip (- b-off b-pos)) + (a-split (lcs-split-at a a-skip)) + (a-head (car a-split)) + (a-tail (cdr a-split)) + (b-split (lcs-split-at b b-skip)) + (b-head (car b-split)) + (b-tail (cdr b-split))) + (setq diff (append diff + (mapcar (lambda (a) + `(- ,a)) + a-head) + (mapcar (lambda (b) + `(+ ,b)) + b-head) + `((! ,(car elt)))) + + common (cdr common) + a (cdr a-tail) + a-pos (+ a-off 1) + b (cdr b-tail) + b-pos (+ b-off 1)))) + (append diff + (mapcar (lambda (a) + `(- ,a)) + a) + (mapcar (lambda (b) + `(+ ,b)) + b)))) + +(provide 'lcs) +;;; lcs.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lcs.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lcs.elc new file mode 100644 index 000000000000..2db8b77a4ccd --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lcs.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-autopaste.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-autopaste.el new file mode 100644 index 000000000000..7582839c268d --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-autopaste.el @@ -0,0 +1,115 @@ +;;; lui-autopaste.el --- Extension for lui for long text input + +;; Copyright (C) 2012 Jorgen Schaefer <forcer@forcix.cx> + +;; Author: Jorgen Schaefer <forcer@forcix.cx> + +;; This file is part of Lui. + +;; 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 extension for lui will intercept long input and replace it by +;; an URL to a paste service. + +;; What is considered "long" is defined by `lui-autopaste-lines'. You +;; can configure which paste service to use by changing +;; `lui-autopaste-function'. + +;; Run `enable-lui-autopaste' to enable this. + +;;; Code: + +(defgroup lui-autopaste nil + "The Lui autopaste extension." + :prefix "lui-autopaste-" + :group 'lui) + +(defcustom lui-autopaste-lines 3 + "Starting at this number of lines, Lui will ask to paste the input." + :type 'integer + :group 'lui-autopaste) + +(defcustom lui-autopaste-function 'lui-autopaste-service-ixio + "Which paste service to use. + +This function will be called with some text as its only argument, +and is expected to return an URL to view the contents." + :type '(choice (const :tag "ix.io" lui-autopaste-service-ixio) + (const :tag "ptpb.pw" lui-autopaste-service-ptpb-pw)) + :group 'lui-autopaste) + +;;;###autoload +(defun enable-lui-autopaste () + "Enable the lui autopaste feature. + +If you enter more than `lui-autopaste-lines' at once, Lui will +ask if you would prefer to use a paste service instead. If you +agree, Lui will paste your input to `lui-autopaste-function' and +replace it with the resulting URL." + (interactive) + (add-hook 'lui-pre-input-hook 'lui-autopaste)) + +;;;###autoload +(defun disable-lui-autopaste () + "Disable the lui autopaste feature." + (interactive) + (remove-hook 'lui-pre-input-hook 'lui-autopaste)) + +(defun lui-autopaste () + "Check if the lui input is too large. If so, paste it instead." + (when (and (>= (count-lines (point-min) (point-max)) + lui-autopaste-lines) + (y-or-n-p "That's pretty long, would you like to use a paste service instead? ")) + (let ((url (funcall lui-autopaste-function + (buffer-substring (point-min) + (point-max))))) + (delete-region (point-min) (point-max)) + (insert url)))) + +(defun lui-autopaste-service-ptpb-pw (text) + "Paste TEXT to ptpb.pw and return the paste url." + (let ((url-request-method "POST") + (url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded"))) + (url-request-data (format "c=%s" (url-hexify-string text))) + (url-http-attempt-keepalives nil)) + (let ((buf (url-retrieve-synchronously "https://ptpb.pw/"))) + (unwind-protect + (with-current-buffer buf + (goto-char (point-min)) + (if (re-search-forward "^url: \\(.*\\)" nil t) + (match-string 1) + (error "Error during pasting to ptpb.pw"))) + (kill-buffer buf))))) + +(defun lui-autopaste-service-ixio (text) + "Paste TEXT to ix.io and return the paste url." + (let ((url-request-method "POST") + (url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded"))) + (url-request-data (format "f:1=%s" (url-hexify-string text))) + (url-http-attempt-keepalives nil)) + (let ((buf (url-retrieve-synchronously "http://ix.io/"))) + (unwind-protect + (with-current-buffer buf + (goto-char (point-min)) + (if (re-search-forward "\n\n" nil t) + (buffer-substring (point) (point-at-eol)) + (error "Error during pasting to ix.io"))) + (kill-buffer buf))))) + +(provide 'lui-autopaste) +;;; lui-autopaste.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-autopaste.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-autopaste.elc new file mode 100644 index 000000000000..bbef287ff911 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-autopaste.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-format.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-format.el new file mode 100644 index 000000000000..68cc0ff000a0 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-format.el @@ -0,0 +1,198 @@ +;;; lui-format.el --- A formatting function for use with Lui + +;; Copyright (C) 2005, 2012 Jorgen Schaefer + +;; Author: Jorgen Schaefer <forcer@forcix.cx> + +;; This file is part of Lui. + +;; 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: + +;; An improved formatting function using named parameters. +;; +;; See the docstring of `lui-format' for more details. +;; +;; Most of the design is borrowed from Python's string.format. + +;;; Code: + +(require 'lui) + +(defun lui-display (format not-tracked-p &rest keywords) + "Display a formatted string in the current Lui interface. + +The string is formatted using FORMAT and `lui-format'. + +If NOT-TRACKED-P is given, the inserted string won't trigger +tracking. See `lui-insert' for a description. + +KEYWORDS are the keyword arguments passed to `lui-format'. + +See `lui-format' for a full description of the arguments." + (lui-insert (lui-format format keywords) + not-tracked-p)) + +(defun lui-format (format &rest keywords) + "Display FORMAT formatted with KEYWORDS. +FORMAT should be a symbol whose value is taken. If the value is a +procedure, the keyword list is passed as a single argument to it, +and it should return the formatted string. If the value is a +string, it is formatted according to the rules below. + +KEYWORDS is a plist of keywords and strings, or symbols and +strings. They are used as format arguments. + +The string is taken verbatim, unless there is are opening or +closing braces. + +Double opening or closing braces are replaced by single +occurrences of those characters. Otherwise, the contents between +opening and closing braces is a format description and replaced +by a formatted string. + +The string between opening and closing braces is taken as a name +of a keyword argument, and replaced by that argument's value. If +there is a colon in the string, the keyword name is the part +before the colon. The part after the colon is used to format the +argument using standard `format' + +Example: + + (lui-format \"Hello {foo:.1f}\" :foo 3.1415) + +is equivalent to + + (format \"Hello %.1f\" 3.1415) + +If the name is either a number, a number followed by a dash, or +two numbers with a dash in between them, this is taken as a +special name that is looked up in the list given using the list +argument to the :indexed-args keyword. + +{1} refers to the second element (element 1) +{1-} refers to the second and all following elements +{1-3} refers to the second through fourth element + +If more than one element is selected, the elements are separated +by a single space character. + +All named arguments receive a property of `lui-format-argument' +with the respective name as value. The whole string receives a +`lui-format' property with FORMAT as a value, and a +`lui-keywords' argument with KEYWORDS as a value." + ;; If it's only a single argument, that argument is a list. + (when (not (cdr keywords)) + (setq keywords (car keywords))) + (cond + ((functionp format) + (apply format keywords)) + ((and (symbolp format) + (functionp (symbol-value format))) + (apply (symbol-value format) keywords)) + (t + (let* ((format-string (if (symbolp format) + (symbol-value format) + format)) + (plist (mapcar (lambda (entry) + (if (keywordp entry) + ;; Keyword -> symbol + (intern (substring (symbol-name entry) + 1)) + entry)) + keywords))) + (propertize (lui-format-internal format-string plist) + 'lui-format format + 'lui-keywords keywords))))) + +(defun lui-format-internal (fmt keywords) + "Internal function for `lui-format'. + +FMT is the format string and KEYWORDS is the symbol-based plist. + +See `lui-format'." + (with-temp-buffer + (insert fmt) + (goto-char (point-min)) + (while (re-search-forward "{{\\|}}\\|{\\([^}]*\\)}" nil t) + (cond + ((string-equal (match-string 0) "3.1") + (replace-match "{")) + ((string-equal (match-string 0) "}}") + (replace-match "}")) + (t ;; (match-string 1) + (replace-match (save-match-data + (lui-format-single (match-string 1) keywords)) + t t)))) + (buffer-string))) + +(defun lui-format-single (specifier keywords) + "Format a single braced SPECIFIER according to KEYWORDS. +See `lui-format' for details. + +This adds `lui-format-argument' as necessary." + (let* ((split (split-string specifier ":")) + (identifier (car split)) + (format (cadr split))) + (when (not format) + (setq format "s")) + (propertize (format (concat "%" format) + (lui-format-lookup identifier keywords)) + 'lui-format-argument (intern identifier)))) + +(defun lui-format-lookup (identifier keywords) + "Lookup the format IDENTIFIER in KEYWORDS. + +See `lui-format' for details." + (cond + ((string-match "^\\([0-9]+\\)\\(-\\([0-9]+\\)?\\)?$" identifier) + (let ((from (match-string 1 identifier)) + (rangep (match-string 2 identifier)) + (to (match-string 3 identifier)) + (indexed-args (plist-get keywords 'indexed-args))) + (if rangep + (mapconcat (lambda (element) + (if (stringp element) + element + (format "%s" element))) + (lui-sublist indexed-args + (string-to-number from) + (when to (string-to-number to))) + " ") + (or (nth (string-to-number from) + indexed-args) + "")))) + (t + (or (plist-get keywords (intern identifier)) + (error "Unknown keyword argument %S" identifier))))) + +(defun lui-sublist (list from &optional to) + "Return the sublist from LIST starting at FROM and ending at TO." + (if (not to) + (nthcdr from list) + (let ((from-list (nthcdr from list)) + (i (- to from)) + (to-list nil)) + (while (>= i 0) + (when (null from-list) + (error "Argument out of range: %S" to)) + (setq to-list (cons (car from-list) + to-list) + i (- i 1) + from-list (cdr from-list))) + (nreverse to-list)))) + +(provide 'lui-format) +;;; lui-format.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-format.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-format.elc new file mode 100644 index 000000000000..6d94859e5f85 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-format.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el new file mode 100644 index 000000000000..9b16ead2f953 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.el @@ -0,0 +1,182 @@ +;;; lui-irc-colors.el --- Add IRC color support to LUI + +;; Copyright (C) 2005 Jorgen Schaefer + +;; Author: Jorgen Schaefer <forcer@forcix.cx> + +;; This file is part of Lui. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This tells LUI how to display IRC colors: +;; ^B - Bold +;; ^_ - Underline +;; ^V - Inverse +;; ^] - Italic +;; ^O - Return to normal +;; ^C1,2 - Colors + +;; The colors are documented at http://www.mirc.co.uk/help/color.txt + +;;; Code: + +(require 'lui) + +(defgroup lui-irc-colors nil + "LUI IRC colors faces." + :group 'circe) + +(defface lui-irc-colors-inverse-face + '((t (:inverse-video t))) + "Face used for inverse video." + :group 'lui-irc-colors) + +(defun lui-irc-defface (face property on-dark on-light rest doc) + (custom-declare-face + face + `((((type graphic) (class color) (background dark)) + (,property ,on-dark)) + (((type graphic) (class color) (background light)) + (,property ,on-light)) + (t (,property ,rest))) + doc + :group 'lui-irc-colors)) + +(defun lui-irc-defface-pair (number on-dark on-light rest name) + (lui-irc-defface + (intern (format "lui-irc-colors-fg-%d-face" number)) + :foreground + on-dark on-light rest + (concat "Face used for foreground IRC color " + (number-to-string number) " (" name ").")) + (lui-irc-defface + (intern (format "lui-irc-colors-bg-%d-face" number)) + :background + on-light on-dark rest + (concat "Face used for background IRC color " + (number-to-string number) " (" name ")."))) + +(defun lui-irc-defface-bulk (colors) + (dotimes (n (length colors)) + (apply 'lui-irc-defface-pair n (nth n colors)))) + +(lui-irc-defface-bulk + '(("#ffffff" "#585858" "white" "white") + ("#a5a5a5" "#000000" "black" "black") + ("#9b9bff" "#0000ff" "blue4" "blue") + ("#40eb51" "#006600" "green4" "green") + ("#ff9696" "#b60000" "red" "red") + ("#d19999" "#8f3d3d" "red4" "brown") + ("#d68fff" "#9c009c" "magenta4" "purple") + ("#ffb812" "#7a4f00" "yellow4" "orange") + ("#ffff00" "#5c5c00" "yellow" "yellow") + ("#80ff95" "#286338" "green" "light green") + ("#00b8b8" "#006078" "cyan4" "teal") + ("#00ffff" "#006363" "cyan" "light cyan") + ("#a8aeff" "#3f568c" "blue" "light blue") + ("#ff8bff" "#853885" "magenta" "pink") + ("#cfcfcf" "#171717" "dimgray" "grey") + ("#e6e6e6" "#303030" "gray" "light grey"))) + +(defvar lui-irc-colors-regex + "\\(\x02\\|\x1F\\|\x16\\|\x1D\\|\x0F\\|\x03\\)" + "A regular expression matching IRC control codes.") + +;;;###autoload +(defun enable-lui-irc-colors () + "Enable IRC color interpretation for Lui." + (interactive) + (add-hook 'lui-pre-output-hook 'lui-irc-colors)) + +(defun disable-lui-irc-colors () + "Disable IRC color interpretation for Lui." + (interactive) + (remove-hook 'lui-pre-output-hook 'lui-irc-colors)) + +(defun lui-irc-colors () + "Add color faces for IRC colors. +This is an appropriate function for `lui-pre-output-hook'." + (goto-char (point-min)) + (let ((start (point)) + (boldp nil) + (inversep nil) + (italicp nil) + (underlinep nil) + (fg nil) + (bg nil)) + (while (re-search-forward lui-irc-colors-regex nil t) + (lui-irc-propertize start (point) + boldp inversep italicp underlinep + fg bg) + (let ((code (match-string 1))) + (replace-match "") + (setq start (point)) + (cond + ((string= code "") + (setq boldp (not boldp))) + ((string= code "") + (setq inversep (not inversep))) + ((string= code " ") + (setq italicp (not italicp))) + ((string= code " ") + (setq underlinep (not underlinep))) + ((string= code "") + (setq boldp nil + inversep nil + italicp nil + underlinep nil + fg nil + bg nil)) + ((string= code "") + (if (looking-at "\\([0-9][0-9]?\\)\\(,\\([0-9][0-9]?\\)\\)?") + (progn + (setq fg (string-to-number (match-string 1)) + bg (if (match-string 2) + (string-to-number (match-string 3)) + bg)) + (setq fg (if (and fg (not (= fg 99))) (mod fg 16) nil) + bg (if (and bg (not (= bg 99))) (mod bg 16) nil)) + (replace-match "")) + (setq fg nil + bg nil))) + (t + (error "lui-irc-colors: Can't happen!"))))) + (lui-irc-propertize (point) (point-max) + boldp inversep italicp underlinep fg bg))) + +(defun lui-irc-propertize (start end boldp inversep italicp underlinep fg bg) + "Propertize the region between START and END." + (let ((faces (append (and boldp '(bold)) + (and inversep '(lui-irc-colors-inverse-face)) + (and italicp '(italic)) + (and underlinep '(underline)) + (and fg (list (lui-irc-colors-face 'fg fg))) + (and bg (list (lui-irc-colors-face 'bg bg)))))) + (when faces + (add-face-text-property start end faces)))) + +(defun lui-irc-colors-face (type n) + "Return a face appropriate for face number N. +TYPE is either 'fg or 'bg." + (if (and (<= 0 n) + (<= n 15)) + (intern (format "lui-irc-colors-%s-%s-face" type n)) + 'default-face)) + +(provide 'lui-irc-colors) +;;; lui-irc-colors.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.elc new file mode 100644 index 000000000000..658dc80d7b4b --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-irc-colors.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-logging.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-logging.el new file mode 100644 index 000000000000..d24e051f92ad --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-logging.el @@ -0,0 +1,201 @@ +;;; lui-logging.el --- Logging support for lui + +;; Copyright (C) 2006 Jorgen Schaefer, +;; 2012 Anthony Martinez + +;; Author: Anthony Martinez <pi+circe@pihost.us> + +;; This file is part of Lui. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This lui module enables logging. Lui applications can change the +;; values of `lui-logging-format-arguments' to provide further +;; possibilities of customizing `lui-logging-file-format' for users. + +;;; Code: + +(require 'lui-format) +(require 'url-util) + +(defgroup lui-logging nil + "Logging support." + :prefix "lui-logging-" + :group 'lui) + +(defcustom lui-logging-format "[%T] {text}" + "The format used for log file entries. +This is first passed through `format-time-string' and then through +`lui-format'. The following format strings exist: + + {text} - the text to be logged" + :type 'string + :group 'lui-logging) + +(defcustom lui-logging-directory "~/.logs" + "The directory where log files are stored." + :type 'directory + :group 'lui-logging) + +(defcustom lui-logging-file-format "{buffer}_%Y-%m-%d.txt" + "The format to be used for the log file name. +This is first passed through `format-time-string', and then +through `lui-format'. Possible lui format strings are: + + {buffer} - the buffer name where the logging happened. + +Lui applications can provide further format strings. See +`lui-logging-format-arguments' in the appropriate buffer." + :type 'string + :group 'lui-logging) + +(defcustom lui-logging-flush-delay 0 + "The number of seconds to delay writing newly-received messages +to disk. This can increase performance/decrease IO-wait at the +cost of a little bit of safety." + :type 'integer + :group 'lui-logging) + +(defvar lui-logging-format-arguments nil + "A list of arguments to be passed to `lui-format'. +This can be used to extend the formatting possibilities of the +file name for lui applications.") +(make-variable-buffer-local 'lui-logging-format-arguments) + +(defvar lui-logging-file-name-unreserved-chars + ;; All but '/' is fine actually, but also omit '%' because otherwise there's + ;; ambiguity between one introduced by encoding and a literal one. + '(?! ?\" ?# ?$ ?& ?` ?\( ?\) ?* ?+ ?,?: ?\; ?< ?= ?> ?? ?@?\[ ?\\ ?\] ?^ ?` + ?\{ ?| ?\}) + "A list of characters that should not be percent-encoded by +`url-hexify-string' while generating a logging file name.") + +(defvar lui-pending-logs + (make-hash-table :test 'equal) + "Storage for log messages awaiting write. It is structured as a +hash table mapping filenames to a list-of-strings, which serves as +a queue.") + +(defvar lui-logging-timer nil + "The timer used to flush lui-logged buffers") + +(defun lui-logging-delayed-p () + (> lui-logging-flush-delay 0)) + +(defun enable-lui-logging () + "Enable lui logging for this buffer. Also create the log +file's directory, should it not exist." + (interactive) + (add-hook 'lui-pre-output-hook 'lui-logging + nil t)) + +(defun disable-lui-logging () + "Disable lui logging for this buffer, and flush any pending +logs to disk." + (interactive) + (remove-hook 'lui-pre-output-hook 'lui-logging t) + (lui-logging-flush)) + +(defun enable-lui-logging-globally () + "Enable lui logging for all Lui buffers. + +This affects current as well as future buffers." + (interactive) + (add-hook 'lui-mode-hook 'enable-lui-logging) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when lui-input-marker + (enable-lui-logging))))) + +(defun disable-lui-logging-globally () + "Disable logging in all future Lui buffers. + +This affects current as well as future buffers." + (interactive) + (remove-hook 'lui-mode-hook 'enable-lui-logging) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when lui-input-marker + (disable-lui-logging))))) + +(defun lui-logging-file-name () + "Create the name of the log file based on `lui-logging-file-format'." + (let* ((time-formatted (format-time-string lui-logging-file-format)) + (buffer (let ((url-unreserved-chars + (append url-unreserved-chars + lui-logging-file-name-unreserved-chars)) + (downcased (downcase (buffer-name (current-buffer))))) + (url-hexify-string downcased))) + (filename (apply 'lui-format + time-formatted + :buffer buffer + lui-logging-format-arguments))) + (concat lui-logging-directory "/" filename))) + +(defun lui-logging-flush () + "Flush out the lui-logging queue, and clear the timer set by +`lui-logging'." + (maphash #'lui-logging-flush-file lui-pending-logs) + (clrhash lui-pending-logs) + (cancel-timer lui-logging-timer) + (setq lui-logging-timer nil)) + +(defun lui-logging-write-to-log (file-name content) + "Actually perform a write to the logfile." + (let ((coding-system-for-write 'raw-text) + (dir (file-name-directory file-name))) + (when (not (file-directory-p dir)) + (make-directory dir t)) + (write-region content nil file-name t 'nomessage))) + +(defun lui-logging-flush-file (file-name queue) + "Consume the logging queue and write the content to the log +file." + (let ((content (apply #'concat (nreverse queue)))) + (lui-logging-write-to-log file-name content))) + +(defun lui-logging-format-string (text) + "Generate a string to be either directly written or enqueued." + (substring-no-properties + (lui-format + (format-time-string lui-logging-format) + :text text))) + +(defun lui-logging-enqueue (file-name text) + "Given a filename, push text onto its queue, and tickle the +timer, if necessary." + (puthash file-name + (cons text (gethash file-name lui-pending-logs)) + lui-pending-logs) + (when (null lui-logging-timer) + (setq lui-logging-timer + (run-with-timer lui-logging-flush-delay nil + #'lui-logging-flush)))) + +(defun lui-logging () + "If output-queueing is enabled, append the to-be-logged string +to the output queue. Otherwise, write directly to the logfile. +This should be added to `lui-pre-output-hook' by way of +`enable-lui-logging'." + (let ((text (lui-logging-format-string (buffer-string)))) + (if (lui-logging-delayed-p) + (lui-logging-enqueue (lui-logging-file-name) text) + (lui-logging-write-to-log (lui-logging-file-name) text)))) + +(provide 'lui-logging) +;;; lui-logging.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-logging.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-logging.elc new file mode 100644 index 000000000000..2fa75d9c2a6f --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-logging.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-track-bar.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-track-bar.el new file mode 100644 index 000000000000..360ecf69d550 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-track-bar.el @@ -0,0 +1,110 @@ +;;; lui-track-bar.el --- Provides a bar to track the last read position + +;; Copyright (C) 2016 Vasilij Schneidermann <v.schneidermann@gmail.com> + +;; Author: Vasilij Schneidermann <v.schneidermann@gmail.com> + +;; This file is part of LUI. + +;; 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, write to the Free Software +;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +;; 02110-1301 USA + +;;; Commentary: + +;; This allows you to track where you've last left off a buffer. + +;; Use (enable-lui-track-bar) to enable this mode globally. You can +;; customize `lui-track-bar-behavior' to change when the track bar +;; moves. You can also use M-x lui-track-bar-move to move the track +;; bar manually. + +;;; Code: + +(require 'lui) +(require 'tracking) + +(defgroup lui-track-bar nil + "Last read position tracking for LUI" + :prefix "lui-track-bar-" + :group 'lui) + +(defcustom lui-track-bar-behavior 'before-switch-to-buffer + "When to move the track bar. + +The following values are possible. + +before-switch-to-buffer (default) + Move the bar to the bottom of the buffer when switching away + from a buffer. + +before-tracking-next-buffer + Move the bar when switching to the next buffer using + \\[tracking-next-buffer]. + +after-send + Move the bar after sending a message." + :type '(choice (const :tag "Before switching buffers" + before-switch-to-buffer) + (const :tag "Before tracking switch" + before-tracking-next-buffer) + (const :tag "After sending" + after-send)) + :group 'lui-track-bar) + +(defface lui-track-bar + '((((type graphic) (background light)) + :inherit default :background "dim gray" :height 0.1) + (((type graphic) (background dark)) + :inherit default :background "light gray" :height 0.1) + (((type tty)) + :inherit (font-lock-comment-face default) :underline t)) + "Track bar face" + :group 'lui-track-bar) + +(defvar lui-track-bar-overlay nil) +(make-variable-buffer-local 'lui-track-bar-overlay) + +;;;###autoload +(defun enable-lui-track-bar () + "Enable a bar in Lui buffers that shows where you stopped reading." + (interactive) + (defadvice switch-to-buffer (before lui-track-bar activate) + (when (and (eq lui-track-bar-behavior 'before-switch-to-buffer) + ;; Do not move the bar if the buffer is displayed still + (<= (length (get-buffer-window-list (current-buffer))) + 1)) + (lui-track-bar-move))) + (defadvice tracking-next-buffer (before lui-track-bar activate) + (when (eq lui-track-bar-behavior 'before-tracking-next-buffer) + (lui-track-bar-move))) + (add-hook 'lui-pre-input-hook 'lui-track-bar--move-pre-input)) + +(defun lui-track-bar--move-pre-input () + (when (eq lui-track-bar-behavior 'after-send) + (lui-track-bar-move))) + +(defun lui-track-bar-move () + "Move the track bar down." + (interactive) + (when (derived-mode-p 'lui-mode) + (when (not lui-track-bar-overlay) + (setq lui-track-bar-overlay (make-overlay (point-min) (point-min))) + (overlay-put lui-track-bar-overlay 'after-string + (propertize "\n" 'face 'lui-track-bar))) + (move-overlay lui-track-bar-overlay + lui-output-marker lui-output-marker))) + +(provide 'lui-track-bar) +;;; lui-track-bar.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-track-bar.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-track-bar.elc new file mode 100644 index 000000000000..3fbf759b6562 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui-track-bar.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui.el new file mode 100644 index 000000000000..07cc758f29c0 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui.el @@ -0,0 +1,1513 @@ +;;; lui.el --- Linewise User Interface -*- lexical-binding: t -*- + +;; Copyright (C) 2005 - 2016 Jorgen Schaefer + +;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; URL: https://github.com/jorgenschaefer/circe/wiki/Lui + +;; 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: + +;; Lui is a library for other Emacs Lisp programs and not useful by +;; itself. + +;; This major mode provides a user interface for applications. The +;; user interface is quite simple, consisting of an input line, a +;; prompt, and some output area, but Lui includes a lot of common +;; options, such as time stamps, filling, colorization, etc. + +;; Application programs should create modes derived from lui-mode. + +;; The application API consists of: + +;; lui-mode +;; lui-set-prompt +;; lui-insert +;; lui-input-function +;; lui-completion-function +;; lui-time-stamp-time +;; lui-time-stamp-zone +;; and the 'lui-fool and 'lui-do-not-track text properties + +;;; Code: + +(require 'button) +(require 'flyspell) +(require 'help-mode) +(require 'ispell) +(require 'paren) +(require 'ring) +(require 'thingatpt) +(require 'rx) + +(require 'tracking) + + +;;;;;;;;;;;;;;;;;;;;; +;;; Customization ;;; +;;;;;;;;;;;;;;;;;;;;; + +(defgroup lui nil + "The Linewise User Interface." + :prefix "lui-" + :group 'applications) + +(defcustom lui-scroll-behavior t + "Set the behavior lui should exhibit for scrolling. + +The following values are possible. If in doubt, use post-output. + +nil + Use default Emacs scrolling. + +post-command + Keep the input line at the end of the window if point is + after the input mark. + +post-output + Keep the input line at the end of the window only after output. + +t + Combine both post-command and post-output. + +post-scroll + Keep the input line at the end of the window on every scroll + event. Careful, this might interact badly with other functions + on `window-scroll-functions'. + + +It would be entirely sensible for Emacs to provide a setting to +do this kind of scrolling by default in a buffer. It seems rather +intuitive and sensible. But as noted on emacs-devel: + + [T]hose who know the code know that it's going to be a pain to + implement, especially if you want acceptable performance. IOW, + patches welcome + +The full discussion can be found here: + +https://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00652.html + +These settings are all hacks that try to give the user the choice +between most correct behavior (post-scroll) and most compliant +behavior (post-output)." + :type '(choice (const :tag "Post Command" t) + (const :tag "Post Output" post-output) + (const :tag "Post Scroll" post-scroll) + (const :tag "Use default scrolling" nil)) + :group 'lui) +(defvaralias 'lui-scroll-to-bottom-p 'lui-scroll-behavior) + +(defcustom lui-flyspell-p nil + "Non-nil if Lui should spell-check your input. +See the function `flyspell-mode' for more information." + :type 'boolean + :group 'lui) + +(defcustom lui-flyspell-alist nil + "Alist of buffer dictionaries. + +This is a list of mappings from buffers to dictionaries to use +for the function `flyspell-mode'. The appropriate dictionary is +automatically used when Lui is activated in a buffer with a +matching buffer name. + +The entries are of the form (REGEXP DICTIONARY), where REGEXP +must match a buffer name, and DICTIONARY specifies an existing +dictionary for the function `flyspell-mode'. See +`ispell-local-dictionary-alist' and `ispell-dictionary-alist' for +a valid list of dictionaries." + :type 'string + :group 'lui) + +(defcustom lui-highlight-keywords nil + "A list of keywords to highlight. + +This specifies a list of keywords that Lui should highlight. Each +entry is of one of the following forms (similar to +`font-lock-keywords'): + + REGEXP + Highlight every match in `lui-highlight-face' + (REGEXP SUBMATCH) + Highlight the SUBMATCH (a number) in REGEXP in + `lui-highlight-face' + (REGEXP FACE) + Highlight everything matching REGEXP in FACE (a symbol) + (REGEXP SUBMATCH FACE) + Highlight the SUBMATCH in REGEXP in FACE + +In all of these cases, the FACE can also be a property list which +is then associated with the match. + +All matches are run, which means later matches can override +changes by earlier ones." + :type '(repeat (choice + (string :tag "Regular Expression") + (list :tag "Submatch" + (string :tag "Regular Expression") + (integer :tag "Submatch")) + (list :tag "Regular Expression in Specific Face" + (string :tag "Regular Expression") + (face :tag "Face")) + (list :tag "Submatch in Specific Face" + (string :tag "Regular Expression") + (integer :tag "Submatch") + (face :tag "Face")))) + :group 'lui) + +(defface lui-strong-face + '((t (:inherit bold))) + "Face used for strong markup." + :group 'lui-irc-colors) + +(defface lui-emphasis-face + '((t (:inherit italic))) + "Face for emphasis markup." + :group 'lui-irc-colors) + +(defface lui-deleted-face + '((t (:strike-through t))) + "Face for deleted messages" + :group 'lui-irc-colors) + +(defcustom lui-formatting-list nil + "List of enabled formatting types. +Each list item is a list consisting of a regular expression +matching the highlighted text, an integer for the submatch and a +face for highlighting the match." + :type `(set + (const :tag "*Strong* text" + (,(rx (or bol whitespace) + (group "*" (+? (not (any whitespace "*"))) "*") + (or eol whitespace)) + 1 lui-strong-face)) + (const :tag "_Emphasized_ text" + (,(rx (or bol whitespace) + (group "_" (+? (not (any whitespace "_"))) "_") + (or eol whitespace)) + 1 lui-emphasis-face))) + :group 'lui) + +(defcustom lui-buttons-list + `(("`\\([A-Za-z0-9+=*/-]+\\)'" 1 + lui-button-elisp-symbol 1) + ("\\<debbugs[#:]\\([0-9]+\\)" 0 + "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s" 1) + ("\\<RFC ?\\([0-9]+\\)" 0 + "http://www.ietf.org/rfc/rfc%s.txt" 1) + ("\\<CVE[- ]\\([0-9]+-[0-9]+\\)" 0 + "https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-%s" 1) + ("\\<SRFI[- ]?\\([0-9]+\\)" 0 + "http://srfi.schemers.org/srfi-%s/srfi-%s.html" 1 1) + ("\\<PEP[- ]?\\([0-9]+\\)" 0 lui-button-pep 1) + ("\\<xkcd[ #]*\\([0-9]+\\)" 0 + "https://xkcd.com/%s" 1) + ("\\([0-9a-zA-Z_.-]+/[0-9a-zA-Z_.-]+\\)#\\([0-9]+\\)" 0 + "https://github.com/%s/issues/%s" 1 2)) + "The list of buttons to buttonize. +This consists of lists of four elements each: + + (REGEXP SUBMATCH FUNCTION ARG-MATCH...) + +Whenever REGEXP is found, SUBMATCH is marked as a button. When +that button is activated, FUNCTION is called with the matches +specified in ARG-MATCHES as its arguments. + +If FUNCTION is a string, it is formatted with %s replaced by +the matches in ARG-MATCHES." + :type '(repeat (list (regexp :tag "Regular expression") + (integer :tag "Submatch to buttonize") + (function :tag "Function to call for this button") + (integer :tag "Submatch to pass as an argument"))) + :group 'lui) + +(defcustom lui-button-issue-tracker nil + "A tracker URL for the current channel. + +This will cause simple #123 links to highlight as issue links to +the given repository. Use %s to insert the actual number." + :type 'string + :group 'lui) + +(defcustom lui-fill-type " " + "How Lui should fill its output. +This can be one of the following values: + + A string + This is used as the fill prefix + 'variable + The first sequence of non-whitespace characters in the + output is used as an alignment, and the rest is filled with + spaces. + A number + The first sequence of non-whitespace characters is + right-aligned at this column, and the rest is filled to + this column. + nil + Turn filling off." + :type '(choice (string :tag "Fill Prefix") + (const :tag "Variable Fill Prefix" variable) + (integer :tag "Fill Column") + (const :tag "No filling" nil)) + :group 'lui) + +(defcustom lui-fill-column 70 + "The column at which Lui should break output. +See `fill-column'." + :type 'integer + :group 'lui) + +(defcustom lui-fill-remove-face-from-newline t + "Non-nil when filling should remove faces from newlines. +Faces on a newline extend to the end of the displayed line, which +is often not was is wanted." + :type 'boolean + :group 'lui) + +(defcustom lui-time-stamp-format "[%H:%M]" + "The format of time stamps. +See `format-time-string' for a full description of available +formatting directives." + :type 'string + :group 'lui) + +(defcustom lui-time-stamp-position 'right + "Where Lui should put time-stamps. +This can be one of the following values: + + A number + At this column of the first line of output + 'right + At a column just right to `lui-fill-column' + 'left + At the left side of the output. The output is thereby moved + to the right. + 'right-margin + In the right margin. You will need to set `right-margin-width' + in all circe buffers. + 'left-margin + In the left margin. You will need to set `left-margin-width' + in all circe buffers. + nil + Do not add any time stamp." + :type '(choice (const :tag "Right" right) + (integer :tag "Column") + (const :tag "Left" left) + (const :tag "Right Margin" right-margin) + (const :tag "Left Margin" left-margin) + (const :tag "None" nil)) + :group 'lui) + +(defcustom lui-time-stamp-only-when-changed-p t + "Non-nil if Lui should only add a time stamp when the time changes. +If `lui-time-stamp-position' is 'left, this will still add the +necessary whitespace." + :type 'boolean + :group 'lui) + +(defcustom lui-read-only-output-p t + "Non-nil if Lui should make the output read-only. +Switching this off makes copying (by killing) easier for some." + :type 'boolean + :group 'lui) + +(defcustom lui-max-buffer-size 102400 + "Non-nil if Lui should truncate the buffer if it grows too much. +If the buffer size (in characters) exceeds this number, it is +truncated at the top." + :type '(choice (const :tag "Never Truncate" nil) + (integer :tag "Maximum Buffer Size")) + :group 'lui) + +(defcustom lui-input-ring-size 32 + "The size of the input history of Lui. +This is the size of the input history used by +\\[lui-previous-input] and \\[lui-next-input]." + :type 'integer + :group 'lui) + +(defcustom lui-mode-hook nil + "The hook run when Lui is started." + :type 'hook + :group 'lui) + +(defcustom lui-pre-input-hook nil + "A hook run before Lui interprets the user input. +It is called with the buffer narrowed to the input line. +Functions can modify the input if they really want to, but the +user won't see the modifications, so that's a bad idea." + :type 'hook + :group 'lui) + +(defcustom lui-pre-output-hook nil + "The hook run before output is formatted." + :type 'hook + :group 'lui) + +(defcustom lui-post-output-hook nil + "The hook run after output has been formatted." + :type 'hook + :group 'lui) + +(defface lui-time-stamp-face + '((t (:foreground "SlateBlue" :weight bold))) + "Lui mode face used for time stamps." + :group 'lui) + +(defface lui-highlight-face + ;; Taken from `font-lock-keyword-face' + '((((class grayscale) (background light)) (:foreground "LightGray" :weight bold)) + (((class grayscale) (background dark)) (:foreground "DimGray" :weight bold)) + (((class color) (background light)) (:foreground "Purple")) + (((class color) (background dark)) (:foreground "Cyan1")) + (t (:weight bold))) + "Lui mode face used for highlighting." + :group 'lui) + +(defface lui-button-face + '((((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:underline t))) + "Default face used for LUI buttons." + :group 'lui) + + +;;;;;;;;;;;;;;;;;;;;;;;; +;;; Client interface ;;; +;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar lui-input-function nil + "The function to be called for Lui input. +This function is called with a single argument, the input +string.") +(make-variable-buffer-local 'lui-input-function) + +(defvar lui-completion-function 'completion-at-point + "A function called to actually do completion.") + + +;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Private variables ;;; +;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar lui-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'lui-send-input) + (define-key map (kbd "TAB") 'lui-next-button-or-complete) + (define-key map (kbd "<backtab>") 'lui-previous-button) + (define-key map (kbd "<S-tab>") 'lui-previous-button) + (define-key map (kbd "M-p") 'lui-previous-input) + (define-key map (kbd "M-n") 'lui-next-input) + (define-key map (kbd "C-c C-u") 'lui-kill-to-beginning-of-line) + (define-key map (kbd "C-c C-i") 'lui-fool-toggle-display) + map) + "The key map used in Lui modes.") + +(defvar lui-input-marker nil + "The marker where input should be inserted.") +(make-variable-buffer-local 'lui-input-marker) + +(defvar lui-output-marker nil + "The marker where output should be inserted. +Use `lui-insert' instead of accessing this marker directly.") +(make-variable-buffer-local 'lui-output-marker) + +(defvar lui-input-ring nil + "The input history ring.") +(make-variable-buffer-local 'lui-input-ring) + +(defvar lui-input-ring-index nil + "The index to the current item in the input ring.") +(make-variable-buffer-local 'lui-input-ring-index) + + +;;;;;;;;;;;;;; +;;; Macros ;;; +;;;;;;;;;;;;;; + +(defmacro lui-save-undo-list (&rest body) + "Run BODY without modifying the undo list." + (let ((old-marker-sym (make-symbol "old-marker"))) + `(let ((,old-marker-sym (marker-position lui-input-marker)) + (val nil)) + ;; Don't modify the undo list. The undo list is for the user's + ;; input only. + (let ((buffer-undo-list t)) + (setq val (progn ,@body))) + (when (consp buffer-undo-list) + ;; Not t :-) + (lui-adjust-undo-list ,old-marker-sym (- lui-input-marker + ,old-marker-sym))) + val))) + + +;;;;;;;;;;;;;;;;;; +;;; Major Mode ;;; +;;;;;;;;;;;;;;;;;; + +(define-derived-mode lui-mode nil "LUI" + "The Linewise User Interface mode. +This can be used as a user interface for various applications. +Those should define derived modes of this, so this function +should never be called directly. + +It can be customized for an application by specifying a +`lui-input-function'." + (setq lui-input-marker (make-marker) + lui-output-marker (make-marker) + lui-input-ring (make-ring lui-input-ring-size) + lui-input-ring-index nil + flyspell-generic-check-word-p 'lui-flyspell-check-word-p) + (set-marker lui-input-marker (point-max)) + (set-marker lui-output-marker (point-max)) + (add-hook 'window-scroll-functions 'lui-scroll-window nil t) + (add-hook 'post-command-hook 'lui-scroll-post-command) + (add-hook 'change-major-mode-hook 'lui-change-major-mode nil t) + (lui-paren-highlighting) + (lui-time-stamp-enable-filtering) + (tracking-mode 1) + (auto-fill-mode 0) + (when (fboundp 'cursor-intangible-mode) + (cursor-intangible-mode 1)) + (when lui-flyspell-p + (require 'flyspell) + (lui-flyspell-change-dictionary))) + +(defun lui-change-major-mode () + "Assure that the user really wants to change the major mode. +This is a good value for a buffer-local `change-major-mode-hook'." + (when (not (y-or-n-p "Really change major mode in a Lui buffer? ")) + (error "User disallowed mode change"))) + +(defun lui-scroll-window (window _display-start) + "Scroll the input line to the bottom of the WINDOW. + +DISPLAY-START is passed by the hook `window-scroll-functions' and +is ignored. + +See `lui-scroll-behavior' for how to customize this." + (when (and (eq lui-scroll-behavior 'post-scroll) + window + (window-live-p window)) + (with-selected-window window + (when (or (>= (point) lui-input-marker) + (equal (point-max) + (window-end nil t))) + (let ((resize-mini-windows nil)) + (save-excursion + (goto-char (point-max)) + (recenter -1))))))) + +(defun lui-scroll-post-command () + "Scroll the input line to the bottom of the window. + +This is called from `post-command-hook'. + +See `lui-scroll-behavior' for how to customize this." + (condition-case err + (dolist (w (window-list)) + (with-current-buffer (window-buffer w) + (when (and lui-input-marker + (memq lui-scroll-behavior '(t post-command))) + ;; Code from ERC's erc-goodies.el. I think this was originally + ;; mine anyhow, not sure though. + (save-restriction + (widen) + (when (>= (point) lui-input-marker) + (save-excursion + (goto-char (point-max)) + (with-selected-window w + (recenter -1)))))))) + (error + (message "Error in lui-scroll-post-command: %S" err) + ))) + +(defun lui-scroll-post-output () + "Scroll the input line to the bottom of the window. + +This is called when lui output happens. + +See `lui-scroll-behavior' for how to customize this." + (when (memq lui-scroll-behavior '(t post-output)) + (let ((resize-mini-windows nil)) + (dolist (window (get-buffer-window-list (current-buffer) nil t)) + (when (or (>= (point) lui-input-marker) + (equal (point-max) + (window-end window))) + (with-selected-window window + (save-excursion + (goto-char (point-max)) + (recenter -1)))))))) + + +;;;;;;;;;;;;; +;;; Input ;;; +;;;;;;;;;;;;; + +(defun lui-send-input () + "Send the current input to the Lui application. +If point is not in the input area, insert a newline." + (interactive) + (if (< (point) lui-input-marker) + (newline) + (save-restriction + (narrow-to-region lui-input-marker (point-max)) + (run-hooks 'lui-pre-input-hook)) + (let ((input (buffer-substring lui-input-marker (point-max)))) + (delete-region lui-input-marker (point-max)) + (lui-add-input input) + (if lui-input-function + (funcall lui-input-function input) + (error "No input function specified"))))) + +(defun lui-add-input (input) + "Add INPUT as if entered by the user." + (ring-insert lui-input-ring input) + (setq lui-input-ring-index nil)) + + +;;;;;;;;;;;;;;; +;;; Buttons ;;; +;;;;;;;;;;;;;;; + +(define-button-type 'lui-button + 'supertype 'button + 'follow-link t + 'face 'lui-button-face) + +(defun lui-buttonize () + "Buttonize the current message." + (lui-buttonize-urls) + (lui-buttonize-custom) + (lui-buttonize-issues)) + +(defun lui-buttonize-custom () + "Add custom buttons to the current message. + +This uses `lui-buttons-list'." + (dolist (entry lui-buttons-list) + (let ((regex (nth 0 entry)) + (submatch (nth 1 entry)) + (function-or-url (nth 2 entry)) + (arg-matches (nthcdr 3 entry))) + (goto-char (point-min)) + (while (re-search-forward regex nil t) + ;; Ensure we're not inserting a button inside a URL button + (when (not (button-at (match-beginning 0))) + (let* ((function (if (functionp function-or-url) + function-or-url + 'browse-url)) + (matches (mapcar (lambda (n) + (match-string-no-properties n)) + arg-matches)) + (arguments (if (functionp function-or-url) + matches + (list (apply #'format function-or-url + matches))))) + (make-button (match-beginning submatch) + (match-end submatch) + 'type 'lui-button + 'action 'lui-button-activate + 'lui-button-function function + 'lui-button-arguments arguments))))))) + +(defun lui-buttonize-issues () + "Buttonize issue references in the current message, if configured." + (when lui-button-issue-tracker + (goto-char (point-min)) + (while (re-search-forward "\\(?:^\\|\\W\\)\\(#\\([0-9]+\\)\\)" nil t) + ;; Ensure we're not inserting a button inside a URL button + (when (not (button-at (point))) + (make-button (match-beginning 1) + (match-end 1) + 'type 'lui-button + 'action 'lui-button-activate + 'lui-button-function 'browse-url + 'lui-button-arguments + (list (format lui-button-issue-tracker + (match-string 2)))))))) + +(defun lui-buttonize-urls () + "Buttonize URLs in the current message." + (let ((regex (regexp-opt thing-at-point-uri-schemes))) + (goto-char (point-min)) + (while (re-search-forward regex nil t) + (let ((bounds (bounds-of-thing-at-point 'url))) + (when bounds + (make-button (car bounds) + (cdr bounds) + 'type 'lui-button + 'action 'lui-button-activate + 'lui-button-function 'browse-url + 'lui-button-arguments + (list (buffer-substring-no-properties + (car bounds) + (cdr bounds))))))))) + +(defun lui-button-activate (button) + "Activate BUTTON. +This calls the function stored in the `lui-button-function' +property with the argument stored in `lui-button-arguments'." + (apply (button-get button 'lui-button-function) + (button-get button 'lui-button-arguments))) + +(defun lui-next-button-or-complete () + "Go to the next button, or complete at point. +When point is in the input line, call `lui-completion-function'. +Otherwise, we move to the next button." + (interactive) + (if (>= (point) + lui-input-marker) + (funcall lui-completion-function) + (forward-button 1))) + +(defun lui-previous-button () + "Go to the previous button." + (interactive) + (backward-button 1)) + +(defun lui-button-elisp-symbol (name) + "Show the documentation for the symbol named NAME." + (let ((sym (intern-soft name))) + (cond + ((not sym) + (message "No such symbol %s" name) + (ding)) + (t + (help-xref-interned sym))))) + +(defun lui-button-pep (number) + "Browse the PEP NUMBER." + (browse-url (format "https://www.python.org/dev/peps/pep-%04i" + (string-to-number number)))) + +(defun lui-button-issue (issue) + "Browse the issue tracker number ISSUE, if configured." + (if lui-button-issue-tracker + (browse-url (format lui-button-issue-tracker issue)) + (error "No issue tracker configured, see `lui-button-issue-tracker'"))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Input Line Killing ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun lui-kill-to-beginning-of-line () + "Kill the input from point to the beginning of the input." + (interactive) + (let* ((beg (point-at-bol)) + (end (point)) + (str (buffer-substring beg end))) + (delete-region beg end) + (kill-new str))) + + +;;;;;;;;;;;;;;;;;;;;; +;;; Input History ;;; +;;;;;;;;;;;;;;;;;;;;; + +;; FIXME! +;; These need some better algorithm. They clobber input when it is not +;; in the ring! +(defun lui-previous-input () + "Cycle through the input history to the last input." + (interactive) + (when (> (ring-length lui-input-ring) 0) + (if (and lui-input-ring-index + (= (1- (ring-length lui-input-ring)) + lui-input-ring-index)) + ;; last item - insert a single empty line + (progn + (lui-replace-input "") + (setq lui-input-ring-index nil)) + ;; If any input is left, store it in the input ring + (when (and (null lui-input-ring-index) + (> (point-max) lui-input-marker)) + (ring-insert lui-input-ring + (buffer-substring lui-input-marker (point-max))) + (setq lui-input-ring-index 0)) + ;; Increment the index + (setq lui-input-ring-index + (if lui-input-ring-index + (ring-plus1 lui-input-ring-index (ring-length lui-input-ring)) + 0)) + ;; And insert the last input + (lui-replace-input (ring-ref lui-input-ring lui-input-ring-index)) + (goto-char (point-max))))) + +(defun lui-next-input () + "Cycle through the input history to the next input." + (interactive) + (when (> (ring-length lui-input-ring) 0) + (if (and lui-input-ring-index + (= 0 lui-input-ring-index)) + ;; first item - insert a single empty line + (progn + (lui-replace-input "") + (setq lui-input-ring-index nil)) + ;; If any input is left, store it in the input ring + (when (and (null lui-input-ring-index) + (> (point-max) lui-input-marker)) + (ring-insert lui-input-ring + (buffer-substring lui-input-marker (point-max))) + (setq lui-input-ring-index 0)) + ;; Decrement the index + (setq lui-input-ring-index (ring-minus1 (or lui-input-ring-index 0) + (ring-length lui-input-ring))) + ;; And insert the next input + (lui-replace-input (ring-ref lui-input-ring lui-input-ring-index)) + (goto-char (point-max))))) + +(defun lui-replace-input (str) + "Replace input with STR." + (save-excursion + (goto-char lui-input-marker) + (delete-region lui-input-marker (point-max)) + (insert str))) + + +;;;;;;;;;;;;; +;;; Fools ;;; +;;;;;;;;;;;;; + +(defun lui-fools () + "Propertize the current narrowing according to foolhardiness. +That is, if any part of it has the text property 'lui-fool set, +make the whole thing invisible." + (when (text-property-any (point-min) + (point-max) + 'lui-fool t) + (add-text-properties (point-min) + (point-max) + '(invisible lui-fool)))) + +(defun lui-fools-hidden-p () + "Return whether fools are currently hidden." + (if (or (eq t buffer-invisibility-spec) + (memq 'lui-fool buffer-invisibility-spec)) + t + nil)) + +(defun lui-fool-toggle-display () + "Display what fools have said." + (interactive) + (when (eq buffer-invisibility-spec t) + (add-to-invisibility-spec 'lui-fool)) + (cond + ((lui-fools-hidden-p) + (message "Now showing the gibberish of fools") + (remove-from-invisibility-spec 'lui-fool)) + (t + (message "Now hiding fools again *phew*") + (add-to-invisibility-spec 'lui-fool))) + ;; For some reason, after this, the display does not always update + ;; (issue #31). Force an update just in case. + (force-mode-line-update t)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Blink Paren and Show Paren Mode ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun lui-paren-highlighting () + "Enable sane parenthesis highlighting in this buffer." + (set (make-local-variable 'blink-paren-function) + 'lui-blink-paren-function) + (when (boundp 'show-paren-data-function) + (set (make-local-variable 'show-paren-data-function) + 'lui-show-paren-data-function))) + +(defun lui-blink-paren-function () + "Do not blink opening parens outside of the lui input area. + +When point is within the lui input area, inserting a closing +parenthesis should only blink parens within the input area, not +outside of it. + +This is a suitable value for `blink-paren-function', which see." + (if (> (point) lui-input-marker) + (let ((blink-matching-paren-distance (- (point) + lui-input-marker))) + (blink-matching-open)) + (blink-matching-open))) + +(defun lui-show-paren-data-function () + "Show parens only within the input area. + +When `show-paren-mode' is enabled, and point is in the input +area, parenthesis highlighting should only happen within the +input area, not include the rest of the buffer. + +This is a suitable value for `show-paren-data-function', which see." + (when (fboundp 'show-paren--default) + (let ((range (show-paren--default))) + (if (or (< (point) lui-input-marker) + (not (elt range 2)) + (>= (elt range 2) lui-input-marker)) + range + nil)))) + + +;;;;;;;;;;;;;;;; +;;; Flyspell ;;; +;;;;;;;;;;;;;;;; + +(defun lui-flyspell-change-dictionary (&optional dictionary) + "*Change flyspell to DICTIONARY. +If DICTIONARY is nil, set a default dictionary according to +`lui-flyspell-alist'. +If it is \"\", disable flyspell." + (interactive (list (completing-read + "Use new dictionary (RET for none, SPC to complete): " + (and (fboundp 'ispell-valid-dictionary-list) + (mapcar 'list (ispell-valid-dictionary-list))) + nil t))) + (let ((dictionary (or dictionary + (lui-find-dictionary (buffer-name))))) + (when flyspell-mode + (flyspell-mode 0)) + (when (and dictionary + (not (equal dictionary ""))) + (ispell-change-dictionary dictionary)) + (flyspell-mode 1))) + + +(defun lui-find-dictionary (buffer-name) + "Return a dictionary appropriate for BUFFER-NAME." + (let ((lis lui-flyspell-alist) + (result nil)) + (while lis + (if (string-match (caar lis) buffer-name) + (setq result (cadr (car lis)) + lis nil) + (setq lis (cdr lis)))) + result)) + +(defun lui-flyspell-check-word-p () + "Return non-nil when flyspell should verify at this position. +This is the value of Lui for `flyspell-generic-check-word-p'." + (>= (point) + lui-input-marker)) + + +;;;;;;;;;;;;;; +;;; Output ;;; +;;;;;;;;;;;;;; + +(defvar lui-message-id 0 + "Unique id for each message. +Used to allow navigation between messages and editing and +deleting.") +(make-variable-buffer-local 'lui-message-id) + +(defvar lui-internal-text-properties '(lui-formatted-time-stamp + lui-time-stamp-last + lui-raw-text + lui-message-id + lui-saved-text-properties) + "Text properties used internally by lui. + +These are always kept when replacing messages.") + +(defun lui-insert (str &optional not-tracked-p) + "Insert STR into the current Lui buffer. + +If NOT-TRACKED-P is given, this insertion won't trigger tracking +of the buffer." + (if not-tracked-p + (lui-insert-with-text-properties str 'not-tracked-p t) + (lui-insert-with-text-properties str))) + +(defun lui-plist-keys (plist) + "Get the keys from PLIST. + +PLIST should be a flat list with keys and values alternating, +like used for setting and getting text properties." + (let ((key t) result) + (dolist (item plist (reverse result)) + (when key + (push item result)) + (setq key (not key))))) + +(defun lui-insert-with-text-properties (str &rest text-properties) + "Insert STR into the current Lui buffer. + +TEXT-PROPERTIES is a property list containing text properties to +add to the inserted message." + (let ((not-tracked-p (plist-get text-properties 'not-tracked-p)) + (saved-text-properties (append (lui-plist-keys text-properties) + lui-internal-text-properties))) + (lui-save-undo-list + (save-excursion + (save-restriction + (let ((inhibit-read-only t) + (inhibit-point-motion-hooks t)) + (widen) + (goto-char lui-output-marker) + (let ((beg (point)) + (end nil)) + (insert str "\n") + (setq end (point)) + (set-marker lui-output-marker (point)) + (narrow-to-region beg end)) + (goto-char (point-min)) + (add-text-properties (point-min) + (point-max) + `(lui-raw-text ,str)) + (run-hooks 'lui-pre-output-hook) + (lui-apply-formatting) + (lui-highlight-keywords) + (lui-buttonize) + (lui-fill) + (lui-time-stamp + (plist-get text-properties 'lui-formatted-time-stamp)) + (goto-char (point-min)) + (add-text-properties + (point-min) (point-max) + (plist-put text-properties 'lui-message-id lui-message-id)) + (setq lui-message-id (1+ lui-message-id)) + (run-hooks 'lui-post-output-hook) + (lui-fools) + (goto-char (point-min)) + (add-text-properties + (point-min) (point-max) + `(lui-saved-text-properties ,saved-text-properties)) + (let ((faces (lui-faces-in-region (point-min) + (point-max))) + (foolish (text-property-any (point-min) + (point-max) + 'lui-fool t)) + (not-tracked-p + (or not-tracked-p + (text-property-any (point-min) + (point-max) + 'lui-do-not-track t)))) + (widen) + (lui-truncate) + (lui-read-only) + (when (and (not not-tracked-p) + (not foolish)) + (tracking-add-buffer (current-buffer) + faces))) + (lui-scroll-post-output))))))) + +(defun lui--adjust-p (pos old) + (and (numberp pos) (>= (abs pos) old))) + +(defun lui--new-pos (pos shift) + (* (if (< pos 0) -1 1) (+ (abs pos) shift))) + +(defun lui-adjust-undo-list (old-begin shift) + ;; Translate buffer positions in buffer-undo-list by SHIFT. + (unless (or (zerop shift) (atom buffer-undo-list)) + (let ((list buffer-undo-list) elt) + (while list + (setq elt (car list)) + (cond ((integerp elt) ; POSITION + (if (lui--adjust-p elt old-begin) + (setf (car list) (lui--new-pos elt shift)))) + ((or (atom elt) ; nil, EXTENT + (markerp (car elt))) ; (MARKER . DISTANCE) + nil) + ((integerp (car elt)) ; (BEGIN . END) + (if (lui--adjust-p (car elt) old-begin) + (setf (car elt) (lui--new-pos (car elt) shift))) + (if (lui--adjust-p (cdr elt) old-begin) + (setf (cdr elt) (lui--new-pos (cdr elt) shift)))) + ((stringp (car elt)) ; (TEXT . POSITION) + (if (lui--adjust-p (cdr elt) old-begin) + (setf (cdr elt) (lui--new-pos (cdr elt) shift)))) + ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) + (let ((cons (nthcdr 3 elt))) + (if (lui--adjust-p (car cons) old-begin) + (setf (car cons) (lui--new-pos (car cons) shift))) + (if (lui--adjust-p (cdr cons) old-begin) + (setf (cdr cons) (lui--new-pos (cdr cons) shift))))) + ((and (featurep 'xemacs) + (extentp (car elt))) ; (EXTENT START END) + (if (lui--adjust-p (nth 1 elt) old-begin) + (setf (nth 1 elt) (lui--new-pos (nth 1 elt) shift))) + (if (lui--adjust-p (nth 2 elt) old-begin) + (setf (nth 2 elt) (lui--new-pos (nth 2 elt) shift))))) + (setq list (cdr list)))))) + +(defvar lui-prompt-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "<end>") 'lui-prompt-end-of-line) + (define-key map (kbd "C-e") 'lui-prompt-end-of-line) + map) + "Keymap for Lui prompts. +Since \\[end-of-line] can't move out of fields, this DTRT for an +unexpecting user.") + +(defun lui-set-prompt (prompt) + "Set PROMPT as the current Lui prompt." + (let ((inhibit-read-only t)) + (lui-save-undo-list + (save-excursion + (goto-char lui-output-marker) + (insert prompt) + (if (> lui-input-marker (point)) + (delete-region (point) lui-input-marker) + (set-marker lui-input-marker (point))) + (add-text-properties lui-output-marker lui-input-marker + `(read-only t + rear-nonsticky t + field lui-prompt + keymap ,lui-prompt-map + front-sticky t + )))))) + +(defun lui-prompt-end-of-line (&optional _N) + "Move past the prompt, and then to the end of the line. +This uses `end-of-line'. + +The argument N is ignored." + (interactive "p") + (goto-char lui-input-marker) + (call-interactively 'end-of-line)) + +(defun lui-faces-in-region (beg end) + "Return a face that describes the region between BEG and END." + (goto-char beg) + (let ((faces nil)) + (while (not (= (point) end)) + (let ((face (get-text-property (point) 'face))) + (dolist (face (if (consp face) + face + (list face))) + (when (and face + (facep face) + (face-differs-from-default-p face)) + (push face faces))) + (goto-char (next-single-property-change (point) 'face + nil end)))) + faces)) + + + +;;;;;;;;;;;;;;;;;;;; +;;; Highlighting ;;; +;;;;;;;;;;;;;;;;;;;; + +(defun lui-highlight-keywords () + "Highlight the entries in the variable `lui-highlight-keywords'. + +This is called automatically when new text is inserted." + (let ((regex (lambda (entry) + (if (stringp entry) + entry + (car entry)))) + (submatch (lambda (entry) + (if (and (consp entry) + (numberp (cadr entry))) + (cadr entry) + 0))) + (properties (lambda (entry) + (let ((face (cond + ;; REGEXP + ((stringp entry) + 'lui-highlight-face) + ;; (REGEXP SUBMATCH) + ((and (numberp (cadr entry)) + (null (cddr entry))) + 'lui-highlight-face) + ;; (REGEXP FACE) + ((null (cddr entry)) + (cadr entry)) + ;; (REGEXP SUBMATCH FACE) + (t + (nth 2 entry))))) + (if (facep face) + `(face ,face) + face))))) + (dolist (entry lui-highlight-keywords) + (goto-char (point-min)) + (while (re-search-forward (funcall regex entry) nil t) + (let* ((exp (funcall submatch entry)) + (beg (match-beginning exp)) + (end (match-end exp))) + (when (not (text-property-any beg end 'lui-highlight-fontified-p t)) + (add-text-properties beg end + (append (funcall properties entry) + '(lui-highlight-fontified-p t))))))))) + +(defun lui-apply-formatting () + "Highlight the entries in `lui-formatting-list'." + (dolist (entry lui-formatting-list) + (goto-char (point-min)) + (let ((re (car entry)) + (subgroup (cadr entry)) + (face (nth 2 entry))) + (while (re-search-forward re nil t) + (when face + (add-face-text-property (match-beginning subgroup) (match-end subgroup) + face nil (current-buffer))))))) + + +;;;;;;;;;;;;;;; +;;; Filling ;;; +;;;;;;;;;;;;;;; + +(defun lui-fill () + "Fill the text in the buffer. +This is called automatically when new text is inserted. See +`lui-fill-type' and `lui-fill-column' on how to customize this +function." + (cond + ((stringp lui-fill-type) + (let ((fill-prefix lui-fill-type) + (fill-column (or lui-fill-column + fill-column))) + (fill-region (point-min) (point-max) + nil t))) + ((eq lui-fill-type 'variable) + (let ((fill-prefix (save-excursion + (goto-char (point-min)) + (let ((beg (point))) + (re-search-forward "\\s-" nil t) + (make-string (- (point) beg) ? )))) + (fill-column (or lui-fill-column + fill-column))) + (fill-region (point-min) (point-max) + nil t))) + ((numberp lui-fill-type) + (let ((right-end (save-excursion + (goto-char (point-min)) + (re-search-forward "\\s-" nil t) + (- (point) + (point-at-bol))))) + (goto-char (point-min)) + (when (< right-end lui-fill-type) + (insert (make-string (- lui-fill-type + right-end) + ? ))) + (let ((fill-prefix (make-string lui-fill-type ? )) + (fill-column (or lui-fill-column + fill-column))) + (fill-region (point-min) (point-max) + nil t))))) + (when lui-fill-remove-face-from-newline + (goto-char (point-min)) + (while (re-search-forward "\n" nil t) + (put-text-property (match-beginning 0) + (match-end 0) + 'face + nil)))) + + +;;;;;;;;;;;;;;;;;;; +;;; Time Stamps ;;; +;;;;;;;;;;;;;;;;;;; + +(defvar lui-time-stamp-last nil + "The last time stamp.") +(make-variable-buffer-local 'lui-time-stamp-last) + +(defvar lui-time-stamp-time nil + "A custom time to use as the time stamp for `lui-insert'. + +This variable should be let-bound when you wish to provide a +custom time to be printed by `lui-time-stamp'. If this variable +is nil the current time is used. See the TIME argument to +`format-time-string' for more information.") + +(defvar lui-time-stamp-zone nil + "A custom timezone to use for the time stamp for `lui-insert'. + +This variable should be let-bound when you wish to provide a +custom time zone when printing the time stamp with +`lui-time-stamp'. If this variable is nil local time is used. +See the ZONE argument to `format-time-string' for more +information.") + +(defun lui-time-stamp (&optional text) + "Add a time stamp to the current buffer. + +If TEXT is specified, use that instead of formatting a new time stamp." + (let ((ts (or text + (format-time-string lui-time-stamp-format + lui-time-stamp-time + lui-time-stamp-zone)))) + (cond + ;; Time stamps right + ((or (numberp lui-time-stamp-position) + (eq lui-time-stamp-position 'right)) + (when (or (not lui-time-stamp-only-when-changed-p) + (not lui-time-stamp-last) + (not (string= ts lui-time-stamp-last))) + (goto-char (point-min)) + (goto-char (point-at-eol)) + (let* ((curcol (current-column)) + (col (if (numberp lui-time-stamp-position) + lui-time-stamp-position + (+ 2 (or lui-fill-column + fill-column + (point))))) + (indent (if (> col curcol) + (- col curcol) + 1)) + (ts-string (propertize + (concat (make-string indent ?\s) + (propertize + ts + 'face 'lui-time-stamp-face)) + 'lui-time-stamp t)) + (start (point))) + (insert ts-string) + (add-text-properties start (1+ (point)) '(intangible t)) + (add-text-properties (1+ start) (point) '(cursor-intangible t))))) + ;; Time stamps left + ((eq lui-time-stamp-position 'left) + (let ((indent-string (propertize (make-string (length ts) ?\s) + 'lui-time-stamp t))) + (goto-char (point-min)) + (cond + ;; Time stamp + ((or (not lui-time-stamp-only-when-changed-p) + (not lui-time-stamp-last) + (not (string= ts lui-time-stamp-last))) + (insert (propertize ts + 'face 'lui-time-stamp-face + 'lui-time-stamp t))) + ;; Just indentation + (t + (insert indent-string))) + (forward-line 1) + (while (< (point) (point-max)) + (insert indent-string) + (forward-line 1)))) + ;; Time stamps in margin + ((or (eq lui-time-stamp-position 'right-margin) + (eq lui-time-stamp-position 'left-margin)) + (when (or (not lui-time-stamp-only-when-changed-p) + (not lui-time-stamp-last) + (not (string= ts lui-time-stamp-last))) + (goto-char (point-min)) + (when lui-fill-type + (goto-char (point-at-eol))) + (let* ((ts (propertize ts 'face 'lui-time-stamp-face)) + (ts-margin (propertize + " " + 'display `((margin ,lui-time-stamp-position) + ,ts) + 'lui-time-stamp t))) + (insert ts-margin))))) + (add-text-properties (point-min) (point-max) + `(lui-formatted-time-stamp ,ts + lui-time-stamp-last ,lui-time-stamp-last)) + (setq lui-time-stamp-last ts))) + +(defun lui-time-stamp-enable-filtering () + "Enable filtering of timestamps from copied text." + (set (make-local-variable 'filter-buffer-substring-functions) + '(lui-filter-buffer-time-stamps))) + +(defun lui-filter-buffer-time-stamps (fun beg end delete) + "Filter text from copied strings. + +This is meant for the variable `filter-buffer-substring-functions', +which see for an explanation of the argument FUN, BEG, END and +DELETE." + (let ((string (funcall fun beg end delete)) + (inhibit-point-motion-hooks t) + (inhibit-read-only t) + ;; Emacs 24.4, 24.5 + deactivate-mark) + (with-temp-buffer + (insert string) + (let ((start (text-property-any (point-min) + (point-max) + 'lui-time-stamp t))) + (while start + (let ((end (next-single-property-change start 'lui-time-stamp + nil (point-max)))) + (delete-region start end) + (setq start (text-property-any (point-min) (point-max) + 'lui-time-stamp t)))) + (buffer-string))))) + +(defun lui-time-stamp-buffer-substring (buffer-string) + "Filter text from copied strings. + +This is meant for the variable `buffer-substring-filters', +which see for an explanation of the argument BUFFER-STRING." + (lui-filter-buffer-time-stamps (lambda (_beg _end _delete) + buffer-string) + nil nil nil)) + + +;;;;;;;;;;;;;;;;;; +;;; Truncating ;;; +;;;;;;;;;;;;;;;;;; + +(defun lui-truncate () + "Truncate the current buffer if it exceeds `lui-max-buffer-size'." + (when (and lui-max-buffer-size + (> (point-max) + lui-max-buffer-size)) + (goto-char (- (point-max) + lui-max-buffer-size)) + (forward-line 0) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point))))) + + +;;;;;;;;;;;;;;;;; +;;; Read-Only ;;; +;;;;;;;;;;;;;;;;; + +(defun lui-read-only () + "Make the current output read-only if `lui-read-only-output-p' is non-nil." + (when lui-read-only-output-p + (add-text-properties (point-min) lui-output-marker + '(read-only t + front-sticky t)))) + + +;;;;;;;;;;;;;;;;;; +;;; Navigation ;;; +;;;;;;;;;;;;;;;;;; + +(defun lui-at-message-p () + "Check if point is on a message." + (get-text-property (point) 'lui-message-id)) + +(defun lui-beginning-of-message-p () + "Check if point is at the beginning of a message." + (or (= (point) (point-min)) + (not (equal (get-text-property (point) 'lui-message-id) + (get-text-property (1- (point)) 'lui-message-id))))) + +(defun lui-beginning-of-message () + "Move point to the beginning of the message at point." + (goto-char (previous-single-property-change (point) 'lui-message-id))) + +(defun lui-forward-message () + "Move point to the next message in the buffer and return point. +If there is no next message, move to the end of the buffer instead." + (let ((current-id (get-text-property (point) 'lui-message-id)) + (next-point + (next-single-property-change (point) 'lui-message-id))) + (if (not next-point) + (goto-char (point-max)) + (let ((message-id + (get-text-property next-point 'lui-message-id))) + (goto-char next-point) + (when (or (not (or current-id message-id)) + (and current-id (not message-id)) + (and current-id message-id + (= current-id message-id))) + (lui-forward-message)))) + (point))) + +(defun lui-backward-message () + "Move point to the previous message in the buffer and return point. +If there is no previous message, move to the beginning of the +buffer instead." + (let ((current-id (get-text-property (point) 'lui-message-id)) + (prev-point + (previous-single-property-change (point) 'lui-message-id))) + (if (not prev-point) + (goto-char (point-min)) + (let ((message-id + (get-text-property prev-point 'lui-message-id))) + (goto-char prev-point) + (when (or (not (or current-id message-id)) + (and current-id (not message-id)) + (and current-id message-id + (= current-id message-id))) + (lui-backward-message)))) + (point))) + + +;;;;;;;;;;;;;;; +;;; Editing ;;; +;;;;;;;;;;;;;;; + +(defun lui-recover-output-marker () + "Reset the output marker to just before the lui prompt." + (let ((input-position (marker-position lui-input-marker))) + (set-marker lui-output-marker + (field-beginning (1- input-position))))) + +(defun lui-build-plist (keys) + "Build a plist with KEYS taken from current text properties." + (let (result) + (dolist (key keys result) + (let ((value (get-text-property (point) key))) + (when value + (setq result (plist-put result key value))))))) + +(defun lui-replace-message (new-message) + "Replace the message at point with NEW-MESSAGE." + (unless (lui-at-message-p) + (error "Point is not on a message")) + (unless (lui-beginning-of-message-p) + (lui-beginning-of-message)) + (let* ((saved-text-properties + (get-text-property (point) 'lui-saved-text-properties)) + (text-properties (lui-build-plist saved-text-properties)) + (inhibit-read-only t) + (lui-time-stamp-last + (get-text-property (point) 'lui-time-stamp-last)) + (lui-message-id + (get-text-property (point) 'lui-message-id))) + (unwind-protect + (progn + (setq lui-output-marker (point-marker)) + (delete-region (point) + (next-single-property-change (point) 'lui-message-id)) + (apply #'lui-insert-with-text-properties new-message + (plist-put text-properties 'not-tracked-p t))) + (lui-recover-output-marker)))) + +(defun lui-replace (new-message predicate) + "Replace a message with NEW-MESSAGE. + +PREDICATE should be a function that returns a non-nil value for +the message that should be replaced." + (save-excursion + (goto-char (point-max)) + (while (> (lui-backward-message) (point-min)) + (when (funcall predicate) + (lui-replace-message new-message))))) + +(defun lui-delete-message () + "Delete the message at point." + (unless (lui-at-message-p) + (error "Point is not on a message")) + (unless (lui-beginning-of-message-p) + (lui-beginning-of-message)) + (let ((inhibit-read-only t)) + (add-text-properties (point) + (next-single-property-change (point) 'lui-message-id) + '(face lui-deleted-face)))) + +(defun lui-delete (predicate) + "Delete a message. + +PREDICATE should be a function that returns a non-nil value for +the message that should be replaced." + (save-excursion + (goto-char (point-max)) + (while (> (lui-backward-message) (point-min)) + (when (funcall predicate) + (lui-delete-message))))) + + +(provide 'lui) +;;; lui.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui.elc new file mode 100644 index 000000000000..5d812f5dc4b5 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/lui.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/make-tls-process.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/make-tls-process.el new file mode 100644 index 000000000000..aa7508568b96 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/make-tls-process.el @@ -0,0 +1,194 @@ +;;; make-tls-process.el --- A non-blocking TLS connection function + +;; Copyright (C) 2015 Jorgen Schaefer <contact@jorgenschaefer.de> + +;; Author: Jorgen Schaefer <contact@jorgenschaefer.de> +;; URL: https://github.com/jorgenschaefer/circe + +;; 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: + +;; A `make-tls-process' function like `make-network-process', in +;; particular supporting non-blocking connects. + +;;; Code: + +(require 'tls) + +(defcustom tls-connection-command + (if (executable-find "gnutls-cli") + "gnutls-cli --insecure -p %p %h" + "openssl s_client -connect %h:%p -ign_eof") + "The command to use to create a TLS connection. + +%h is replaced with server hostname, %p with port to connect to. +The program should read input on stdin and write output to +stdout. + +Also see `tls-success' for what the program should output after +successful negotiation." + :group 'tls + :type 'string) + +(defvar tls-debug-output nil + "Non-nil if you want to see lots of debug messages.") + +(defun tls--debug (format-string &rest args) + "Display a message if debug output is enabled. + +If `tls-debug-output' is non-nil, this acts like `message'. +Otherwise, it's a no-op." + (when tls-debug-output + (apply #'message format-string args))) + +(defun make-tls-process (&rest args) + "Create a TLS client process. + +A TLS network process is a command process that runs a command +line program like gnutls or openssl, not a full network process. +Network communication should work as usual, but the sentinel +might receive process-specific events. + +Different from a process sentinel, but like a network sentinel, +the sentinel is called with an event \"open\\n\" when the +connection is established. + +This function uses `tls-connection-command' to connect to a +server. + +Do NOT use `set-process-filter' or `set-process-sentinel' on the +return value of this function. The connection setup uses special +sentinels and filters to be deal with the program output used +here. Use the :sentinel and :filter keyword arguments to set them +once the connection is fully established. + +Arguments are specified as keyword/argument pairs, similar to +`make-network-process'. The following arguments are defined: + +:name NAME -- NAME is name for process. It is modified if necessary +to make it unique. + +:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate +with the process. Process output goes at end of that buffer, unless +you specify an output stream or filter function to handle the output. +BUFFER may be also nil, meaning that this process is not associated +with any buffer. + +:host HOST -- HOST is name of the host to connect to, or its IP +address. The symbol `local' specifies the local host. If specified +for a server process, it must be a valid name or address for the local +host, and only clients connecting to that address will be accepted. + +:service SERVICE -- SERVICE is name of the service desired, or an +integer specifying a port number to connect to. If SERVICE is t, +a random port number is selected for the server. (If Emacs was +compiled with getaddrinfo, a port number can also be specified as +a string, e.g. \"80\", as well as an integer. This is not +portable.) + +:coding CODING -- If CODING is a symbol, it specifies the coding +system used for both reading and writing for this process. If CODING +is a cons (DECODING . ENCODING), DECODING is used for reading, and +ENCODING is used for writing. + +:noquery BOOL -- Query the user unless BOOL is non-nil, and process is +running when Emacs is exited. + +:filter FILTER -- Install FILTER as the process filter. + +:sentinel SENTINEL -- Install SENTINEL as the process sentinel. + +:plist PLIST -- Install PLIST as the new process's initial plist." + (let* ((name (plist-get args :name)) + (host (plist-get args :host)) + (service (plist-get args :service)) + (proc (tls--start-process name tls-connection-command host service))) + (process-put proc :tls-args args) + (set-process-sentinel proc #'tls--sentinel) + (set-process-filter proc #'tls--filter) + proc)) + +(defun tls--sentinel (proc event) + "The default sentinel for TLS connections. + +Try the next command in the list, or fail if there are none +left." + (tls--debug "tls--sentinel %S %S" + (process-status proc) + event) + (tls--debug "Failed TLS output: %s" + (process-get proc :tls-data)) + (if (eq (process-status proc) + 'exit) + (let ((sentinel (plist-get (process-get proc :tls-args) + :sentinel))) + (when sentinel + (funcall sentinel proc (format "failed with %s\n" event)))) + (error "Unexpected event in tls sentinel: %S" event))) + +(defun tls--filter (proc data) + "The default filter for TLS connections. + +We wait until both `tls-success' and `tls-end-of-info' have been +received. Once that happens, we are done and we can switch over +to the real connection." + (let ((data (concat (or (process-get proc :tls-data) + "") + data))) + (if (and (string-match tls-success data) + (string-match tls-end-of-info data)) + (let* ((remaining-data (substring data (match-end 0))) + (args (process-get proc :tls-args)) + (buffer (plist-get args :buffer)) + (coding (plist-get args :coding)) + (noquery (plist-get args :noquery)) + (filter (plist-get args :filter)) + (sentinel (plist-get args :sentinel)) + (plist (plist-get args :plist))) + (set-process-plist proc plist) + (set-process-sentinel proc sentinel) + (set-process-filter proc filter) + (set-process-buffer proc buffer) + (if (consp coding) + (set-process-coding-system proc (car coding) (cdr coding)) + (set-process-coding-system proc coding coding)) + (set-process-query-on-exit-flag proc (not noquery)) + (when sentinel + (funcall sentinel proc "open\n")) + (when (and (not (equal remaining-data "")) + filter) + (funcall filter proc remaining-data))) + (process-put proc :tls-data data)))) + +(defun tls--start-process (name cmd host port) + "Start a single process for network communication. + +This code is mostly taken from tls.el." + (let ((process-connection-type tls-process-connection-type) + (formatted-cmd + (format-spec + cmd + (format-spec-make + ?h host + ?p (if (integerp port) + (int-to-string port) + port))))) + (tls--debug "TLS starting process: %s" formatted-cmd) + (start-process name nil + shell-file-name shell-command-switch + formatted-cmd))) + +(provide 'make-tls-process) +;;; make-tls-process.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/make-tls-process.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/make-tls-process.elc new file mode 100644 index 000000000000..d277296535d4 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/make-tls-process.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/shorten.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/shorten.el new file mode 100644 index 000000000000..1ba6085b9c91 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/shorten.el @@ -0,0 +1,223 @@ +;;; shorten.el --- component-wise string shortener + +;; Copyright (C) 2013 John J Foerch <jjfoerch@earthlink.net> + +;; Keywords: extensions +;; Author: John J Foerch <jjfoerch@earthlink.net> +;; URL: https://github.com/jorgenschaefer/circe/blob/master/shorten.el + +;; 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 a component-wise string shortener, meaning that, given a list +;; of strings, it breaks each string into parts, then computes shortest +;; prefix of each part with respect to others of the same 'depth', such +;; that when joined back together, the shortened form of the whole string +;; remains unique within the resulting list. Many styles of shortening +;; are made possible via three functions that the caller may provide: the +;; split function, the join function, and the validate-component function. +;; +;; Strings are broken with the value of `shorten-split-function' (a +;; procedure string->list), and shortened components are rejoined with the +;; value of `shorten-join-function' (a procedure list->string[*]). The +;; default split and join functions break the string on word boundaries, +;; and rejoin on the empty string. Potential shortened forms of +;; components are tested with `shorten-validate-component-function'; its +;; default value passes only if its argument contains at least one +;; word-constituent character (regexp \w), meaning that by default, +;; components consisting entirely of non-word characters will not be +;; shortened, and components that start with non-word characters will only +;; be shortened so much that they have at least one word-constituent +;; character in them. +;; +;; The main entry point is `shorten-strings', which takes a list of strings +;; as its argument and returns an alist ((STRING . SHORTENED-STRING) ...). +;; +;; [*] Also takes a second argument; see docstring of +;; `shorten-join-function'. + +;;; History: + +;; - Version 0.1 (March 7, 2013): initial release + +;;; Code: + +;; Tree utils +;; +(defsubst shorten-make-tree-root () + (cons nil nil)) + +(defsubst shorten-tree-make-entry (token short full) + (list token short full nil)) + +(defsubst shorten-tree-token (entry) + (car entry)) + +(defsubst shorten-tree-fullname (entry) + (nth 2 entry)) + +(defsubst shorten-tree-descendants (entry) + (nthcdr 3 entry)) + +(defsubst shorten-tree-set-shortened (entry short) + (setcar (cdr entry) short)) + +(defsubst shorten-tree-set-fullname (entry full) + (setcar (nthcdr 2 entry) full)) + +(defsubst shorten-tree-insert (node item) + (when (car node) + (setcdr node (cons (car node) (cdr node)))) + (setcar node item)) + + +;; Caller configuration +;; +(defun shorten-split (s) + (split-string s "\\b" t)) + +(defun shorten-join (lst &optional tail-count) + (mapconcat #'identity lst "")) + +(defun shorten-join-sans-tail (lst tail-count) + "A shorten-join that drops unnecessary tail components." + (shorten-join (butlast lst tail-count))) + +(defun shorten-validate-component (str) + (string-match-p "\\w" str)) + +(defvar shorten-split-function #'shorten-split + "Value should be a function of string->list that breaks a +string into components. The default breaks on word-boundaries. +To get simple prefix shortening, bind this to `list'. + +Users should not generally change the global value of this +variable; instead, bind it dynamically around calls to +`shorten-strings'.") + +(defvar shorten-join-function #'shorten-join + "A function that takes a list of components and a tail-count, +and returns a joined string. Tail-count is the number of +components on the end of the list that are not needed to uniquify +the result, and so may be safely dropped if aggressive shortening +is desired. The default preserves tail components, and joins the +list on the empty string. + +Users should not generally change the global value of this +variable; instead, bind it dynamically around calls to +`shorten-strings'.") + +(defvar shorten-validate-component-function #'shorten-validate-component + "Predicate that returns t if a proposed shortened form of a +single component is acceptable, nil if a longer one should be +tried. The default validates only when the candidate contains at +least one word-constituent character, thus strings consisting of +punctuation will not be shortened. For aggressive shortening, +bind to a procedure that always returns t. + +Users should not generally change the global value of this +variable; instead, bind it dynamically around calls to +`shorten-strings'.") + + +;; Main procedures +;; +(defun shorten-one (str others) + "Return shortest unique prefix of STR among OTHERS, or STR if +it cannot be shortened. If STR is a member of OTHERS (tested +with `eq') that entry is ignored. The value of +`shorten-validate-component-function' will be used to validate +any prefix." + (let ((max (length str)) + (len 1)) + (or (catch 'return + (while (< len max) + (let ((prefix (substring str 0 len))) + (when (funcall shorten-validate-component-function prefix) + (when (catch 'return + (dolist (other others t) + (when (and (>= (length other) len) + (string= (substring other 0 len) prefix) + (not (eq other str))) + (throw 'return nil)))) + (throw 'return prefix))) + (setq len (1+ len))))) + str))) + +(defun shorten-walk-internal (node path tail-count result-out) + (let ((others (mapcar #'car node))) + (setq tail-count (if (cdr node) 0 (1+ tail-count))) + (dolist (entry node) + (let* ((token (shorten-tree-token entry)) + (shortened (shorten-one token others)) + (path (cons shortened path)) + (fullname (shorten-tree-fullname entry)) + (descendants (shorten-tree-descendants entry)) + (have-descendants (not (equal '(nil) descendants)))) + (shorten-tree-set-shortened entry shortened) + ;; if this entry has a fullname, add to result-out + (when fullname + (let ((joined (funcall shorten-join-function + (reverse path) + (if have-descendants 0 tail-count)))) + (shorten-tree-insert result-out (cons fullname joined)))) + ;; if this entry has descendants, recurse + (when have-descendants + (shorten-walk-internal descendants path + (if fullname -1 tail-count) + result-out)))))) + +(defun shorten-walk (tree) + "Takes a tree of the type made by `shorten-make-tree' and +returns an alist ((STRING . SHORTENED-STRING) ...). Uses +`shorten-join-function' to join shortened components back +together into SHORTENED-STRING. See also +`shorten-validate-component-function'." + (let ((result-out (shorten-make-tree-root))) + (shorten-walk-internal tree '() -1 result-out) + (if (equal '(nil) result-out) nil result-out))) + +(defun shorten-make-tree (strings) + "Takes a list of strings and returns a tree of the type used by +`shorten-walk' to generate shortened strings. Uses +`shorten-split-function' to split the strings." + (let ((tree (shorten-make-tree-root))) + (dolist (s strings) + (let ((node tree) + (tokens (funcall shorten-split-function s)) + (entry nil)) + ;; create a path in tree for tokens + (dolist (token tokens) + (setq entry (assoc token node)) + (when (not entry) + (setq entry (shorten-tree-make-entry token nil nil)) + (shorten-tree-insert node entry)) + (setq node (shorten-tree-descendants entry))) + ;; for the last token, set 'fullname' + (shorten-tree-set-fullname entry s))) + (if (equal tree '(nil)) nil tree))) + +;;;###autoload +(defun shorten-strings (strings) + "Takes a list of strings and returns an alist ((STRING +. SHORTENED-STRING) ...). Uses `shorten-split-function' to split +the strings, and `shorten-join-function' to join shortened +components back together into SHORTENED-STRING. See also +`shorten-validate-component-function'." + (shorten-walk (shorten-make-tree strings))) + + +(provide 'shorten) +;;; shorten.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/shorten.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/shorten.elc new file mode 100644 index 000000000000..12bce2477efd --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/shorten.elc Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el new file mode 100644 index 000000000000..8fd53fcb2910 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el @@ -0,0 +1,428 @@ +;;; tracking.el --- Buffer modification tracking + +;; Copyright (C) 2006, 2012 - 2015 Jorgen Schaefer + +;; Author: Jorgen Schaefer <forcer@forcix.cx> +;; URL: https://github.com/jorgenschaefer/circe/wiki/Tracking + +;; 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: + +;; tracking.el is a library for other Emacs Lisp programs not useful +;; by itself. + +;; The library provides a way to globally register buffers as being +;; modified and scheduled for user review. The user can cycle through +;; the buffers using C-c C-SPC. This is especially useful for buffers +;; that interact with external sources, such as chat clients and +;; similar programs. + +;;; Code: + +(require 'easy-mmode) +(require 'shorten) +(require 'cl-lib) + +;;; User customization +(defgroup tracking nil + "Tracking of buffer activities." + :prefix "tracking-" + :group 'applications) + +(defcustom tracking-shorten-buffer-names-p t + "Whether to shorten buffer names in the mode line. +A non-nil value will cause tracked buffer names to be shortened +as much as possible to stay unambiguous when displaying them in +the mode line." + :type 'boolean + :group 'tracking) + +(defcustom tracking-frame-behavior 'visible + "How to deal with frams to determine visibility of buffers. +This is passed as the second argument to `get-buffer-window', +see there for further explanation." + :type '(choice (const :tag "All visible frames" visible) + (const :tag "Visible and iconified frames" 0) + (const :tag "All frames" t) + (const :tag "Selected frame only" nil)) + :group 'tracking) + +(defcustom tracking-position 'before-modes + "Where tracked buffers should appear in the mode line. + + 'before-modes + Before the mode indicators + 'after-modes + After the mode indicators + 'end + At the end of the mode line" + :type '(choice (const :tag "Before the Mode Indicators" before-modes) + (const :tag "Afterthe Mode Indicators" after-modes) + (const :tag "At the End of the Mode Line" end)) + :group 'tracking) + +(defcustom tracking-faces-priorities nil + "A list of faces which should be shown by tracking in the mode line. +The first face found in this list is used." + :type '(repeat face) + :group 'tracking) + +(defcustom tracking-ignored-buffers nil + "A list of buffers that are never tracked. +Each element of this list has one of the following forms: + + regexp - Any buffer matching won't be tracked. + function - Any buffer matching won't be tracked. + (regexp faces ...) - Any buffer matching won't be tracked, + unless it has a face in FACES ... associated with it. + If no faces are given, `tracking-faces-priorities' is + used. + (function faces ...) - As per above, but with a function + as predicate instead of a regexp." + :type '(repeat (choice regexp + function + (list (choice regexp function) + (repeat face)))) + :group 'tracking) + +(defcustom tracking-most-recent-first nil + "When non-nil, newly tracked buffers will go to the front of the +list, rather than to the end." + :type 'boolean + :group 'tracking) + +(defcustom tracking-sort-faces-first nil + "When non-nil, tracked buffers with any highlight face will go to +the front of the tracking list. + +See `tracking-most-recent-first' for whether they are appended at the +front or the back of the highlighted buffers." + :type 'boolean + :group 'tracking) + +(defcustom tracking-buffer-added-hook nil + "Hook run when a buffer has some activity. + +The functions are run in the context of the buffer. + +This can also happen when the buffer is already tracked. Check if the +buffer name is in `tracking-buffers' if you want to see if it was +added before." + :type 'hook + :group 'tracking) + +(defcustom tracking-buffer-removed-hook nil + "Hook run when a buffer becomes active and is removed. + +The functions are run in the context of the buffer." + :type 'hook + :group 'tracking) + +(defcustom tracking-max-mode-line-entries nil + "Maximum number of buffers shown in the mode-line. + +If set to nil, all buffers will be shown." + :type '(choice (const :tag "All" nil) + (integer :tag "Maximum")) + :group 'tracking) + +;;; Internal variables +(defvar tracking-buffers nil + "The list of currently tracked buffers.") + +(defvar tracking-mode-line-buffers "" + "The entry to the mode line.") +(put 'tracking-mode-line-buffers 'risky-local-variable t) + +(defvar tracking-start-buffer nil + "The buffer we started from when cycling through the active buffers.") + +(defvar tracking-last-buffer nil + "The buffer we last switched to with `tracking-next-buffer'. +When this is not the current buffer when we continue switching, a +new `tracking-start-buffer' is created.") + +(defvar tracking-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-SPC") 'tracking-next-buffer) + (define-key map (kbd "C-c C-@") 'tracking-next-buffer) + map) + "The keymap used for tracking mode.") + +;;;###autoload +(define-minor-mode tracking-mode + "Allow cycling through modified buffers. +This mode in itself does not track buffer modification, but +provides an API for programs to add buffers as modified (using +`tracking-add-buffer'). + +Once this mode is active, modified buffers are shown in the mode +line. The user can cycle through them using +\\[tracking-next-buffer]." + :group 'tracking + :global t + (cond + (tracking-mode + (cond + ((eq tracking-position 'before-modes) + (let ((head nil) + (tail (default-value 'mode-line-format))) + (when (not (memq 'tracking-mode-line-buffers tail)) + (catch 'return + (while tail + (if (not (eq (car tail) + 'mode-line-modes)) + (setq head (cons (car tail) + head) + tail (cdr tail)) + (setq-default mode-line-format + (append (reverse head) + '(tracking-mode-line-buffers) + tail)) + (throw 'return t))))))) + ((eq tracking-position 'after-modes) + (add-to-list 'mode-line-misc-info + 'tracking-mode-line-buffers)) + ((eq tracking-position 'end) + (add-to-list 'mode-line-misc-info + 'tracking-mode-line-buffers + t)) + (t + (error "Invalid value for `tracking-position' (%s)" tracking-position))) + (add-hook 'window-configuration-change-hook + 'tracking-remove-visible-buffers)) + (t + (setq mode-line-misc-info (delq 'tracking-mode-line-buffers + mode-line-misc-info)) + (setq-default mode-line-format (delq 'tracking-mode-line-buffers + (default-value 'mode-line-format))) + (remove-hook 'window-configuration-change-hook + 'tracking-remove-visible-buffers)))) + +;;;###autoload +(defun tracking-add-buffer (buffer &optional faces) + "Add BUFFER as being modified with FACES. +This does check whether BUFFER is currently visible. + +If FACES is given, it lists the faces that might be appropriate +for BUFFER in the mode line. The highest-priority face of these +and the current face of the buffer, if any, is used. Priority is +decided according to `tracking-faces-priorities'. +When `tracking-sort-faces-first' is non-nil, all buffers with any +face set will be stable-sorted before any buffers with no face set." + (when (and (not (get-buffer-window buffer tracking-frame-behavior)) + (not (tracking-ignored-p buffer faces))) + (with-current-buffer buffer + (run-hooks 'tracking-buffer-added-hook)) + (let* ((entry (member (buffer-name buffer) + tracking-buffers))) + (if entry + (setcar entry (tracking-faces-merge (car entry) + faces)) + (setq tracking-buffers + (if tracking-most-recent-first + (cons (tracking-faces-merge (buffer-name buffer) + faces) + tracking-buffers) + (nconc tracking-buffers + (list (tracking-faces-merge (buffer-name buffer) + faces))))))) + (when tracking-sort-faces-first + (let ((with-any-face (cl-remove-if-not + (lambda (str) (get-text-property 0 'face str)) + tracking-buffers)) + (with-no-face (cl-remove-if + (lambda (str) (get-text-property 0 'face str)) + tracking-buffers))) + (setq tracking-buffers (nconc with-any-face with-no-face)))) + (setq tracking-mode-line-buffers (tracking-status)) + (force-mode-line-update t) + )) + +;;;###autoload +(defun tracking-remove-buffer (buffer) + "Remove BUFFER from being tracked." + (when (member (buffer-name buffer) + tracking-buffers) + (with-current-buffer buffer + (run-hooks 'tracking-buffer-removed-hook))) + (setq tracking-buffers (delete (buffer-name buffer) + tracking-buffers)) + (setq tracking-mode-line-buffers (tracking-status)) + (sit-for 0) ;; Update mode line + ) + +;;;###autoload +(defun tracking-next-buffer () + "Switch to the next active buffer." + (interactive) + (cond + ((and (not tracking-buffers) + tracking-start-buffer) + (let ((buf tracking-start-buffer)) + (setq tracking-start-buffer nil) + (if (buffer-live-p buf) + (switch-to-buffer buf) + (message "Original buffer does not exist anymore") + (ding)))) + ((not tracking-buffers) + nil) + (t + (when (not (eq tracking-last-buffer + (current-buffer))) + (setq tracking-start-buffer (current-buffer))) + (let ((new (car tracking-buffers))) + (when (buffer-live-p (get-buffer new)) + (with-current-buffer new + (run-hooks 'tracking-buffer-removed-hook))) + (setq tracking-buffers (cdr tracking-buffers) + tracking-mode-line-buffers (tracking-status)) + (if (buffer-live-p (get-buffer new)) + (switch-to-buffer new) + (message "Buffer %s does not exist anymore" new) + (ding) + (setq tracking-mode-line-buffers (tracking-status)))) + (setq tracking-last-buffer (current-buffer)) + ;; Update mode line. See `force-mode-line-update' for the idea for + ;; this code. Using `sit-for' can be quite inefficient for larger + ;; buffers. + (dolist (w (window-list)) + (with-current-buffer (window-buffer w))) + ))) + +;;;###autoload +(defun tracking-previous-buffer () + "Switch to the last active buffer." + (interactive) + (when tracking-buffers + (switch-to-buffer (car (last tracking-buffers))))) + +(defun tracking-ignored-p (buffer faces) + "Return non-nil when BUFFER with FACES shouldn't be tracked. +This uses `tracking-ignored-buffers'. Actual returned value is +the entry from tracking-ignored-buffers that causes this buffer +to be ignored." + (catch 'return + (let ((buffer-name (buffer-name buffer))) + (dolist (entry tracking-ignored-buffers) + (cond + ((stringp entry) + (and (string-match entry buffer-name) + (throw 'return entry))) + ((functionp entry) + (and (funcall entry buffer-name) + (throw 'return entry))) + ((or (and (stringp (car entry)) + (string-match (car entry) buffer-name)) + (and (functionp (car entry)) + (funcall (car entry) buffer-name))) + (when (not (tracking-any-in (or (cdr entry) + tracking-faces-priorities) + faces)) + (throw 'return entry)))))) + nil)) + +(defun tracking-status () + "Return the current track status. + +This returns a list suitable for `mode-line-format'. +If `tracking-max-mode-line-entries' is a positive integer, +only return that many entries, ending with '+n'." + (if (not tracking-buffers) + "" + (let* ((buffer-names (cl-remove-if-not #'get-buffer tracking-buffers)) + (shortened-names (tracking-shorten tracking-buffers)) + (result (list " [")) + (i 0)) + (cl-block exit + (while buffer-names + (push `(:propertize + ,(car shortened-names) + face ,(get-text-property 0 'face (car buffer-names)) + keymap ,(let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] + `(lambda () + (interactive) + (pop-to-buffer ,(car buffer-names)))) + map) + mouse-face mode-line-highlight + help-echo ,(format (concat "New activity in %s\n" + "mouse-1: pop to the buffer") + (car buffer-names))) + result) + (cl-incf i) + (setq buffer-names (cdr buffer-names) + shortened-names (cdr shortened-names)) + (when (and tracking-max-mode-line-entries + buffer-names + (>= i tracking-max-mode-line-entries)) + (push (concat " +" (number-to-string (length buffer-names))) result) + (cl-return-from exit)) + (when buffer-names + (push "," result)))) + (push "] " result) + (nreverse result)))) + +(defun tracking-remove-visible-buffers () + "Remove visible buffers from the tracked buffers. +This is usually called via `window-configuration-changed-hook'." + (interactive) + (dolist (buffer-name tracking-buffers) + (let ((buffer (get-buffer buffer-name))) + (cond + ((not buffer) + (setq tracking-buffers (delete buffer-name tracking-buffers)) + (setq tracking-mode-line-buffers (tracking-status)) + (sit-for 0)) + ((get-buffer-window buffer tracking-frame-behavior) + (tracking-remove-buffer buffer)))))) + +;;; Helper functions +(defun tracking-shorten (buffers) + "Shorten BUFFERS according to `tracking-shorten-buffer-names-p'." + (if tracking-shorten-buffer-names-p + (let ((all (shorten-strings (mapcar #'buffer-name (buffer-list))))) + (mapcar (lambda (buffer) + (let ((short (cdr (assoc buffer all)))) + (set-text-properties + 0 (length short) + (text-properties-at 0 buffer) + short) + short)) + buffers)) + buffers)) + +(defun tracking-any-in (lista listb) + "Return non-nil when any element in LISTA is in LISTB" + (catch 'return + (dolist (entry lista) + (when (memq entry listb) + (throw 'return t))) + nil)) + +(defun tracking-faces-merge (string faces) + "Merge faces into string, adhering to `tracking-faces-priorities'. +This returns STRING with the new face." + (let ((faces (cons (get-text-property 0 'face string) + faces))) + (catch 'return + (dolist (candidate tracking-faces-priorities) + (when (memq candidate faces) + (throw 'return + (propertize string 'face candidate)))) + string))) + +(provide 'tracking) +;;; tracking.el ends here diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.elc new file mode 100644 index 000000000000..75c63bd44933 --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.elc Binary files differ |