diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/circe-20180525.1231/tracking.el | 428 |
1 files changed, 0 insertions, 428 deletions
diff --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 |