about summary refs log tree commit diff
path: root/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2018-09-10T18·51-0400
committerWilliam Carroll <wpcarro@gmail.com>2018-09-10T18·53-0400
commit17ee0e400bef47c371afcae76037f9ea6a44ad13 (patch)
tree0e5efee6f00e402890e91f3eceb4b29408a498b6 /configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el
parent8b2fadf4776b7ddb4a67b4bc8ff6463770e56028 (diff)
Support Vim, Tmux, Emacs with Stow
After moving off of Meta, Dotfiles has a greater responsibility to
manage configs. Vim, Tmux, and Emacs are now within Stow's purview.
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el')
-rw-r--r--configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el428
1 files changed, 428 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el
new file mode 100644
index 000000000000..8fd53fcb2910
--- /dev/null
+++ b/configs/shared/emacs/.emacs.d/elpa/circe-20180525.531/tracking.el
@@ -0,0 +1,428 @@
+;;; tracking.el --- Buffer modification tracking
+
+;; Copyright (C) 2006, 2012 - 2015  Jorgen Schaefer
+
+;; Author: Jorgen Schaefer <forcer@forcix.cx>
+;; URL: https://github.com/jorgenschaefer/circe/wiki/Tracking
+
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; tracking.el is a library for other Emacs Lisp programs not useful
+;; by itself.
+
+;; The library provides a way to globally register buffers as being
+;; modified and scheduled for user review. The user can cycle through
+;; the buffers using C-c C-SPC. This is especially useful for buffers
+;; that interact with external sources, such as chat clients and
+;; similar programs.
+
+;;; Code:
+
+(require 'easy-mmode)
+(require 'shorten)
+(require 'cl-lib)
+
+;;; User customization
+(defgroup tracking nil
+  "Tracking of buffer activities."
+  :prefix "tracking-"
+  :group 'applications)
+
+(defcustom tracking-shorten-buffer-names-p t
+  "Whether to shorten buffer names in the mode line.
+A non-nil value will cause tracked buffer names to be shortened
+as much as possible to stay unambiguous when displaying them in
+the mode line."
+  :type 'boolean
+  :group 'tracking)
+
+(defcustom tracking-frame-behavior 'visible
+  "How to deal with frams to determine visibility of buffers.
+This is passed as the second argument to `get-buffer-window',
+see there for further explanation."
+  :type '(choice (const :tag "All visible frames" visible)
+                 (const :tag "Visible and iconified frames" 0)
+                 (const :tag "All frames" t)
+                 (const :tag "Selected frame only" nil))
+  :group 'tracking)
+
+(defcustom tracking-position 'before-modes
+  "Where tracked buffers should appear in the mode line.
+
+  'before-modes
+      Before the mode indicators
+  'after-modes
+      After the mode indicators
+  'end
+      At the end of the mode line"
+  :type '(choice (const :tag "Before the Mode Indicators" before-modes)
+                 (const :tag "Afterthe Mode Indicators" after-modes)
+                 (const :tag "At the End of the Mode Line" end))
+  :group 'tracking)
+
+(defcustom tracking-faces-priorities nil
+  "A list of faces which should be shown by tracking in the mode line.
+The first face found in this list is used."
+  :type '(repeat face)
+  :group 'tracking)
+
+(defcustom tracking-ignored-buffers nil
+  "A list of buffers that are never tracked.
+Each element of this list has one of the following forms:
+
+  regexp - Any buffer matching won't be tracked.
+  function - Any buffer matching won't be tracked.
+  (regexp faces ...) - Any buffer matching won't be tracked,
+      unless it has a face in FACES ... associated with it.
+      If no faces are given, `tracking-faces-priorities' is
+      used.
+  (function faces ...) - As per above, but with a function
+      as predicate instead of a regexp."
+  :type '(repeat (choice regexp
+                         function
+                         (list (choice regexp function)
+                               (repeat face))))
+  :group 'tracking)
+
+(defcustom tracking-most-recent-first nil
+  "When non-nil, newly tracked buffers will go to the front of the
+list, rather than to the end."
+  :type 'boolean
+  :group 'tracking)
+
+(defcustom tracking-sort-faces-first nil
+  "When non-nil, tracked buffers with any highlight face will go to
+the front of the tracking list.
+
+See `tracking-most-recent-first' for whether they are appended at the
+front or the back of the highlighted buffers."
+  :type 'boolean
+  :group 'tracking)
+
+(defcustom tracking-buffer-added-hook nil
+  "Hook run when a buffer has some activity.
+
+The functions are run in the context of the buffer.
+
+This can also happen when the buffer is already tracked. Check if the
+buffer name is in `tracking-buffers' if you want to see if it was
+added before."
+  :type 'hook
+  :group 'tracking)
+
+(defcustom tracking-buffer-removed-hook nil
+  "Hook run when a buffer becomes active and is removed.
+
+The functions are run in the context of the buffer."
+  :type 'hook
+  :group 'tracking)
+
+(defcustom tracking-max-mode-line-entries nil
+  "Maximum number of buffers shown in the mode-line.
+
+If set to nil, all buffers will be shown."
+  :type '(choice (const :tag "All" nil)
+                 (integer :tag "Maximum"))
+  :group 'tracking)
+
+;;; Internal variables
+(defvar tracking-buffers nil
+  "The list of currently tracked buffers.")
+
+(defvar tracking-mode-line-buffers ""
+  "The entry to the mode line.")
+(put 'tracking-mode-line-buffers 'risky-local-variable t)
+
+(defvar tracking-start-buffer nil
+  "The buffer we started from when cycling through the active buffers.")
+
+(defvar tracking-last-buffer nil
+  "The buffer we last switched to with `tracking-next-buffer'.
+When this is not the current buffer when we continue switching, a
+new `tracking-start-buffer' is created.")
+
+(defvar tracking-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "C-c C-SPC") 'tracking-next-buffer)
+    (define-key map (kbd "C-c C-@") 'tracking-next-buffer)
+    map)
+  "The keymap used for tracking mode.")
+
+;;;###autoload
+(define-minor-mode tracking-mode
+  "Allow cycling through modified buffers.
+This mode in itself does not track buffer modification, but
+provides an API for programs to add buffers as modified (using
+`tracking-add-buffer').
+
+Once this mode is active, modified buffers are shown in the mode
+line. The user can cycle through them using
+\\[tracking-next-buffer]."
+  :group 'tracking
+  :global t
+  (cond
+   (tracking-mode
+    (cond
+     ((eq tracking-position 'before-modes)
+      (let ((head nil)
+            (tail (default-value 'mode-line-format)))
+        (when (not (memq 'tracking-mode-line-buffers tail))
+          (catch 'return
+            (while tail
+              (if (not (eq (car tail)
+                           'mode-line-modes))
+                  (setq head (cons (car tail)
+                                   head)
+                        tail (cdr tail))
+                (setq-default mode-line-format
+                              (append (reverse head)
+                                      '(tracking-mode-line-buffers)
+                                      tail))
+                (throw 'return t)))))))
+     ((eq tracking-position 'after-modes)
+      (add-to-list 'mode-line-misc-info
+                   'tracking-mode-line-buffers))
+     ((eq tracking-position 'end)
+      (add-to-list 'mode-line-misc-info
+                   'tracking-mode-line-buffers
+                   t))
+     (t
+      (error "Invalid value for `tracking-position' (%s)" tracking-position)))
+    (add-hook 'window-configuration-change-hook
+              'tracking-remove-visible-buffers))
+   (t
+    (setq mode-line-misc-info (delq 'tracking-mode-line-buffers
+                                    mode-line-misc-info))
+    (setq-default mode-line-format (delq 'tracking-mode-line-buffers
+                                         (default-value 'mode-line-format)))
+    (remove-hook 'window-configuration-change-hook
+                 'tracking-remove-visible-buffers))))
+
+;;;###autoload
+(defun tracking-add-buffer (buffer &optional faces)
+  "Add BUFFER as being modified with FACES.
+This does check whether BUFFER is currently visible.
+
+If FACES is given, it lists the faces that might be appropriate
+for BUFFER in the mode line. The highest-priority face of these
+and the current face of the buffer, if any, is used. Priority is
+decided according to `tracking-faces-priorities'.
+When `tracking-sort-faces-first' is non-nil, all buffers with any
+face set will be stable-sorted before any buffers with no face set."
+  (when (and (not (get-buffer-window buffer tracking-frame-behavior))
+             (not (tracking-ignored-p buffer faces)))
+    (with-current-buffer buffer
+      (run-hooks 'tracking-buffer-added-hook))
+    (let* ((entry (member (buffer-name buffer)
+                          tracking-buffers)))
+      (if entry
+          (setcar entry (tracking-faces-merge (car entry)
+                                              faces))
+        (setq tracking-buffers
+              (if tracking-most-recent-first
+                  (cons (tracking-faces-merge (buffer-name buffer)
+                                              faces)
+                        tracking-buffers)
+                  (nconc tracking-buffers
+                         (list (tracking-faces-merge (buffer-name buffer)
+                                                     faces)))))))
+    (when tracking-sort-faces-first
+      (let ((with-any-face (cl-remove-if-not
+                            (lambda (str) (get-text-property 0 'face str))
+                            tracking-buffers))
+            (with-no-face (cl-remove-if
+                           (lambda (str) (get-text-property 0 'face str))
+                           tracking-buffers)))
+        (setq tracking-buffers (nconc with-any-face with-no-face))))
+    (setq tracking-mode-line-buffers (tracking-status))
+    (force-mode-line-update t)
+    ))
+
+;;;###autoload
+(defun tracking-remove-buffer (buffer)
+  "Remove BUFFER from being tracked."
+  (when (member (buffer-name buffer)
+                tracking-buffers)
+    (with-current-buffer buffer
+      (run-hooks 'tracking-buffer-removed-hook)))
+  (setq tracking-buffers (delete (buffer-name buffer)
+                                 tracking-buffers))
+  (setq tracking-mode-line-buffers (tracking-status))
+  (sit-for 0) ;; Update mode line
+  )
+
+;;;###autoload
+(defun tracking-next-buffer ()
+  "Switch to the next active buffer."
+  (interactive)
+  (cond
+   ((and (not tracking-buffers)
+         tracking-start-buffer)
+    (let ((buf tracking-start-buffer))
+      (setq tracking-start-buffer nil)
+      (if (buffer-live-p buf)
+          (switch-to-buffer buf)
+        (message "Original buffer does not exist anymore")
+        (ding))))
+   ((not tracking-buffers)
+    nil)
+   (t
+    (when (not (eq tracking-last-buffer
+                   (current-buffer)))
+      (setq tracking-start-buffer (current-buffer)))
+    (let ((new (car tracking-buffers)))
+      (when (buffer-live-p (get-buffer new))
+        (with-current-buffer new
+          (run-hooks 'tracking-buffer-removed-hook)))
+      (setq tracking-buffers (cdr tracking-buffers)
+            tracking-mode-line-buffers (tracking-status))
+      (if (buffer-live-p (get-buffer new))
+          (switch-to-buffer new)
+        (message "Buffer %s does not exist anymore" new)
+        (ding)
+        (setq tracking-mode-line-buffers (tracking-status))))
+    (setq tracking-last-buffer (current-buffer))
+    ;; Update mode line. See `force-mode-line-update' for the idea for
+    ;; this code. Using `sit-for' can be quite inefficient for larger
+    ;; buffers.
+    (dolist (w (window-list))
+      (with-current-buffer (window-buffer w)))
+    )))
+
+;;;###autoload
+(defun tracking-previous-buffer ()
+  "Switch to the last active buffer."
+  (interactive)
+  (when tracking-buffers
+    (switch-to-buffer (car (last tracking-buffers)))))
+
+(defun tracking-ignored-p (buffer faces)
+  "Return non-nil when BUFFER with FACES shouldn't be tracked.
+This uses `tracking-ignored-buffers'.  Actual returned value is
+the entry from tracking-ignored-buffers that causes this buffer
+to be ignored."
+  (catch 'return
+    (let ((buffer-name (buffer-name buffer)))
+      (dolist (entry tracking-ignored-buffers)
+        (cond
+         ((stringp entry)
+          (and (string-match entry buffer-name)
+               (throw 'return entry)))
+         ((functionp entry)
+          (and (funcall entry buffer-name)
+               (throw 'return entry)))
+         ((or (and (stringp (car entry))
+                   (string-match (car entry) buffer-name))
+              (and (functionp (car entry))
+                   (funcall (car entry) buffer-name)))
+          (when (not (tracking-any-in (or (cdr entry)
+                                          tracking-faces-priorities)
+                                      faces))
+            (throw 'return entry))))))
+    nil))
+
+(defun tracking-status ()
+  "Return the current track status.
+
+This returns a list suitable for `mode-line-format'.
+If `tracking-max-mode-line-entries' is a positive integer,
+only return that many entries, ending with '+n'."
+  (if (not tracking-buffers)
+      ""
+    (let* ((buffer-names (cl-remove-if-not #'get-buffer tracking-buffers))
+           (shortened-names (tracking-shorten tracking-buffers))
+           (result (list " ["))
+           (i 0))
+      (cl-block exit
+        (while buffer-names
+          (push `(:propertize
+                  ,(car shortened-names)
+                  face ,(get-text-property 0 'face (car buffer-names))
+                  keymap ,(let ((map (make-sparse-keymap)))
+                            (define-key map [mode-line down-mouse-1]
+                              `(lambda ()
+                                 (interactive)
+                                 (pop-to-buffer ,(car buffer-names))))
+                            map)
+                  mouse-face mode-line-highlight
+                  help-echo ,(format (concat "New activity in %s\n"
+                                             "mouse-1: pop to the buffer")
+                                     (car buffer-names)))
+                result)
+          (cl-incf i)
+          (setq buffer-names (cdr buffer-names)
+                shortened-names (cdr shortened-names))
+          (when (and tracking-max-mode-line-entries
+                     buffer-names
+                     (>= i tracking-max-mode-line-entries))
+            (push (concat " +" (number-to-string (length buffer-names))) result)
+            (cl-return-from exit))
+          (when buffer-names
+            (push "," result))))
+      (push "] " result)
+      (nreverse result))))
+
+(defun tracking-remove-visible-buffers ()
+  "Remove visible buffers from the tracked buffers.
+This is usually called via `window-configuration-changed-hook'."
+  (interactive)
+  (dolist (buffer-name tracking-buffers)
+    (let ((buffer (get-buffer buffer-name)))
+      (cond
+       ((not buffer)
+        (setq tracking-buffers (delete buffer-name tracking-buffers))
+        (setq tracking-mode-line-buffers (tracking-status))
+        (sit-for 0))
+       ((get-buffer-window buffer tracking-frame-behavior)
+        (tracking-remove-buffer buffer))))))
+
+;;; Helper functions
+(defun tracking-shorten (buffers)
+  "Shorten BUFFERS according to `tracking-shorten-buffer-names-p'."
+  (if tracking-shorten-buffer-names-p
+      (let ((all (shorten-strings (mapcar #'buffer-name (buffer-list)))))
+        (mapcar (lambda (buffer)
+                  (let ((short (cdr (assoc buffer all))))
+                    (set-text-properties
+                     0 (length short)
+                     (text-properties-at 0 buffer)
+                     short)
+                    short))
+                buffers))
+    buffers))
+
+(defun tracking-any-in (lista listb)
+  "Return non-nil when any element in LISTA is in LISTB"
+  (catch 'return
+    (dolist (entry lista)
+      (when (memq entry listb)
+        (throw 'return t)))
+    nil))
+
+(defun tracking-faces-merge (string faces)
+  "Merge faces into string, adhering to `tracking-faces-priorities'.
+This returns STRING with the new face."
+  (let ((faces (cons (get-text-property 0 'face string)
+                     faces)))
+    (catch 'return
+      (dolist (candidate tracking-faces-priorities)
+        (when (memq candidate faces)
+          (throw 'return
+                 (propertize string 'face candidate))))
+      string)))
+
+(provide 'tracking)
+;;; tracking.el ends here