diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231')
38 files changed, 0 insertions, 9629 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-autoloads.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-autoloads.el deleted file mode 100644 index c886e994b93a..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-autoloads.el +++ /dev/null @@ -1,226 +0,0 @@ -;;; 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" (23450 31940 148862 789000)) -;;; 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" -;;;;;; (23450 31940 157109 795000)) -;;; 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" -;;;;;; (23450 31940 150680 309000)) -;;; 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" (23450 31940 -;;;;;; 158742 648000)) -;;; 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" -;;;;;; (23450 31940 155387 224000)) -;;; 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" (23450 31940 -;;;;;; 145441 433000)) -;;; 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" (23450 -;;;;;; 31940 129328 821000)) -;;; 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" (23450 31940 -;;;;;; 161840 905000)) -;;; 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" (23450 31940 147061 -;;;;;; 445000)) -;;; 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" (23450 31940 138249 -;;;;;; 945000)) -;;; 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") (23450 31940 160246 405000)) - -;;;*** - -;; 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.1231/circe-chanop.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-chanop.el deleted file mode 100644 index a5880e5f8c1e..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-chanop.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; 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.1231/circe-chanop.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-chanop.elc deleted file mode 100644 index 5b27c801d03b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-chanop.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el deleted file mode 100644 index dd5e64e04fa6..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.el +++ /dev/null @@ -1,340 +0,0 @@ -;;; 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.1231/circe-color-nicks.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.elc deleted file mode 100644 index 8758a95984c6..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-color-nicks.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-compat.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-compat.el deleted file mode 100644 index f509c66d5b14..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-compat.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; 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.1231/circe-compat.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-compat.elc deleted file mode 100644 index bd4554cbacfa..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-compat.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el deleted file mode 100644 index 6c9e29a251e8..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.el +++ /dev/null @@ -1,197 +0,0 @@ -;;; 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.1231/circe-display-images.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.elc deleted file mode 100644 index 4ebbda193bf7..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-display-images.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-lagmon.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-lagmon.el deleted file mode 100644 index 42a37329ca5f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-lagmon.el +++ /dev/null @@ -1,243 +0,0 @@ -;;; 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.1231/circe-lagmon.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-lagmon.elc deleted file mode 100644 index 39353b9814f9..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-lagmon.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-new-day-notifier.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-new-day-notifier.el deleted file mode 100644 index 88d9a4b350eb..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-new-day-notifier.el +++ /dev/null @@ -1,86 +0,0 @@ -;;; 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.1231/circe-new-day-notifier.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-new-day-notifier.elc deleted file mode 100644 index 070093319b4a..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-new-day-notifier.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-pkg.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-pkg.el deleted file mode 100644 index 9f9374238dfa..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe-pkg.el +++ /dev/null @@ -1,6 +0,0 @@ -(define-package "circe" "20180525.1231" "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.1231/circe.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el deleted file mode 100644 index 721044dd2aff..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.el +++ /dev/null @@ -1,3602 +0,0 @@ -;;; 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.1231/circe.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.elc deleted file mode 100644 index d04c2ac73210..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/circe.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/irc.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/irc.el deleted file mode 100644 index 04b260c75a43..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/irc.el +++ /dev/null @@ -1,1413 +0,0 @@ -;;; 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.1231/irc.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/irc.elc deleted file mode 100644 index 9c9cd1508ce8..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/irc.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lcs.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lcs.el deleted file mode 100644 index b5beb12ef145..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lcs.el +++ /dev/null @@ -1,202 +0,0 @@ -;;; 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.1231/lcs.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lcs.elc deleted file mode 100644 index 2db8b77a4ccd..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lcs.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-autopaste.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-autopaste.el deleted file mode 100644 index 7582839c268d..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-autopaste.el +++ /dev/null @@ -1,115 +0,0 @@ -;;; 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.1231/lui-autopaste.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-autopaste.elc deleted file mode 100644 index bbef287ff911..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-autopaste.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-format.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-format.el deleted file mode 100644 index 68cc0ff000a0..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-format.el +++ /dev/null @@ -1,198 +0,0 @@ -;;; 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.1231/lui-format.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-format.elc deleted file mode 100644 index 6d94859e5f85..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-format.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-irc-colors.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-irc-colors.el deleted file mode 100644 index 9b16ead2f953..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-irc-colors.el +++ /dev/null @@ -1,182 +0,0 @@ -;;; 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.1231/lui-irc-colors.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-irc-colors.elc deleted file mode 100644 index 658dc80d7b4b..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-irc-colors.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-logging.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-logging.el deleted file mode 100644 index d24e051f92ad..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-logging.el +++ /dev/null @@ -1,201 +0,0 @@ -;;; 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.1231/lui-logging.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-logging.elc deleted file mode 100644 index 2fa75d9c2a6f..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-logging.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-track-bar.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-track-bar.el deleted file mode 100644 index 360ecf69d550..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-track-bar.el +++ /dev/null @@ -1,110 +0,0 @@ -;;; 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.1231/lui-track-bar.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-track-bar.elc deleted file mode 100644 index 3fbf759b6562..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui-track-bar.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui.el deleted file mode 100644 index 07cc758f29c0..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui.el +++ /dev/null @@ -1,1513 +0,0 @@ -;;; 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.1231/lui.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui.elc deleted file mode 100644 index 5d812f5dc4b5..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/lui.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/make-tls-process.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/make-tls-process.el deleted file mode 100644 index aa7508568b96..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/make-tls-process.el +++ /dev/null @@ -1,194 +0,0 @@ -;;; 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.1231/make-tls-process.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/make-tls-process.elc deleted file mode 100644 index d277296535d4..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/make-tls-process.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el deleted file mode 100644 index 1ba6085b9c91..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.el +++ /dev/null @@ -1,223 +0,0 @@ -;;; 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.1231/shorten.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.elc deleted file mode 100644 index 12bce2477efd..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/shorten.elc +++ /dev/null Binary files differdiff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.el deleted file mode 100644 index 8fd53fcb2910..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.el +++ /dev/null @@ -1,428 +0,0 @@ -;;; 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.1231/tracking.elc b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.elc deleted file mode 100644 index 75c63bd44933..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.elc +++ /dev/null Binary files differ |