Browse Source

Stole +ivy/tasks from doom-emacs

master
Josh Wolfe 2 years ago
parent
commit
ed9a2cd3e3

+ 1
- 1
emacs/.emacs.d/README.org View File

@@ -1745,7 +1745,7 @@ Stores all backups and temp files in =~/.bak.emacs/=
(setq todo-file-path "c:/dev/SideProjects/todo-projectile/todo-projectile.el"))
(when (file-exists-p todo-file-path)
(load-file todo-file-path)
(setq org-project-use-ag t)))
(setq todo-projectile-use-ag t)))
#+END_SRC

** Extract Dates

+ 0
- 322
emacs/.emacs.d/lisp/command-log-mode.el View File

@@ -1,322 +0,0 @@
;;; command-log-mode.el --- log keyboard commands to buffer

;; homepage: https://github.com/lewang/command-log-mode

;; Copyright (C) 2013 Nic Ferrier
;; Copyright (C) 2012 Le Wang
;; Copyright (C) 2004 Free Software Foundation, Inc.

;; Author: Michael Weber <michaelw@foldr.org>
;; Keywords: help
;; Initial-version: <2004-10-07 11:41:28 michaelw>
;; Time-stamp: <2004-11-06 17:08:11 michaelw>

;; This file 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, or (at your option)
;; any later version.

;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This add-on can be used to demo Emacs to an audience. When
;; activated, keystrokes get logged into a designated buffer, along
;; with the command bound to them.

;; To enable, use e.g.:
;;
;; (require 'command-log-mode)
;; (add-hook 'LaTeX-mode-hook 'command-log-mode)
;;
;; To see the log buffer, call M-x clm/open-command-log-buffer.

;; The key strokes in the log are decorated with ISO9601 timestamps on
;; the property `:time' so if you want to convert the log for
;; screencasting purposes you could use the time stamp as a key into
;; the video beginning.

;;; Code:

(eval-when-compile (require 'cl))

(defvar clm/log-text t
"A non-nil setting means text will be saved to the command log.")

(defvar clm/log-repeat nil
"A nil setting means repetitions of the same command are merged into the single log line.")

(defvar clm/recent-history-string ""
"This string will hold recently typed text.")

(defun clm/recent-history ()
(setq clm/recent-history-string
(concat clm/recent-history-string
(buffer-substring-no-properties (- (point) 1) (point)))))

(add-hook 'post-self-insert-hook 'clm/recent-history)

(defun clm/zap-recent-history ()
(unless (or (member this-original-command
clm/log-command-exceptions*)
(eq this-original-command #'self-insert-command))
(setq clm/recent-history-string "")))

(add-hook 'post-command-hook 'clm/zap-recent-history)

(defvar clm/time-string "%Y-%m-%dT%H:%M:%S"
"The string sent to `format-time-string' when command time is logged.")

(defvar clm/logging-dir "~/log/"
"Directory in which to store files containing logged commands.")

(defvar clm/log-command-exceptions*
'(nil self-insert-command backward-char forward-char
delete-char delete-backward-char backward-delete-char
backward-delete-char-untabify
universal-argument universal-argument-other-key
universal-argument-minus universal-argument-more
beginning-of-line end-of-line recenter
move-end-of-line move-beginning-of-line
handle-switch-frame
newline previous-line next-line)
"A list commands which should not be logged, despite logging being enabled.
Frequently used non-interesting commands (like cursor movements) should be put here.")

(defvar clm/command-log-buffer nil
"Reference of the currenly used buffer to display logged commands.")
(defvar clm/command-repetitions 0
"Count of how often the last keyboard commands has been repeated.")
(defvar clm/last-keyboard-command nil
"Last logged keyboard command.")


(defvar clm/log-command-indentation 11
"*Indentation of commands in command log buffer.")

(defgroup command-log nil
"Customization for the command log.")

(defcustom command-log-mode-auto-show nil
"Show the command-log window or frame automatically."
:group 'command-log
:type 'boolean)

(defcustom command-log-mode-window-size 40
"The size of the command-log window."
:group 'command-log
:type 'integer)

(defcustom command-log-mode-window-font-size 2
"The font-size of the command-log window."
:group 'command-log
:type 'integer)

(defcustom command-log-mode-key-binding-open-log "C-c o"
"The key binding used to toggle the log window."
:group 'command-log
:type '(radio
(const :tag "No key" nil)
(key-sequence "C-c o"))) ;; this is not right though it works for kbd

(defcustom command-log-mode-open-log-turns-on-mode nil
"Does opening the command log turn on the mode?"
:group 'command-log
:type 'boolean)

(defcustom command-log-mode-is-global nil
"Does turning on command-log-mode happen globally?"
:group 'command-log
:type 'boolean)

;;;###autoload
(define-minor-mode command-log-mode
"Toggle keyboard command logging."
:init-value nil
:lighter " command-log"
:keymap nil
(if command-log-mode
(when (and
command-log-mode-auto-show
(not (get-buffer-window clm/command-log-buffer)))
(clm/open-command-log-buffer))
;; We can close the window though
(clm/close-command-log-buffer)))

(define-global-minor-mode global-command-log-mode command-log-mode
command-log-mode)

(defun clm/buffer-log-command-p (cmd &optional buffer)
"Determines whether keyboard command CMD should be logged.
If non-nil, BUFFER specifies the buffer used to determine whether CMD should be logged.
If BUFFER is nil, the current buffer is assumed."
(let ((val (if buffer
(buffer-local-value command-log-mode buffer)
command-log-mode)))
(and (not (null val))
(null (member cmd clm/log-command-exceptions*)))))

(defmacro clm/save-command-environment (&rest body)
(declare (indent 0))
`(let ((deactivate-mark nil) ; do not deactivate mark in transient
; mark mode
;; do not let random commands scribble over
;; {THIS,LAST}-COMMAND
(this-command this-command)
(last-command last-command))
,@body))

(defun clm/open-command-log-buffer (&optional arg)
"Opens (and creates, if non-existant) a buffer used for logging keyboard commands.
If ARG is Non-nil, the existing command log buffer is cleared."
(interactive "P")
(with-current-buffer
(setq clm/command-log-buffer
(get-buffer-create " *command-log*"))
(text-scale-set 1))
(when arg
(with-current-buffer clm/command-log-buffer
(erase-buffer)))
(let ((new-win (split-window-horizontally
(- 0 command-log-mode-window-size))))
(set-window-buffer new-win clm/command-log-buffer)
(set-window-dedicated-p new-win t)))

(defun clm/close-command-log-buffer ()
"Close the command log window."
(interactive)
(with-current-buffer
(setq clm/command-log-buffer
(get-buffer-create " *command-log*"))
(let ((win (get-buffer-window (current-buffer))))
(when (windowp win)
(delete-window win)))))

;;;###autoload
(defun clm/toggle-command-log-buffer (&optional arg)
"Toggle the command log showing or not."
(interactive "P")
(when (and command-log-mode-open-log-turns-on-mode
(not command-log-mode))
(if command-log-mode-is-global
(global-command-log-mode)
(command-log-mode)))
(with-current-buffer
(setq clm/command-log-buffer
(get-buffer-create " *command-log*"))
(let ((win (get-buffer-window (current-buffer))))
(if (windowp win)
(clm/close-command-log-buffer)
;; Else open the window
(clm/open-command-log-buffer arg)))))

(defun clm/scroll-buffer-window (buffer &optional move-fn)
"Updates `point' of windows containing BUFFER according to MOVE-FN.
If non-nil, MOVE-FN is called on every window which displays BUFFER.
If nil, MOVE-FN defaults to scrolling to the bottom, making the last line visible.

Scrolling up can be accomplished with:
\(clm/scroll-buffer-window buf (lambda () (goto-char (point-min))))
"
(let ((selected (selected-window))
(point-mover (or move-fn
(function (lambda () (goto-char (point-max)))))))
(walk-windows (function (lambda (window)
(when (eq (window-buffer window) buffer)
(select-window window)
(funcall point-mover)
(select-window selected))))
nil t)))

(defmacro clm/with-command-log-buffer (&rest body)
(declare (indent 0))
`(when (and (not (null clm/command-log-buffer))
(buffer-name clm/command-log-buffer))
(with-current-buffer clm/command-log-buffer
,@body)))

(defun clm/log-command (&optional cmd)
"Hook into `pre-command-hook' to intercept command activation."
(clm/save-command-environment
(setq cmd (or cmd this-command))
(when (clm/buffer-log-command-p cmd)
(clm/with-command-log-buffer
(let ((current (current-buffer)))
(goto-char (point-max))
(cond ((and (not clm/log-repeat) (eq cmd clm/last-keyboard-command))
(incf clm/command-repetitions)
(save-match-data
(when (and (> clm/command-repetitions 1)
(search-backward "[" (line-beginning-position -1) t))
(delete-region (point) (line-end-position))))
(backward-char) ; skip over either ?\newline or ?\space before ?\[
(insert " [")
(princ (1+ clm/command-repetitions) current)
(insert " times]"))
(t ;; (message "last cmd: %s cur: %s" last-command cmd)
;; showing accumulated text with interleaved key presses isn't very useful
(when (and clm/log-text (not clm/log-repeat))
(if (eq clm/last-keyboard-command 'self-insert-command)
(insert "[text: " clm/recent-history-string "]\n")))
(setq clm/command-repetitions 0)
(insert
(propertize
(key-description (this-command-keys))
:time (format-time-string clm/time-string (current-time))))
(when (>= (current-column) clm/log-command-indentation)
(newline))
(move-to-column clm/log-command-indentation t)
(princ (if (byte-code-function-p cmd) "<bytecode>" cmd) current)
(newline)
(setq clm/last-keyboard-command cmd)))
(clm/scroll-buffer-window current))))))

(defun clm/command-log-clear ()
"Clear the command log buffer."
(interactive)
(with-current-buffer clm/command-log-buffer
(erase-buffer)))

(defun clm/save-log-line (start end)
"Helper function for `clm/save-command-log' to export text properties."
(save-excursion
(goto-char start)
(let ((time (get-text-property (point) :time)))
(if time
(list (cons start (if time
(concat "[" (get-text-property (point) :time) "] ")
"")))))))

(defun clm/save-command-log ()
"Save commands to today's log.
Clears the command log buffer after saving."
(interactive)
(save-window-excursion
(set-buffer (get-buffer " *command-log*"))
(goto-char (point-min))
(let ((now (format-time-string "%Y-%m-%d"))
(write-region-annotate-functions '(clm/save-log-line)))
(while (and (re-search-forward "^.*" nil t)
(not (eobp)))
(append-to-file (line-beginning-position) (1+ (line-end-position)) (concat clm/logging-dir now))))
(clm/command-log-clear)))

(add-hook 'pre-command-hook 'clm/log-command)

(eval-after-load 'command-log-mode
'(when command-log-mode-key-binding-open-log
(global-set-key
(kbd command-log-mode-key-binding-open-log)
'clm/toggle-command-log-buffer)))

(provide 'command-log-mode)

;;; command-log-mode.el ends here

+ 96
- 0
emacs/.emacs.d/lisp/doom-todo-ivy.el View File

@@ -0,0 +1,96 @@
;;; -*- lexical-binding: t; -*-

(defvar doom/ivy-buffer-icons nil
"If non-nil, show buffer mode icons in `ivy-switch-buffer' and the like.")

(defvar doom/ivy-task-tags
'(("TODO" . warning)
("XXX" . warning)
("BUG" . error)
("FIXME" . error))
"An alist of tags for `doom/ivy-tasks' to include in its search, whose CDR is the
face to render it with.")

(defun doom/ivy--tasks-candidates (tasks)
"Generate a list of task tags (specified by `doom/ivy-task-tags') for
`doom/ivy-tasks'."
(let* ((max-type-width
(cl-loop for task in doom/ivy-task-tags maximize (length (car task))))
(max-desc-width
(cl-loop for task in tasks maximize (length (cl-cdadr task))))
(max-width (max (- (frame-width) (1+ max-type-width) max-desc-width)
25)))
(cl-loop
with fmt = (format "%%-%ds %%-%ds%%s%%s:%%s" max-type-width max-width)
for alist in tasks
collect
(let-alist alist
(format fmt
(propertize .type 'face (cdr (assoc .type doom/ivy-task-tags)))
(string-trim (substring .desc 0 (min max-desc-width (length .desc))))
(propertize " | " 'face 'font-lock-comment-face)
(propertize (abbreviate-file-name .file) 'face 'font-lock-keyword-face)
(propertize .line 'face 'font-lock-constant-face))))))

(defun doom/ivy--tasks (target)
(let* (case-fold-search
(task-tags (mapcar #'car doom/ivy-task-tags))
(cmd
(format "%s -H -S --noheading -- %s %s"
(or (when-let* ((bin (executable-find "rg")))
(concat bin " --line-number"))
(when-let* ((bin (executable-find "ag")))
(concat bin " --numbers"))
(error "ripgrep & the_silver_searcher are unavailable"))
(shell-quote-argument
(concat "\\s("
(string-join task-tags "|")
")([\\s:]|\\([^)]+\\):?)"))
target)))
(save-match-data
(cl-loop with out = (replace-regexp-in-string "c:" "" (replace-regexp-in-string "\\\\" "/" (shell-command-to-string cmd)))
for x in (and out (split-string out "\n" t))
when (condition-case-unless-debug ex
(string-match
(concat "^\\([^:]+\\):\\([0-9]+\\):.+\\("
(string-join task-tags "\\|")
"\\):?\\s-*\\(.+\\)")
x)
(error
(message! (red "Error matching task in file: (%s) %s"
(error-message-string ex)
(car (split-string x ":"))))
nil))
collect `((type . ,(match-string 3 x))
(desc . ,(match-string 4 x))
(file . ,(match-string 1 x))
(line . ,(match-string 2 x)))))))

(defun doom/ivy--tasks-open-action (x)
"Jump to the file and line of the current task."
(let ((location (cadr (split-string x " | ")))
(type (car (split-string x " "))))
(cl-destructuring-bind (file line) (split-string location ":")
(with-ivy-window
(find-file (expand-file-name file (projectile-project-root)))
(goto-char (point-min))
(forward-line (1- (string-to-number line)))
(search-forward type (line-end-position) t)
(backward-char (length type))
(recenter)))))

;;;###autoload
(defun doom/ivy-tasks (&optional arg)
"Search through all TODO/FIXME tags in the current project. If ARG, only
search current file. See `doom/ivy-task-tags' to customize what this searches for."
(interactive "P")
(ivy-read (format "Tasks (%s): "
(if arg
(concat "in: " (file-relative-name buffer-file-name))
"project"))
(doom/ivy--tasks-candidates
(doom/ivy--tasks (if arg buffer-file-name (projectile-project-root))))
:action #'doom/ivy--tasks-open-action
:caller 'doom/ivy-tasks))

(provide 'doom-todo-ivy)

+ 0
- 97
emacs/.emacs.d/lisp/init-powerline-doom-one.el View File

@@ -1,97 +0,0 @@
(defface my-pl-segment1-active
'((t (:foreground "#181E26" :background "#51AFEF")))
"Powerline first segment active face.")
(defface my-pl-segment1-inactive
'((t (:foreground "#FFFFFF" :background "#404850")))
"Powerline first segment inactive face.")
(defface my-pl-segment2-active
'((t (:foreground "#DFDFDF" :background "#1f5582")))
"Powerline second segment active face.")
(defface my-pl-segment2-inactive
'((t (:foreground "#FFFFFF" :background "#404850")))
"Powerline second segment inactive face.")
(defface my-pl-segment3-active
'((t (:foreground "#DFDFDF" :background "#22252C")))
"Powerline third segment active face.")
(defface my-pl-segment3-inactive
'((t (:foreground "#FFFFFF" :background "#22252C")))
"Powerline third segment inactive face.")

(defun air--powerline-default-theme ()
"Set up my custom Powerline with Evil indicators."
(interactive)
(setq-default mode-line-format
'("%e"
(:eval
(let* ((active (powerline-selected-window-active))
(seg1 (if active 'my-pl-segment1-active 'my-pl-segment1-inactive))
(seg2 (if active 'my-pl-segment2-active 'my-pl-segment2-inactive))
(seg3 (if active 'my-pl-segment3-active 'my-pl-segment3-inactive))
(separator-left (intern (format "powerline-%s-%s"
(powerline-current-separator)
(car powerline-default-separator-dir))))
(separator-right (intern (format "powerline-%s-%s"
(powerline-current-separator)
(cdr powerline-default-separator-dir))))
(lhs (list (let ((evil-face (powerline-evil-face)))
(if evil-mode
(powerline-raw (powerline-evil-tag) evil-face)
))
(if evil-mode
(funcall separator-left (powerline-evil-face) seg1))
;;(when powerline-display-buffer-size
;; (powerline-buffer-size nil 'l))
;;(when powerline-display-mule-info
;; (powerline-raw mode-line-mule-info nil 'l))
(powerline-buffer-id seg1 'l)
(powerline-raw "[%*]" seg1 'l)
(when (and (boundp 'which-func-mode) which-func-mode)
(powerline-raw which-func-format seg1 'l))
(powerline-raw " " seg1)
(funcall separator-left seg1 seg2)
(when (boundp 'erc-modified-channels-object)
(powerline-raw erc-modified-channels-object seg2 'l))
(powerline-major-mode seg2 'l)
(powerline-process seg2)
(powerline-minor-modes seg2 'l)
(powerline-narrow seg2 'l)
(powerline-raw " " seg2)
(funcall separator-left seg2 seg3)
(powerline-vc seg3 'r)
(when (bound-and-true-p nyan-mode)
(powerline-raw (list (nyan-create)) seg3 'l))))
(rhs (list (powerline-raw global-mode-string seg3 'r)
(funcall separator-right seg3 seg2)
(unless window-system
(powerline-raw (char-to-string #xe0a1) seg2 'l))
(powerline-raw "%4l" seg2 'l)
(powerline-raw ":" seg2 'l)
(powerline-raw "%3c" seg2 'r)
(funcall separator-right seg2 seg1)
(powerline-raw " " seg1)
(powerline-raw "%6p" seg1 'r)
(when powerline-display-hud
(powerline-hud seg1 seg3)))))
(concat (powerline-render lhs)
(powerline-fill seg3 (powerline-width rhs))
(powerline-render rhs)))))))

(custom-set-faces
'(powerline-evil-emacs-face ((t (:inherit powerline-evil-base-face :background "#ff6c6b"))))
'(powerline-evil-insert-face ((t (:inherit powerline-evil-base-face :background "#CDB464"))))
'(powerline-evil-normal-face ((t (:inherit powerline-evil-base-face :background "#404850"))))
'(powerline-evil-replace-face ((t (:inherit powerline-evil-base-face :background "#da8548"))))
'(powerline-evil-visual-face ((t (:inherit powerline-evil-base-face :background "#C678DD"))))
'(powerline-evil-operator-face ((t (:inherit powerline-evil-operator-face :background "#5699AF")))))

(use-package powerline
:ensure t
:config
(setq powerline-default-separator (if (display-graphic-p) 'slant
nil))
(air--powerline-default-theme))

(use-package powerline-evil
:ensure t)

(provide 'init-powerline-doom-one)

+ 0
- 89
emacs/.emacs.d/lisp/init-powerline.el View File

@@ -1,89 +0,0 @@
(defface my-pl-segment1-active
'((t (:foreground "#000000" :background "#E1B61A")))
"Powerline first segment active face.")
(defface my-pl-segment1-inactive
'((t (:foreground "#CEBFF3" :background "#3A2E58")))
"Powerline first segment inactive face.")
(defface my-pl-segment2-active
'((t (:foreground "#F5E39F" :background "#8A7119")))
"Powerline second segment active face.")
(defface my-pl-segment2-inactive
'((t (:foreground "#CEBFF3" :background "#3A2E58")))
"Powerline second segment inactive face.")
(defface my-pl-segment3-active
'((t (:foreground "#CEBFF3" :background "#3A2E58")))
"Powerline third segment active face.")
(defface my-pl-segment3-inactive
'((t (:foreground "#CEBFF3" :background "#3A2E58")))
"Powerline third segment inactive face.")

(defun air--powerline-default-theme ()
"Set up my custom Powerline with Evil indicators."
(interactive)
(setq-default mode-line-format
'("%e"
(:eval
(let* ((active (powerline-selected-window-active))
(seg1 (if active 'my-pl-segment1-active 'my-pl-segment1-inactive))
(seg2 (if active 'my-pl-segment2-active 'my-pl-segment2-inactive))
(seg3 (if active 'my-pl-segment3-active 'my-pl-segment3-inactive))
(separator-left (intern (format "powerline-%s-%s"
(powerline-current-separator)
(car powerline-default-separator-dir))))
(separator-right (intern (format "powerline-%s-%s"
(powerline-current-separator)
(cdr powerline-default-separator-dir))))
(lhs (list (let ((evil-face (powerline-evil-face)))
(if evil-mode
(powerline-raw (powerline-evil-tag) evil-face)
))
(if evil-mode
(funcall separator-left (powerline-evil-face) seg1))
;;(when powerline-display-buffer-size
;; (powerline-buffer-size nil 'l))
;;(when powerline-display-mule-info
;; (powerline-raw mode-line-mule-info nil 'l))
(powerline-buffer-id seg1 'l)
(powerline-raw "[%*]" seg1 'l)
(when (and (boundp 'which-func-mode) which-func-mode)
(powerline-raw which-func-format seg1 'l))
(powerline-raw " " seg1)
(funcall separator-left seg1 seg2)
(when (boundp 'erc-modified-channels-object)
(powerline-raw erc-modified-channels-object seg2 'l))
(powerline-major-mode seg2 'l)
(powerline-process seg2)
(powerline-minor-modes seg2 'l)
(powerline-narrow seg2 'l)
(powerline-raw " " seg2)
(funcall separator-left seg2 seg3)
(powerline-vc seg3 'r)
(when (bound-and-true-p nyan-mode)
(powerline-raw (list (nyan-create)) seg3 'l))))
(rhs (list (powerline-raw global-mode-string seg3 'r)
(funcall separator-right seg3 seg2)
(unless window-system
(powerline-raw (char-to-string #xe0a1) seg2 'l))
(powerline-raw "%4l" seg2 'l)
(powerline-raw ":" seg2 'l)
(powerline-raw "%3c" seg2 'r)
(funcall separator-right seg2 seg1)
(powerline-raw " " seg1)
(powerline-raw "%6p" seg1 'r)
(when powerline-display-hud
(powerline-hud seg1 seg3)))))
(concat (powerline-render lhs)
(powerline-fill seg3 (powerline-width rhs))
(powerline-render rhs)))))))

(use-package powerline
:ensure t
:config
(setq powerline-default-separator (if (display-graphic-p) 'slant
nil))
(air--powerline-default-theme))

(use-package powerline-evil
:ensure t)

(provide 'init-powerline)

+ 0
- 227
emacs/.emacs.d/lisp/zoom.el View File

@@ -1,227 +0,0 @@
;;; zoom.el --- Fixed and automatic balanced window layout

;; Copyright (c) 2017 Andrea Cardaci <cyrus.and@gmail.com>
;;
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

;; Author: Andrea Cardaci <cyrus.and@gmail.com>
;; Version: 0.1.0
;; URL: https://github.com/cyrus-and/zoom
;; Package-Requires: ((emacs "24.4"))
;; Keywords: frames

;;; Commentary:

;; This minor mode takes care of managing the window sizes by enforcing a fixed
;; and automatic balanced layout where the currently selected window is resized
;; according to `zoom-size' which can be an absolute value in lines/columns, a
;; ratio between the selected window and frame size or even a custom callback.

;;; Code:

(defgroup zoom nil
"Enforce a fixed and automatic balanced window layout."
:group 'windows)

(defcustom zoom-size '(80 . 24)
"Size hint for the selected window.

It can be either a cons or a function.

Each component of the cons can be either an absolute value in
lines/columns or a ratio between the selected window and the
frame size. In the former case the window is resized according
to its body size, i.e., the total window size can be much larger.
In any case, windows are never shrinked if they are already
larger than the resulting size.

The function takes no arguments and returns a cons as specified
above."
:type '(choice (function :tag "Custom")
(cons :tag "Fixed"
(choice (integer :tag "Columns")
(float :tag "Width ratio"))
(choice (integer :tag "Lines")
(float :tag "Height ratio"))))
:safe 'consp
:group 'zoom)

(defcustom zoom-ignored-major-modes nil
"List of ignored major modes.

Selected windows using any of these major modes should not be
enlarged (only balanced)."
:type '(repeat symbol)
:group 'zoom)

(defcustom zoom-ignored-buffer-names nil
"List of ignored buffer names.

Selected windows displaying any of these buffers should not be
enlarged (only balanced)."
:type '(repeat string)
:group 'zoom)

(defcustom zoom-ignored-buffer-name-regexps nil
"List of ignored buffer name regexps.

Selected windows displaying buffers matching any of these regexps
should not be enlarged (only balanced)."
:type '(repeat regexp)
:group 'zoom)

(defcustom zoom-ignore-predicates nil
"List of additional predicates that allow to ignore windows.

These functions are called (in order) to decide whether the
selected window should be ignored (only balanced) or not.
Predicates take no parameters and as soon as one function returns
a non-nil value, the selected window is ignored and the others
are not called."
:type '(repeat function)
:group 'zoom)

;;;###autoload
(define-minor-mode zoom-mode
"Enforce a fixed and automatic balanced window layout."
:global t
:lighter " Z"
:require 'zoom
(if zoom-mode
(zoom--on)
(zoom--off)))

;;;###autoload
(defun zoom ()
"Zoom the current window and balance the others."
(interactive)
;; manual invocation only works when this mode is disabled
(if zoom-mode
(message "Window zooming is automatic (M-x zoom-mode to disable)")
(zoom--update)))

(defun zoom--on ()
"Enable hooks and advices and update the layout."
(add-hook 'window-size-change-functions 'zoom--hook-handler)
(advice-add 'select-window :after 'zoom--hook-handler)
;; update the layout once loaded
(dolist (frame (frame-list))
(with-selected-frame frame
(zoom--hook-handler))))

(defun zoom--off ()
"Disable hooks and advices and evenly balance the windows."
(remove-hook 'window-size-change-functions 'zoom--hook-handler)
(advice-remove 'select-window 'zoom--hook-handler)
;; leave with a clean layout
(dolist (frame (frame-list))
(balance-windows frame)))

(defun zoom--hook-handler (&rest arguments)
"Handle an update event.

ARGUMENTS is ignored."
;; check if should actually update
(unless (or (not zoom-mode)
(window-minibuffer-p)
;; `one-window-p' does not work well with the completion buffer
;; when emacsclient is used
(frame-root-window-p (selected-window)))
(zoom--update)))

(defun zoom--update ()
"Update the window layout in the current frame."
;; temporarily disables this mode during resize to avoid infinite recursion
;; and enable `window-combination-resize' too ensure that other windows are
;; resized nicely after resizing the selected one
(let ((zoom-mode nil)
(window-combination-resize t))
;; start from a balanced layout anyway
(balance-windows)
;; check if the selected window is not ignored
(unless (zoom--window-ignored-p)
(zoom--resize)
(zoom--fix-scroll))))

(defun zoom--window-ignored-p ()
"Check whether the selected window will be ignored or not."
(or
;; check against the major mode
(member major-mode zoom-ignored-major-modes)
;; check against the buffer name
(member (buffer-name) zoom-ignored-buffer-names)
;; check against the buffer name (using a regexp)
(catch 'ignored
(dolist (regex zoom-ignored-buffer-name-regexps)
(when (string-match regex (buffer-name))
(throw 'ignored t))))
;; check user-defined predicates
(catch 'ignored
(dolist (predicate zoom-ignore-predicates)
(when (funcall predicate)
(throw 'ignored t))))))

(defun zoom--resize ()
"Resize the selected window according to the user preference."
(let ((size-hint-cons
;; either use the cons as is or call the custom function
(if (functionp zoom-size) (funcall zoom-size) zoom-size)))
(zoom--resize-one-side size-hint-cons t)
(zoom--resize-one-side size-hint-cons nil)))

(defun zoom--resize-one-side (size-hint-cons horizontal)
"Resize one dimension of the selected window according to the user preference.

Argument SIZE-HINT-CONS is the size hint provided by the user.

Argument HORIZONTAL determines whether the window should be
resized horizontally or vertically."
(let* ((size-hint
(if horizontal (car size-hint-cons) (cdr size-hint-cons)))
(frame-size
(if horizontal (frame-width) (frame-height)))
;; use the total size (including fringes, scroll bars, etc.) for ratios
;; and the body size for absolute values
(window-size
(if (floatp size-hint)
(if horizontal (window-total-width) (window-total-height))
(if horizontal (window-body-width) (window-body-height))))
;; either use an absolute value or a ratio
(min-window-size
(if (floatp size-hint) (round (* size-hint frame-size)) size-hint))
;; do not shrink the window if it is already large enough
(desired-delta (max (- min-window-size window-size) 0))
;; fall back to the maximum available if the windows are too small
(delta (window-resizable nil desired-delta horizontal)))
;; actually resize the window
(window-resize nil delta horizontal)))

(defun zoom--fix-scroll ()
"Fix the horizontal scrolling if needed."
;; scroll all the way to the left border
(scroll-right (window-hscroll))
;; if the window is not wide enough to contain the point scroll to center
;; unless lines are not truncated
(when (and truncate-lines
(> (current-column) (- (window-body-width) hscroll-margin)))
(scroll-left (- (current-column) (/ (window-body-width) 2)))))

(provide 'zoom)

;;; zoom.el ends here

Loading…
Cancel
Save