diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/#org-custom.el# | 64 | ||||
| -rw-r--r-- | lisp/cpp.el | 54 | ||||
| -rw-r--r-- | lisp/general.el | 57 | ||||
| -rw-r--r-- | lisp/hl-line.el | 298 | ||||
| -rw-r--r-- | lisp/js-mode-custom.el | 20 | ||||
| -rw-r--r-- | lisp/minimap.el | 936 | ||||
| m--------- | lisp/neotree | 0 | ||||
| -rw-r--r-- | lisp/neotree.el | 2226 | ||||
| -rw-r--r-- | lisp/org-bullets.el | 126 | ||||
| -rw-r--r-- | lisp/org-custom.el | 68 | ||||
| -rw-r--r-- | lisp/perfect-margin.el | 336 | ||||
| -rw-r--r-- | lisp/smooth-scrolling.el | 327 | ||||
| -rw-r--r-- | lisp/text.el | 7 |
13 files changed, 4519 insertions, 0 deletions
diff --git a/lisp/#org-custom.el# b/lisp/#org-custom.el# new file mode 100644 index 0000000..8fbc6a0 --- /dev/null +++ b/lisp/#org-custom.el# @@ -0,0 +1,64 @@ +;; https://zzamboni.org/post/beautifying-org-mode-in-emacs/ + +(defun org-custom-hook() + (setq org-hide-emphasis-markers t) + (font-lock-add-keywords 'org-mode + '(("^ *\\([-]\\) " + (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) "•")))))) + + (let* ((variable-tuple + (cond ((x-list-fonts "ETBembo") '(:font "ETBembo")) + ((x-list-fonts "Source Sans Pro") '(:font "Source Sans Pro")) + ((x-list-fonts "Lucida Grande") '(:font "Lucida Grande")) + ((x-list-fonts "Verdana") '(:font "Verdana")) + ((x-family-fonts "Sans Serif") '(:family "Sans Serif")) + (nil (warn "Cannot find a Sans Serif Font. Install Source Sans Pro.")))) + (base-font-color (face-foreground 'default nil 'default)) + (headline `(:inherit default :weight bold :foreground ,base-font-color))) + + (custom-theme-set-faces + 'user + `(org-level-8 ((t (,@headline ,@variable-tuple)))) + `(org-level-7 ((t (,@headline ,@variable-tuple)))) + `(org-level-6 ((t (,@headline ,@variable-tuple)))) + `(org-level-5 ((t (,@headline ,@variable-tuple)))) + `(org-level-4 ((t (,@headline ,@variable-tuple :height 0.8)))) + `(org-level-3 ((t (,@headline ,@variable-tuple :height 0.9)))) + `(org-level-2 ((t (,@headline ,@variable-tuple :height 1.0)))) + `(org-level-1 ((t (,@headline ,@variable-tuple :height 1.25)))) + `(org-document-title ((t (,@headline ,@variable-tuple :height 1.5 :underline nil)))))) + + (custom-theme-set-faces + 'user + '(org-block ((t (:inherit fixed-pitch)))) + '(org-code ((t (:inherit (shadow fixed-pitch))))) + '(org-document-info ((t (:foreground "dark orange")))) + '(org-document-info-keyword ((t (:inherit (shadow fixed-pitch))))) + '(org-indent ((t (:inherit (org-hide fixed-pitch))))) + '(org-link ((t (:foreground "royal blue" :underline t)))) + '(org-meta-line ((t (:inherit (font-lock-comment-face fixed-pitch))))) + '(org-property-value ((t (:inherit fixed-pitch))) t) + '(org-special-keyword ((t (:inherit (font-lock-comment-face fixed-pitch))))) + '(org-table ((t (:inherit fixed-pitch :foreground "#83a598")))) + '(org-tag ((t (:inherit (shadow fixed-pitch) :weight bold :height 0.8)))) + '(org-verbatim ((t (:inherit (shadow fixed-pitch)))))) + + (variable-pitch-mode) + (visual-line-mode) + + (require 'org-bullets) + (org-bullets-mode 1) + + (setq org-blank-before-new-entry (quote ((heading . nil) + (plain-list-item . nil)))) +) + +(custom-set-variables + '(org-directory "~/Documents/org") + '(org-agenda-files (list org-directory))) + +(setq org-todo-keywords + '((sequence "TODO" "PROGRESS" "VERIFY" "|" "DONE" "ABANDONED"))) + +(provide 'org-custom) + diff --git a/lisp/cpp.el b/lisp/cpp.el new file mode 100644 index 0000000..0fca237 --- /dev/null +++ b/lisp/cpp.el @@ -0,0 +1,54 @@ +(defun setup-c() + (setq c++-tab-always-indent 0) + (setq c-basic-offset 4) ;; Default is 2 + (setq c-indent-level 4) ;; Default is 2 + (c-set-offset 'brace-list-open 0) + + + (setq tab-stop-list '(4 8 12 16 20 24 28 32 36 40 44 48 52 56 60)) + (setq tab-width 4) + (electric-indent-mode 0) + ) + +;; == irony-mode == +(use-package irony + :ensure t + :defer t + :init + (add-hook 'c++-mode-hook 'irony-mode) + (add-hook 'c-mode-hook 'irony-mode) + (add-hook 'objc-mode-hook 'irony-mode) + :config + ;; replace the `completion-at-point' and `complete-symbol' bindings in + ;; irony-mode's buffers by irony-mode's function + (defun my-irony-mode-hook () + (define-key irony-mode-map [remap completion-at-point] + 'irony-completion-at-point-async) + (define-key irony-mode-map [remap complete-symbol] + 'irony-completion-at-point-async)) + (add-hook 'irony-mode-hook 'my-irony-mode-hook) + (add-hook 'irony-mode-hook 'irony-cdb-autosetup-compile-options) + ) + +;; == company-mode == +(use-package company + :ensure t + :defer t + :init (add-hook 'after-init-hook 'global-company-mode) + :config + (use-package company-irony :ensure t :defer t) + (setq company-idle-delay nil + company-minimum-prefix-length 2 + company-show-numbers t + company-tooltip-limit 20 + company-dabbrev-downcase nil + company-backends '((company-irony company-gtags)) + ) + :bind ("C-;" . company-complete-common) + ) + +;; Flycheck +(eval-after-load 'flycheck + '(add-hook 'flycheck-mode-hook #'flycheck-irony-setup)) + +(provide 'cpp) diff --git a/lisp/general.el b/lisp/general.el new file mode 100644 index 0000000..f6f447b --- /dev/null +++ b/lisp/general.el @@ -0,0 +1,57 @@ +(defun setup-general() + ;; menu bars + (menu-bar-mode -1) + (toggle-scroll-bar -1) + (tool-bar-mode -1) + (setq mac-shift-modifier 'meta) + + ;; Default Values + ;(setq-default indent-tabs-mode t) ; use spaces only if nil + (setq-default tab-width 4) ; Assuming you want your tabs to be four spaces wide + (set-face-attribute 'default nil :font "Droid Sans Mono-12") + (set-fontset-font t nil "Courier New" nil 'append) + (set-fontset-font t '(?😊 . ?😎) "Segoe UI Emoji") + + ;;(set-face-attribute 'default nil :height 110 :family "Consolas") + (set-language-environment "UTF-8") + (set-default-coding-systems 'utf-8) + + ;; Cursor + (setq-default cursor-type 'bar) + (blink-cursor-mode 1) + + ;; Margin + (global-linum-mode 1) + ;; (require 'minimap) + ;; (minimap-mode 1) + (require 'perfect-margin) + (perfect-margin-mode 1) + + ;; Highlight line + (require 'hl-line) + (global-hl-line-mode 1) + (set-face-background hl-line-face "#EFEFEF") + + ;; Initialization screen + (setq inhibit-splash-screen t) + (setq initial-scratch-message "") + (setq initial-major-mode 'text-mode) + + ;; Projectile for projects + (require 'projectile) + (projectile-mode +1) + (define-key projectile-mode-map (kbd "C-c p") 'projectile-command-map) + + ;; Tree + (require 'neotree) + (global-set-key [f8] 'neotree-toggle) + (setq neo-smart-open t) + (setq projectile-switch-project-action 'neotree-projectile-action) + (setq neo-theme (if (display-graphic-p) 'icons 'arrow)) + + ;; Smooth scroll + (require 'smooth-scrolling) + (smooth-scrolling-mode 1) +) + +(provide 'general) diff --git a/lisp/hl-line.el b/lisp/hl-line.el new file mode 100644 index 0000000..26cfcc3 --- /dev/null +++ b/lisp/hl-line.el @@ -0,0 +1,298 @@ +;;; hl-line.el --- highlight the current line -*- lexical-binding:t -*- + +;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc. + +;; Author: Dave Love <fx@gnu.org> +;; Maintainer: emacs-devel@gnu.org +;; Created: 1998-09-13 +;; Keywords: faces, frames, emulations + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Provides a local minor mode (toggled by M-x hl-line-mode) and +;; a global minor mode (toggled by M-x global-hl-line-mode) to +;; highlight, on a suitable terminal, the line on which point is. The +;; global mode highlights the current line in the selected window only +;; (except when the minibuffer window is selected). This was +;; implemented to satisfy a request for a feature of Lesser Editors. +;; The local mode is sticky: it highlights the line about the buffer's +;; point even if the buffer's window is not selected. Caveat: the +;; buffer's point might be different from the point of a non-selected +;; window. Set the variable `hl-line-sticky-flag' to nil to make the +;; local mode behave like the global mode. + +;; You probably don't really want to use the global mode; if the +;; cursor is difficult to spot, try changing its color, relying on +;; `blink-cursor-mode' or both. The hookery used might affect +;; response noticeably on a slow machine. The local mode may be +;; useful in non-editing buffers such as Gnus or PCL-CVS though. + +;; An overlay is used. In the non-sticky cases, this overlay is +;; active only on the selected window. A hook is added to +;; `post-command-hook' to activate the overlay and move it to the line +;; about point. + +;; You could make variable `global-hl-line-mode' buffer-local and set +;; it to nil to avoid highlighting specific buffers, when the global +;; mode is used. + +;; By default the whole line is highlighted. The range of highlighting +;; can be changed by defining an appropriate function as the +;; buffer-local value of `hl-line-range-function'. + +;;; Code: + +(defvar-local hl-line-overlay nil + "Overlay used by Hl-Line mode to highlight the current line.") + +(defvar-local global-hl-line-overlay nil + "Overlay used by Global-Hl-Line mode to highlight the current line.") + +(defvar global-hl-line-overlays nil + "Overlays used by Global-Hl-Line mode in various buffers. +Global-Hl-Line keeps displaying one overlay in each buffer +when `global-hl-line-sticky-flag' is non-nil.") + +(defgroup hl-line nil + "Highlight the current line." + :version "21.1" + :group 'convenience) + +(defface hl-line + '((t :inherit highlight :extend t)) + "Default face for highlighting the current line in Hl-Line mode." + :version "22.1" + :group 'hl-line) + +(defcustom hl-line-face 'hl-line + "Face with which to highlight the current line in Hl-Line mode." + :type 'face + :group 'hl-line + :set (lambda (symbol value) + (set symbol value) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (overlayp hl-line-overlay) + (overlay-put hl-line-overlay 'face hl-line-face)))) + (when (overlayp global-hl-line-overlay) + (overlay-put global-hl-line-overlay 'face hl-line-face)))) + +(defcustom hl-line-sticky-flag t + "Non-nil means the HL-Line mode highlight appears in all windows. +Otherwise Hl-Line mode will highlight only in the selected +window. Setting this variable takes effect the next time you use +the command `hl-line-mode' to turn Hl-Line mode on. + +This variable has no effect in Global Highlight Line mode. +For that, use `global-hl-line-sticky-flag'." + :type 'boolean + :version "22.1" + :group 'hl-line) + +(defcustom global-hl-line-sticky-flag nil + "Non-nil means the Global HL-Line mode highlight appears in all windows. +Otherwise Global Hl-Line mode will highlight only in the selected +window. Setting this variable takes effect the next time you use +the command `global-hl-line-mode' to turn Global Hl-Line mode on." + :type 'boolean + :version "24.1" + :group 'hl-line) + +(defvar hl-line-range-function nil + "If non-nil, function to call to return highlight range. +The function of no args should return a cons cell; its car value +is the beginning position of highlight and its cdr value is the +end position of highlight in the buffer. +It should return nil if there's no region to be highlighted. + +This variable is expected to be made buffer-local by modes.") + +(defvar hl-line-overlay-buffer nil + "Most recently visited buffer in which Hl-Line mode is enabled.") + +(defvar hl-line-overlay-priority -50 + "Priority used on the overlay used by hl-line.") + +;;;###autoload +(define-minor-mode hl-line-mode + "Toggle highlighting of the current line (Hl-Line mode). + +Hl-Line mode is a buffer-local minor mode. If +`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the +line about the buffer's point in all windows. Caveat: the +buffer's point might be different from the point of a +non-selected window. Hl-Line mode uses the function +`hl-line-highlight' on `post-command-hook' in this case. + +When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the +line about point in the selected window only." + :group 'hl-line + (if hl-line-mode + (progn + ;; In case `kill-all-local-variables' is called. + (add-hook 'change-major-mode-hook #'hl-line-unhighlight nil t) + (hl-line-highlight) + (setq hl-line-overlay-buffer (current-buffer)) + (add-hook 'post-command-hook #'hl-line-highlight nil t)) + (remove-hook 'post-command-hook #'hl-line-highlight t) + (hl-line-unhighlight) + (remove-hook 'change-major-mode-hook #'hl-line-unhighlight t))) + +(defun hl-line-make-overlay () + (let ((ol (make-overlay (point) (point)))) + (overlay-put ol 'priority hl-line-overlay-priority) ;(bug#16192) + (overlay-put ol 'face hl-line-face) + ol)) + +(defun hl-line-highlight () + "Activate the Hl-Line overlay on the current line." + (if hl-line-mode ; Might be changed outside the mode function. + (progn + (unless (overlayp hl-line-overlay) + (setq hl-line-overlay (hl-line-make-overlay))) ; To be moved. + (overlay-put hl-line-overlay + 'window (unless hl-line-sticky-flag (selected-window))) + (hl-line-move hl-line-overlay) + (hl-line-maybe-unhighlight)) + (hl-line-unhighlight))) + +(defun hl-line-unhighlight () + "Deactivate the Hl-Line overlay on the current line." + (when (overlayp hl-line-overlay) + (delete-overlay hl-line-overlay) + (setq hl-line-overlay nil))) + +(defun hl-line-maybe-unhighlight () + "Maybe deactivate the Hl-Line overlay on the current line. +Specifically, when `hl-line-sticky-flag' is nil deactivate all +such overlays in all buffers except the current one." + (let ((hlob hl-line-overlay-buffer) + (curbuf (current-buffer))) + (when (and (buffer-live-p hlob) + (not hl-line-sticky-flag) + (not (eq curbuf hlob)) + (not (minibufferp))) + (with-current-buffer hlob + (hl-line-unhighlight))) + (when (and (overlayp hl-line-overlay) + (eq (overlay-buffer hl-line-overlay) curbuf)) + (setq hl-line-overlay-buffer curbuf)))) + +;;;###autoload +(define-minor-mode global-hl-line-mode + "Toggle line highlighting in all buffers (Global Hl-Line mode). + +If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode +highlights the line about the current buffer's point in all live +windows. + +Global-Hl-Line mode uses the function `global-hl-line-highlight' +on `post-command-hook'." + :global t + :group 'hl-line + (if global-hl-line-mode + (progn + ;; In case `kill-all-local-variables' is called. + (add-hook 'change-major-mode-hook #'global-hl-line-unhighlight) + (global-hl-line-highlight-all) + (add-hook 'post-command-hook #'global-hl-line-highlight)) + (global-hl-line-unhighlight-all) + (remove-hook 'post-command-hook #'global-hl-line-highlight) + (remove-hook 'change-major-mode-hook #'global-hl-line-unhighlight))) + +(defun global-hl-line-highlight () + "Highlight the current line in the current window." + (when global-hl-line-mode ; Might be changed outside the mode function. + (unless (window-minibuffer-p) + (unless (overlayp global-hl-line-overlay) + (setq global-hl-line-overlay (hl-line-make-overlay))) ; To be moved. + (unless (member global-hl-line-overlay global-hl-line-overlays) + (push global-hl-line-overlay global-hl-line-overlays)) + (overlay-put global-hl-line-overlay 'window + (unless global-hl-line-sticky-flag + (selected-window))) + (hl-line-move global-hl-line-overlay) + (global-hl-line-maybe-unhighlight)))) + +(defun global-hl-line-highlight-all () + "Highlight the current line in all live windows." + (walk-windows (lambda (w) + (with-current-buffer (window-buffer w) + (global-hl-line-highlight))) + nil t)) + +(defun global-hl-line-unhighlight () + "Deactivate the Global-Hl-Line overlay on the current line." + (when (overlayp global-hl-line-overlay) + (delete-overlay global-hl-line-overlay) + (setq global-hl-line-overlay nil))) + +(defun global-hl-line-maybe-unhighlight () + "Maybe deactivate the Global-Hl-Line overlay on the current line. +Specifically, when `global-hl-line-sticky-flag' is nil deactivate +all such overlays in all buffers except the current one." + (mapc (lambda (ov) + (let ((ovb (overlay-buffer ov))) + (when (and (not global-hl-line-sticky-flag) + (bufferp ovb) + (not (eq ovb (current-buffer))) + (not (minibufferp))) + (with-current-buffer ovb + (global-hl-line-unhighlight))))) + global-hl-line-overlays)) + +(defun global-hl-line-unhighlight-all () + "Deactivate all Global-Hl-Line overlays." + (mapc (lambda (ov) + (let ((ovb (overlay-buffer ov))) + (when (bufferp ovb) + (with-current-buffer ovb + (global-hl-line-unhighlight))))) + global-hl-line-overlays) + (setq global-hl-line-overlays nil)) + +(defun hl-line-move (overlay) + "Move the Hl-Line overlay. +If `hl-line-range-function' is non-nil, move the OVERLAY to the position +where the function returns. If `hl-line-range-function' is nil, fill +the line including the point by OVERLAY." + (let (tmp b e) + (if hl-line-range-function + (setq tmp (funcall hl-line-range-function) + b (car tmp) + e (cdr tmp)) + (setq tmp t + b (line-beginning-position) + e (line-beginning-position 2))) + (if tmp + (move-overlay overlay b e) + (move-overlay overlay 1 1)))) + +(defun hl-line-unload-function () + "Unload the Hl-Line library." + (global-hl-line-mode -1) + (save-current-buffer + (dolist (buffer (buffer-list)) + (set-buffer buffer) + (when hl-line-mode (hl-line-mode -1)))) + ;; continue standard unloading + nil) + +(provide 'hl-line) + +;;; hl-line.el ends here diff --git a/lisp/js-mode-custom.el b/lisp/js-mode-custom.el new file mode 100644 index 0000000..7f4d396 --- /dev/null +++ b/lisp/js-mode-custom.el @@ -0,0 +1,20 @@ +(defun setup-js() + (setq js-indent-level 2) + ) + +(require 'js2-mode) +(require 'js2-refactor) +(require 'js2-highlight-vars) +(require 'company) +;(add-hook 'js-mode-hook 'js2-minor-mode) +(add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode)) +(add-hook 'js2-mode-hook #'js2-imenu-extras-mode) +(add-hook 'js2-mode-hook 'ac-js2-mode) +(add-hook 'js2-mode-hook 'js2-refactor-mode) +(add-hook 'js2-mode-hook 'js2-highlight-vars-mode) +(add-hook 'js2-mode-hook 'setup-js) +(js2r-add-keybindings-with-prefix "C-c C-r") +(add-to-list 'company-backends 'ac-js2-company) + + +(provide 'js-mode-custom) diff --git a/lisp/minimap.el b/lisp/minimap.el new file mode 100644 index 0000000..c360673 --- /dev/null +++ b/lisp/minimap.el @@ -0,0 +1,936 @@ +;;; minimap.el --- Sidebar showing a "mini-map" of a buffer + +;; Copyright (C) 2009-2020 Free Software Foundation, Inc. + +;; Author: David Engster <deng@randomsample.de> +;; Keywords: +;; Version: 1.3 + +;; This file is part of GNU Emacs. + +;; 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, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file is an implementation of a minimap sidebar, i.e., a +;; smaller display of the current buffer on the left side. It +;; highlights the currently shown region and updates its position +;; automatically. You can navigate in the minibar by dragging the +;; active region with the mouse, which will scroll the corresponding +;; edit buffer. Additionally, you can overlay information from the +;; tags gathered by CEDET's semantic analyzer. + +;; Simply use M-x minimap-mode to toggle activation of the minimap. +;; Use 'M-x customize-group RET minimap RET' to adapt minimap to your +;; needs. + +;;; KNOWN BUGS: + +;; * Currently cannot deal with images. +;; * Display/movement can be a bit erratic at times. + +;;; TODO: + +;; * Fix known bugs. +;; * Make sidebar permanently visible. This requires something like a +;; 'window group' feature in Emacs, which is currently being worked on. +;; * Moving the active region with the keyboard / mouse-wheel ? + + +;;; News: +;; +;;;; Changes since v1.2: +;; +;; - New option: minimap-hide-cursor (active by default) +;; - New option: minimap-disable-mode-line (active by default) +;; - Make current line highlighting face configurable, change to dark gray. +;; - New default behavior for minimap-automatically-delete-window: +;; keep minimap window as long as buffer is visible. Change variable +;; to 't' to get old behavior. +;; - Bug fixes +;; +;;;; Changes since v1.1: +;; +;; - Change some defaults: better colors, reduced update delay. +;; - `minimap-tag-only': New experimental feature to only display an +;; 'abstract view' of the buffer with overlays generated from +;; Semantic information. Works only for buffers parsed by Semantic. +;; - `minimap-highlight-line': Highlight current line in Minimap. +;; - Fix autoloads. +;; - Display lines denoting beginning/end of functions in Semantic +;; overlays. +;; +;;;; Changes since v1.0: +;; +;; - Largely rewritten as a minor mode; use M-x minimap-mode to +;; enable/disable. +;; - Minimap will now remain active for all buffers which derive from +;; `prog-mode' (can be changed through `minimap-major-modes'). The +;; minimap window will be automatically created or deleted (see new +;; variables `minimap-recreate-window' and +;; `minimap-automatically-delete-window'). +;; - Possibility to set a minimum width of the minimap window +;; (`minimap-minimum-width'). +;; - Minimap window will be marked so that you should not be able to +;; enter it. +;; - Semantic overlays will be automatically updated during editing. +;; - Lots of bug fixes. + +;; Silence byte compiler +(declare-function semantic-active-p "semantic/fw") +(declare-function semantic-fetch-tags "semantic") +(declare-function semantic-tag-class "semantic/tag") +(declare-function semantic-tag-overlay "semantic/tag") +(declare-function semantic-tag-name "semantic/tag") + +(defgroup minimap nil + "A minimap sidebar for Emacs." + :group 'convenience) + +(defface minimap-font-face + '((default :family "DejaVu Sans Mono" :height 30)) + "Face used for text in minimap buffer, notably the font family and height. +This height should be really small. You probably want to use a +TrueType font for this. After changing this, you should +recreate the minimap to avoid problems with recentering." + :group 'minimap) + +(defface minimap-current-line-face + '((((background dark)) (:background "dark gray")) + (t (:background "dark gray"))) + "Face for the current line in the minimap. +By default, both foreground and background are yellow." + :group 'minimap) + +(defface minimap-active-region-background + '((((background dark)) (:background "#700000" :extend t)) + (t (:background "#C847D8FEFFFF" :extend t))) + "Face for the active region in the minimap. +By default, this is only a different background color." + :group 'minimap) + +(defface minimap-semantic-function-face + '((((background dark)) + (:box (:line-width 1 :color "white") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "#202414")) + (t (:box (:line-width 1 :color "black") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "gray90"))) + "Face used for functions in the semantic overlay.") + +(defface minimap-semantic-variable-face + '((((background dark)) + (:box (:line-width 1 :color "white") + :inherit (font-lock-variable-name-face minimap-font-face) + :height 2.75 :background "gray10")) + (t (:box (:line-width 1 :color "black") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "gray90"))) + "Face used for variables in the semantic overlay.") + +(defface minimap-semantic-type-face + '((((background dark)) + (:box (:line-width 1 :color "white") + :inherit (font-lock-type-face minimap-font-face) + :height 2.75 :background "gray10")) + (t (:box (:line-width 1 :color "black") + :inherit (font-lock-function-name-face minimap-font-face) + :height 2.75 :background "gray90"))) + "Face used for types in the semantic overlay.") + +(defcustom minimap-width-fraction 0.15 + "Fraction of width which should be used for minimap sidebar." + :type 'number + :group 'minimap) + +(defcustom minimap-minimum-width 30 + "Minimum width of minimap in characters (default size). +Use nil to disable." + :type 'number + :group 'minimap) + +(defcustom minimap-window-location 'left + "Location of the minimap window. +Can be either the symbol `left' or `right'." + :type '(choice (const :tag "Left" left) + (const :tag "Right" right)) + :group 'minimap) + +(defcustom minimap-buffer-name " *MINIMAP*" + "Buffer name of minimap sidebar." + :type 'string + :group 'minimap) + +(defcustom minimap-update-delay 0.1 + "Delay in seconds after which sidebar gets updated. +Setting this to 0 will let the minimap react immediately, but +this will slow down scrolling." + :type 'number + :set (lambda (sym value) + (set sym value) + (when (and (boundp 'minimap-timer-object) + minimap-timer-object) + (cancel-timer minimap-timer-object) + (setq minimap-timer-object + (run-with-idle-timer + minimap-update-delay t 'minimap-update)))) + :group 'minimap) + +(defcustom minimap-always-recenter nil + "Whether minimap sidebar should be recentered after every point movement." + :type 'boolean + :group 'minimap) + +(defcustom minimap-recenter-type 'relative + "Specifies the type of recentering the minimap should use. +The minimap can use different types of recentering, i.e., how the +minimap should behave when you scroll in the main window or when +you drag the active region with the mouse. The following +explanations will probably not help much, so simply try them and +choose the one which suits you best. + +`relative' -- The position of the active region in the minimap +corresponds with the relative position of this region in the +buffer. This the default. + +`middle' -- The active region will stay fixed in the middle of +the minimap. + +`free' -- The position will be more or less free. When dragging +the active region, the minimap will scroll when you reach the +bottom or top." + :type '(choice (const :tag "Relative" relative) + (const :tag "Middle" middle) + (const :tag "Free" free)) + :group 'minimap) + +(defcustom minimap-hide-scroll-bar t + "Whether the minimap should hide the vertical scrollbar." + :type 'boolean + :group 'minimap) + +(defcustom minimap-hide-fringes nil + "Whether the minimap should hide the fringes." + :type 'boolean + :group 'minimap) + +(defcustom minimap-dedicated-window t + "Whether the minimap should create a dedicated window." + :type 'boolean + :group 'minimap) + +(defcustom minimap-display-semantic-overlays t + "Display overlays from CEDET's semantic analyzer. +If you use CEDET and the buffer's major-mode is supported, the +minimap can display overlays generated by the semantic analyzer. +By default, it will apply the faces `minimap-semantic-<X>-face', +with <X> being \"function\", \"variable\" and \"type\". Also, it +will display the name of the tag in the middle of the overlay in +the corresponding font-lock face. + +See also `minimap-enlarge-certain-faces', which can be used as +fallback." + :type 'boolean + :group 'minimap) + +(defcustom minimap-enlarge-certain-faces 'as-fallback + "Whether certain faces should be enlarged in the minimap. +All faces listed in `minimap-normal-height-faces' will be +displayed using the default font height, allowing you to still +read text using those faces. By default, this should enlarge all +function names in the minimap, given you have font locking +enabled. This variable can have the following values: + +'as-fallback (the default) -- The feature will only be activated + if information from CEDET's semantic analyzer isn't available + (see: `minimap-display-semantic-overlays'). +'always -- Always active. +nil -- Inactive." + :type '(choice (const :tag "Fallback if CEDET unavailable." as-fallback) + (const :tag "Always active." always) + (const :tag "Inactive." nil)) + :group 'minimap) + +(defcustom minimap-normal-height-faces '(font-lock-function-name-face) + "List of faces which should be displayed with normal height. +When `minimap-enlarge-certain-faces' is non-nil, all faces in +this list will be displayed using the default font height. By +default, this list contains `font-lock-function-name-face', so +you can still read function names in the minimap." + :type '(repeat face) + :group 'minimap) + +(defcustom minimap-sync-overlay-properties '(face invisible) + "Specifies which overlay properties should be synced. +Unlike text properties, overlays are not applied automatically to +the minimap and must be explicitly synced. This variable +specifies which overlay properties should be synced by +`minimap-sync-overlays'. Most importantly, this variable should +include 'invisible', so that hidden text does not appear in the +minimap buffer." + :type '(repeat symbol) + :group 'minimap) + +(defcustom minimap-major-modes '(prog-mode) + "Major modes for which a minimap should be created. +This can also be a parent mode like 'prog-mode. +If nil, a minimap must be explicitly created for each buffer." + :type '(repeat symbol) + :group 'minimap) + +(defcustom minimap-recreate-window t + "Whether the minimap window should be automatically re-created. +If this is non-nil, the side window for the minimap will be +automatically re-created as soon as you kill it." + :type 'boolean + :group 'minimap) + +(defcustom minimap-automatically-delete-window 'visible + "Whether the minimap window should be automatically deleted. +You can choose between three different behaviors here: If this is +`nil', the minimap window will never be automatically deleted. If +this is set to symbol 'visible, the minimap stays active as long +as the minimap's buffer is visible somewhere in the frame, +whether it is active or not. Any other value will delete the +minimap window as soon as you enter a buffer which is not derived +from `minimap-major-modes' (excluding the minibuffer)." + :type '(choice (const :tag "Never delete automatically" nil) + (const :tag "Keep as long as buffer visible" visible) + (const :tag "Delete when entering unsupported buffer" t)) + :group 'minimap) + +(defcustom minimap-tag-only nil + "Whether the minimap should only display parsed tags from CEDET." + :type 'boolean + :group 'minimap) + +(defcustom minimap-highlight-line t + "Whether the minimap should highlight the current line." + :type 'boolean + :group 'minimap) + +(defcustom minimap-disable-mode-line t + "Whether to disable the mode-line in the minimap window." + :type 'boolen + :group 'minimap) + +(defcustom minimap-hide-cursor t + "Whether to hide the cursor in the minimap window." + :type 'boolen + :group 'minimap) + +;;; Internal variables + +;; The buffer currently displayed in the minimap +(defvar minimap-active-buffer nil) +;; Window start/end from the base buffer +(defvar minimap-start nil) +(defvar minimap-end nil) +;; General overlay for the minimap +(defvar minimap-base-overlay nil) +;; Overlay for the active region +(defvar minimap-active-overlay nil) +;; Timer +(defvar minimap-timer-object nil) +;; Lines the minimap can display +(defvar minimap-numlines nil) +(defvar minimap-pointmin-overlay nil) +;; Line overlay +(defvar minimap-line-overlay nil) + + +;;; Helpers + +(defun minimap-active-current-buffer-p () + "Whether the current buffer is displayed in the minimap." + (and (eq (current-buffer) minimap-active-buffer) + (get-buffer minimap-buffer-name) + (with-current-buffer minimap-buffer-name + (eq minimap-active-buffer (buffer-base-buffer))))) + +(defsubst minimap-get-window () + "Get current minimap window." + (when (get-buffer minimap-buffer-name) + (get-buffer-window minimap-buffer-name))) + +(defsubst minimap-kill-buffer () + "Kill the minimap buffer." + (when (get-buffer minimap-buffer-name) + (kill-buffer minimap-buffer-name))) + +(defun minimap-create-window () + (let ((width (round (* (window-width) + minimap-width-fraction))) + buffer-window) + (when (< width minimap-minimum-width) + (setq width minimap-minimum-width)) + (if (eq minimap-window-location 'left) + ;; The existing window becomes the minimap + (progn + (setq buffer-window (split-window-horizontally width)) + ;; Restore prev/next buffers in the new window + (set-window-next-buffers buffer-window + (window-next-buffers)) + (set-window-prev-buffers buffer-window + (window-prev-buffers))) + ;; The new window is the minimap + (setq buffer-window (selected-window)) + (select-window (split-window-horizontally + (* -1 width)))) + ;; Set up the minimap window: + ;; You should not be able to enter the minimap window. + (set-window-parameter nil 'no-other-window t) + ;; Switch to buffer. + (switch-to-buffer + (get-buffer-create minimap-buffer-name) t t) + ;; Do not fold lines in the minimap. + (setq truncate-lines t) + ;; Make it dedicated. + (when minimap-dedicated-window + (set-window-dedicated-p nil t)) + ;; Return minimap window, but make sure we select the window where + ;; the buffer is in. + (prog1 + (selected-window) + (select-window buffer-window)))) + +(defun minimap-setup-hooks (&optional remove) + "Hook minimap into other modes. +If REMOVE is non-nil, remove minimap from other modes." + (if remove + (progn + (remove-hook 'outline-view-change-hook 'minimap-sync-overlays) + (remove-hook 'hs-hide-hook 'minimap-sync-overlays) + (remove-hook 'hs-show-hook 'minimap-sync-overlays) + (remove-hook 'flycheck-after-syntax-check-hook 'minimap-sync-overlays)) + ;; outline-(minor-)mode + (add-hook 'outline-view-change-hook 'minimap-sync-overlays) + ;; hideshow + (add-hook 'hs-hide-hook 'minimap-sync-overlays) + (add-hook 'hs-show-hook 'minimap-sync-overlays) + (add-hook 'flycheck-after-syntax-check-hook 'minimap-sync-overlays))) + +;;; Minimap creation / killing + +;;;###autoload +(define-minor-mode minimap-mode + "Toggle minimap mode." + :global t + :group 'minimap + :lighter " MMap" + (if minimap-mode + (progn + (when (and minimap-major-modes + (apply 'derived-mode-p minimap-major-modes)) + (unless (minimap-get-window) + (minimap-create-window)) + ;; Create minimap. + (minimap-new-minimap)) + ;; Create timer. + (setq minimap-timer-object + (run-with-idle-timer minimap-update-delay t 'minimap-update)) + ;; Hook into other modes. + (minimap-setup-hooks)) + ;; Turn it off + (minimap-kill) + (minimap-setup-hooks t))) + +(defun minimap-create () + "Create a minimap sidebar." + (interactive) + (minimap-mode 1)) + +(defun minimap-new-minimap () + "Create new minimap BUFNAME for current buffer and window. +Re-use already existing minimap window if possible." + (interactive) + (let ((currentbuffer (current-buffer)) + (win (minimap-get-window)) + (indbuf (make-indirect-buffer (current-buffer) + (concat minimap-buffer-name "_temp"))) + (edges (window-pixel-edges))) + ;; Remember the active buffer currently displayed in the minimap. + (setq minimap-active-buffer (current-buffer)) + ;; Hook into CEDET if necessary. + (when (and minimap-display-semantic-overlays + (boundp 'semantic-after-toplevel-cache-change-hook)) + (add-hook 'semantic-after-partial-cache-change-hook + 'minimap-apply-semantic-overlays nil t) + (add-hook 'semantic-after-toplevel-cache-change-hook + 'minimap-apply-semantic-overlays nil t)) + (with-selected-window win + ;; Now set up the minimap: + (when (window-dedicated-p) + (set-window-dedicated-p nil nil)) + (switch-to-buffer indbuf t t) + (minimap-kill-buffer) + (rename-buffer minimap-buffer-name) + ;; Do not fold lines in the minimap. + (setq truncate-lines t) + (when minimap-dedicated-window + (set-window-dedicated-p nil t)) + (setq minimap-base-overlay (make-overlay (point-min) (point-max) nil t t)) + (overlay-put minimap-base-overlay 'face 'minimap-font-face) + (overlay-put minimap-base-overlay 'priority 1) + ;; Add the hand mouse pointer to visible text. It doesn’t seem + ;; possible to set the mouse cursor when there’s no text. See + ;; `void-text-area-pointer'. + (overlay-put minimap-base-overlay 'pointer 'hand) + (when minimap-tag-only + (overlay-put minimap-base-overlay 'face + `(:inherit minimap-font-face + :foreground ,(face-background 'default)))) + (setq minimap-pointmin-overlay (make-overlay (point-min) (1+ (point-min)))) + (setq minimap-start (window-start) + minimap-end (window-end) + minimap-active-overlay (make-overlay minimap-start minimap-end) + line-spacing 0) + (overlay-put minimap-active-overlay 'face + 'minimap-active-region-background) + (when minimap-tag-only + (overlay-put minimap-active-overlay 'face + `(:inherit 'minimap-active-region-background + :foreground ,(face-background 'minimap-active-region-background)))) + (overlay-put minimap-active-overlay 'priority 5) + (minimap-sb-mode 1) + (when minimap-disable-mode-line + (setq mode-line-format nil)) + (when minimap-hide-cursor + (setq cursor-type nil)) + (when minimap-hide-scroll-bar + (setq vertical-scroll-bar nil) + (set-window-buffer nil (current-buffer))) + (when minimap-hide-fringes + (set-window-fringes nil 0 0)) + (when (and (boundp 'linum-mode) + linum-mode) + (linum-mode 0)) + (setq buffer-read-only t) + ;; Calculate the actual number of lines displayable with the minimap face. + (setq minimap-numlines + (floor + (/ + (- (nth 3 edges) (nth 1 edges)) + (car (progn (redisplay t) (window-line-height))))))) + (minimap-sync-overlays))) + +(defun minimap-kill () + "Kill minimap." + (interactive) + (when (minimap-get-window) + (delete-window (minimap-get-window))) + (cancel-timer minimap-timer-object)) + +;;; Minimap update + +(defun minimap-update (&optional force) + "Update minimap sidebar if necessary. +This is meant to be called from the idle-timer or the post command hook. +When FORCE, enforce update of the active region." + (interactive) + ;; If we are in the minibuffer, do nothing. + (unless (active-minibuffer-window) + (if (minimap-active-current-buffer-p) + ;; We are still in the same buffer, so just update the minimap. + (minimap-update-current-buffer force) + ;; The buffer was switched, check if the minimap should switch, too. + (if (and minimap-major-modes + (apply 'derived-mode-p minimap-major-modes)) + (progn + ;; Create window if necessary... + (unless (minimap-get-window) + (minimap-create-window)) + ;; ...and re-create minimap with new buffer... + (minimap-new-minimap) + ;; Redisplay + (sit-for 0) + ;; ...and call update again. + (minimap-update t)) + ;; We have entered a buffer for which no minimap should be + ;; displayed. Check if we should de + (when (and (minimap-get-window) + (minimap-need-to-delete-window)) + ;; We wait a tiny bit before deleting the window, since we + ;; might only be temporarily in another buffer. + (run-with-timer 0.3 nil + (lambda () + (when (and (null (minimap-active-current-buffer-p)) + (minimap-get-window)) + (delete-window (minimap-get-window)))))))))) + +(defun minimap-need-to-delete-window () + "Check if we should delete the minimap window. +This depends on `minimap-automatically-delete-window'." + (if (eq minimap-automatically-delete-window 'visible) + (null (get-buffer-window minimap-active-buffer)) + (null minimap-automatically-delete-window))) + +(defun minimap-update-current-buffer (force) + "Update minimap for the current buffer." + (let ((win (minimap-get-window)) + (start (window-start)) + (end (window-end)) + (pt (point))) + (when (and (null win) + minimap-recreate-window) + ;; The minimap window is no longer visible, so create it again... + (setq win (minimap-create-window)) + ;; ...and switch to existing minimap buffer. + (with-selected-window win + (when (window-dedicated-p) + (set-window-dedicated-p nil nil)) + (switch-to-buffer minimap-buffer-name t t) + (when minimap-hide-fringes + (set-window-fringes nil 0 0)) + (when minimap-dedicated-window + (set-window-dedicated-p nil t)))) + (with-selected-window win + ;; Make sure the base overlay spans the whole buffer. + (unless (and (= (overlay-start minimap-base-overlay) (point-min)) + (= (overlay-end minimap-base-overlay) (point-max))) + (move-overlay minimap-base-overlay (point-min) (point-max))) + (unless (and (not force) + (= minimap-start start) + (= minimap-end end)) + ;; Update the overlay. + (move-overlay minimap-active-overlay start end) + (setq minimap-start start + minimap-end end) + (minimap-recenter (line-number-at-pos (/ (+ end start) 2)) + (/ (- (line-number-at-pos end) + (line-number-at-pos start)) + 2))) + (goto-char pt) + (beginning-of-line) + (when minimap-highlight-line + (minimap-highlight-line)) + (when minimap-always-recenter + (recenter (round (/ (window-height) 2))))))) + +(defun minimap-highlight-line () + "Highlight current line in the minimap." + (unless minimap-line-overlay + (setq minimap-line-overlay (make-overlay (point) (1+ (point)) nil t)) + (overlay-put minimap-line-overlay 'priority 6)) + (overlay-put + minimap-line-overlay 'face + `(:background ,(face-background 'minimap-current-line-face) + :foreground ,(face-foreground 'minimap-current-line-face))) + (move-overlay minimap-line-overlay (point) (line-beginning-position 2))) + +;;; Overlay movement + +(defun minimap-move-overlay-mouse (start-event) + "Move overlay by tracking mouse movement." + (interactive "e") + (when (get-buffer-window (buffer-base-buffer (current-buffer))) + (let* ((echo-keystrokes 0) + (end-posn (event-end start-event)) + (start-point (posn-point end-posn)) + (make-cursor-line-fully-visible nil) + (cursor-type nil) + (minimap-automatically-delete-window nil) + (pcselmode (when (boundp 'pc-selection-mode) + pc-selection-mode)) + pt ev) + (when (and pcselmode (fboundp 'pc-selection-mode)) + (pc-selection-mode -1)) + (move-overlay minimap-active-overlay start-point minimap-end) + (track-mouse + (minimap-set-overlay start-point) + (while (and + (consp (setq ev (read-event))) + (eq (car ev) 'mouse-movement)) + (setq pt (posn-point (event-start ev))) + (when (numberp pt) + (with-selected-window (get-buffer-window minimap-buffer-name) + (goto-char pt) + (beginning-of-line) + (minimap-set-overlay (point)))))) + (minimap-update) + (when (and pcselmode (fboundp 'pc-selection-mode)) + (pc-selection-mode 1))))) + +(defun minimap-set-overlay (pt) + "Set overlay position, with PT being the middle." + (goto-char pt) + (let* ((ovstartline (line-number-at-pos minimap-start)) + (ovendline (line-number-at-pos minimap-end)) + (ovheight (round (/ (- ovendline ovstartline) 2))) + (line (line-number-at-pos)) + (winstart (window-start)) + (winend (window-end)) + newstart newend) + (setq pt (point-at-bol)) + (setq newstart (minimap-line-to-pos (- line ovheight))) + ;; Perform recentering + (minimap-recenter line ovheight) + ;; Set new position in main buffer and redisplay + (with-selected-window (get-buffer-window (buffer-base-buffer)) + (goto-char pt) + (set-window-start nil newstart) + (redisplay t) + (setq newend (window-end))) + (when (eq minimap-recenter-type 'free) + (while (> newend winend) + (scroll-up 5) + (redisplay t) + (setq winend (window-end)))) + (move-overlay minimap-active-overlay newstart newend))) + +(defun minimap-line-to-pos (line) + "Return point position of line number LINE." + (save-excursion + (goto-char 1) + (if (eq selective-display t) + (re-search-forward "[\n\C-m]" nil 'end (1- line)) + (forward-line (1- line))) + (point))) + +(defun minimap-recenter (middle height) + "Recenter the minimap according to `minimap-recenter-type'. +MIDDLE is the line number in the middle of the active region. +HEIGHT is the number of lines from MIDDLE to begin/end of the +active region." + (cond + ;; Relative recentering + ((eq minimap-recenter-type 'relative) + (let* ((maxlines (line-number-at-pos (point-max))) + percentage relpos newline start numlines) + (setq numlines (count-lines (window-start) (window-end))) + (setq percentage (/ (float middle) (float maxlines))) + (setq newline (ceiling (* percentage numlines))) + (setq start (minimap-line-to-pos + (- middle height + (floor (* percentage + (- numlines height height)))))) + (or (> start (point-min)) + (setq start (point-min))) + ;; If (point-max) already visible, don't go further + (if (and (> start (window-start)) + (with-selected-window (get-buffer-window (buffer-base-buffer)) + (= (point-max) (window-end)))) + (save-excursion + (goto-char (point-max)) + (recenter -1)) + (unless (and (> start (window-start)) + (= (point-max) (window-end))) + (set-window-start nil start))))) + ;; Middle recentering + ((eq minimap-recenter-type 'middle) + (let ((start (- middle height + (floor (* 0.5 + (- minimap-numlines height height)))))) + (if (< start 1) + (progn + ;; Hack: Emacs cannot scroll down any further, so we fake + ;; it using an overlay. Otherwise, the active region + ;; would move to the top. + (overlay-put minimap-pointmin-overlay + 'display (concat + (make-string (abs start) 10) + (buffer-substring (point-min) (1+ (point-min))))) + (overlay-put minimap-pointmin-overlay + 'face `(:background ,(face-background 'default))) + (overlay-put minimap-pointmin-overlay + 'priority 10) + (setq start 1)) + (overlay-put minimap-pointmin-overlay 'display "") + (overlay-put minimap-pointmin-overlay 'face nil)) + (set-window-start nil (minimap-line-to-pos start)))) + ;; Free recentering + ((eq minimap-recenter-type 'free) + (let ((newstart (minimap-line-to-pos (- middle height))) + (winstart (window-start))) + (while (< newstart winstart) + (scroll-down 5) + (redisplay t) + (setq winstart (window-start))))))) + +;;; Minimap minor mode + + (defvar minimap-sb-mode-map (make-sparse-keymap) + "Keymap used by `minimap-sb-mode'.") + +(define-key minimap-sb-mode-map [down-mouse-1] 'minimap-move-overlay-mouse) +(define-key minimap-sb-mode-map [down-mouse-2] 'minimap-move-overlay-mouse) +(define-key minimap-sb-mode-map [down-mouse-3] 'minimap-move-overlay-mouse) + +(define-minor-mode minimap-sb-mode + "Minor mode for minimap sidebar." + nil "minimap" minimap-sb-mode-map) + +;;; Sync minimap with modes which create/delete overlays. + +(defun minimap-sync-overlays () + "Synchronize overlays between base and minimap buffer. +Apply semantic overlays or face enlargement if necessary." + (interactive) + ;; Get overlays and Semantic status from base buffer. + (when (and minimap-mode + (minimap-active-current-buffer-p)) + (with-current-buffer minimap-active-buffer + (let ((baseov (overlays-in (point-min) (point-max))) + (semantic (and (boundp 'semantic-version) + (semantic-active-p))) + ov props p) + ;; Apply overlays to minimap. + (with-current-buffer minimap-buffer-name + ;; Delete overlays (but keep our own). + (let ((ovs (overlays-in (point-min) (point-max)))) + (dolist (ov ovs) + (unless (member ov (list minimap-pointmin-overlay + minimap-base-overlay + minimap-active-overlay)) + (delete-overlay ov)))) + (while baseov + (when (and (eq (overlay-buffer (car baseov)) minimap-active-buffer) + (setq props (minimap-get-sync-properties (car baseov)))) + (setq ov (make-overlay (overlay-start (car baseov)) + (overlay-end (car baseov)))) + (while (setq p (car props)) + (overlay-put ov (car p) (cadr p)) + (setq props (cdr props)))) + (setq baseov (cdr baseov))) + (move-overlay minimap-pointmin-overlay (point-min) (1+ (point-min))) + ;; Re-apply font overlay + (move-overlay minimap-base-overlay (point-min) (point-max))) + ;; Face enlargement + (when (and font-lock-mode + (or (eq minimap-enlarge-certain-faces 'always) + (and (eq minimap-enlarge-certain-faces 'as-fallback) + (or (not minimap-display-semantic-overlays) + (not semantic))))) + (when (eq font-lock-support-mode 'jit-lock-mode) + (condition-case nil + (jit-lock-fontify-now) + (error nil))) + (minimap-enlarge-faces)) + ;; Semantic overlays + (when (and semantic + minimap-display-semantic-overlays) + (minimap-apply-semantic-overlays t)))))) + +(defun minimap-get-sync-properties (ov) + "Get properties from overlay OV which should be synced. +You can specify those properties with +`minimap-sync-overlay-properties'." + (let ((syncprops minimap-sync-overlay-properties)) + (when minimap-tag-only + (setq syncprops (delq 'face syncprops))) + (delq nil + (mapcar + (lambda (p) + (let ((val (overlay-get ov p))) + (if val + (list p val) + nil))) + syncprops)))) + +(defun minimap-enlarge-faces () + "Apply default font to all faces in `minimap-normal-height-faces'." + (let ((pos (next-single-property-change (point-min) 'face)) + next ov face) + (while pos + (setq face (get-text-property pos 'face)) + (when (and face + (member face minimap-normal-height-faces)) + (with-current-buffer minimap-buffer-name + (setq ov + (make-overlay pos + (setq pos (next-single-property-change pos 'face)))) + (overlay-put ov 'face `(:family ,(face-font 'default))) + (overlay-put ov 'priority 5))) + (setq pos (next-single-property-change pos 'face))))) + +(defun minimap-apply-semantic-overlays (tags) + "Apply semantic overlays to the minimap. +TAGS is the list of tags. If it is t, fetch tags from buffer." + (when (and tags + minimap-mode) + (with-current-buffer minimap-active-buffer + (let (tag class ov ovnew) + (when (eq tags t) + (setq tags (semantic-fetch-tags))) + (while tags + (setq tag (car tags)) + (setq class (semantic-tag-class tag)) + (setq ov (semantic-tag-overlay tag)) + (when (and (overlayp ov) + (or (eq class 'function) + (eq class 'type) + (eq class 'variable))) + (with-current-buffer minimap-buffer-name + (let* ((start (overlay-start ov)) + (end (overlay-end ov)) + (name (semantic-tag-name tag)) + (lstart (line-number-at-pos start)) + (lend (line-number-at-pos end))) + ;; First, remove old Semantic overlays. + (remove-overlays start end 'minimap-semantic t) + (if minimap-tag-only + ;; Now put the new ones. + (overlay-put + (setq ovnew (make-overlay start end)) + 'face `(:background ,(face-background + (intern (format "minimap-semantic-%s-face" + (symbol-name class)))) + :foreground + ,(face-background + (intern (format "minimap-semantic-%s-face" + (symbol-name class)))) + )) + ;; Now put the new ones. + (overlay-put + (setq ovnew (make-overlay start end)) + 'face `(:background ,(face-background + (intern (format "minimap-semantic-%s-face" + (symbol-name class))))))) + (overlay-put ovnew 'priority 4) + (when (and (eq class 'function) + (> (- lend lstart) 5)) + (overlay-put ovnew 'priority 1) + (overlay-put ovnew 'minimap-semantic t) + (overlay-put (setq ovnew (make-overlay start (progn (goto-char start) (point-at-eol)))) + 'display (make-string 200 ?\u203E)) + (overlay-put ovnew 'minimap-semantic t) + (overlay-put ovnew 'face `(:foreground ,(face-foreground 'default) :overline nil)) + (overlay-put ovnew 'priority 8) + (overlay-put (setq ovnew (make-overlay (progn (goto-char end) (point-at-bol)) end)) + 'display (make-string 200 ?_)) + (overlay-put ovnew 'face `(:foreground ,(face-foreground 'default))) + (overlay-put ovnew 'minimap-semantic t) + (overlay-put ovnew 'priority 8)) + (setq start + (minimap-line-to-pos (/ (+ lstart lend) 2))) + (goto-char start) + (while (looking-at "^$") + (forward-line -1)) + (setq start (point)) + (setq end (progn (goto-char start) (point-at-eol))) + (setq ovnew (make-overlay start end)) + (overlay-put ovnew 'face (format "minimap-semantic-%s-face" + (symbol-name class))) + (overlay-put ovnew 'display (concat " " name " ")) + (overlay-put ovnew 'priority 7) + (overlay-put ovnew 'minimap-semantic t) + + + ))) + (setq tags (cdr tags))))))) + +(provide 'minimap) + +;;; minimap.el ends here diff --git a/lisp/neotree b/lisp/neotree new file mode 160000 +Subproject 98fe21334affaffe2334bf7c987edaf1980d2d0 diff --git a/lisp/neotree.el b/lisp/neotree.el new file mode 100644 index 0000000..0156cb9 --- /dev/null +++ b/lisp/neotree.el @@ -0,0 +1,2226 @@ +;;; neotree.el --- A tree plugin like NerdTree for Vim + +;; Copyright (C) 2014 jaypei + +;; Author: jaypei <jaypei97159@gmail.com> +;; URL: https://github.com/jaypei/emacs-neotree +;; Version: 0.5.1 +;; Package-Requires: ((cl-lib "0.5")) + +;; 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: + +;; To use this file, put something like the following in your +;; ~/.emacs: +;; +;; (add-to-list 'load-path "/directory/containing/neotree/") +;; (require 'neotree) +;; +;; Type M-x neotree to start. +;; +;; To set options for NeoTree, type M-x customize, then select +;; Applications, NeoTree. +;; + +;;; Code: + +(require 'cl-lib) + +;; +;; Constants +;; + +(defconst neo-buffer-name " *NeoTree*" + "Name of the buffer where neotree shows directory contents.") + +(defconst neo-dir + (expand-file-name (if load-file-name + (file-name-directory load-file-name) + default-directory))) + +(defconst neo-header-height 5) + +(eval-and-compile + + ;; Added in Emacs 24.3 + (unless (fboundp 'user-error) + (defalias 'user-error 'error)) + + ;; Added in Emacs 24.3 (mirrors/emacs@b335efc3). + (unless (fboundp 'setq-local) + (defmacro setq-local (var val) + "Set variable VAR to value VAL in current buffer." + (list 'set (list 'make-local-variable (list 'quote var)) val))) + + ;; Added in Emacs 24.3 (mirrors/emacs@b335efc3). + (unless (fboundp 'defvar-local) + (defmacro defvar-local (var val &optional docstring) + "Define VAR as a buffer-local variable with default value VAL. +Like `defvar' but additionally marks the variable as being automatically +buffer-local wherever it is set." + (declare (debug defvar) (doc-string 3)) + (list 'progn (list 'defvar var val docstring) + (list 'make-variable-buffer-local (list 'quote var)))))) + +;; Add autoload function for vc (#153). +(autoload 'vc-responsible-backend "vc.elc") + +;; +;; Macros +;; + +(defmacro neo-util--to-bool (obj) + "If OBJ is non-nil, return t, else return nil." + `(and ,obj t)) + +(defmacro neo-global--with-buffer (&rest body) + "Execute the forms in BODY with global NeoTree buffer." + (declare (indent 0) (debug t)) + `(let ((neotree-buffer (neo-global--get-buffer))) + (unless (null neotree-buffer) + (with-current-buffer neotree-buffer + ,@body)))) + +(defmacro neo-global--with-window (&rest body) + "Execute the forms in BODY with global NeoTree window." + (declare (indent 0) (debug t)) + `(save-selected-window + (neo-global--select-window) + ,@body)) + +(defmacro neo-global--when-window (&rest body) + "Execute the forms in BODY when selected window is NeoTree window." + (declare (indent 0) (debug t)) + `(when (eq (selected-window) neo-global--window) + ,@body)) + +(defmacro neo-global--switch-to-buffer () + "Switch to NeoTree buffer." + `(let ((neotree-buffer (neo-global--get-buffer))) + (unless (null neotree-buffer) + (switch-to-buffer neotree-buffer)))) + +(defmacro neo-buffer--with-editing-buffer (&rest body) + "Execute BODY in neotree buffer without read-only restriction." + `(let (rlt) + (neo-global--with-buffer + (setq buffer-read-only nil) + (setq rlt (progn ,@body)) + (setq buffer-read-only t)) + rlt)) + +(defmacro neo-buffer--with-resizable-window (&rest body) + "Execute BODY in neotree window without `window-size-fixed' restriction." + `(let (rlt) + (neo-global--with-buffer + (neo-buffer--unlock-width)) + (setq rlt (progn ,@body)) + (neo-global--with-buffer + (neo-buffer--lock-width)) + rlt)) + +(defmacro neotree-make-executor (&rest fn-form) + "Make an open event handler, FN-FORM is event handler form." + (let* ((get-args-fn + (lambda (sym) (or (plist-get fn-form sym) (lambda (&rest _))))) + (file-fn (funcall get-args-fn :file-fn)) + (dir-fn (funcall get-args-fn :dir-fn))) + `(lambda (&optional arg) + (interactive "P") + (neo-global--select-window) + (neo-buffer--execute arg ,file-fn ,dir-fn)))) + + +;; +;; Customization +;; + +(defgroup neotree nil + "Options for neotree." + :prefix "neo-" + :group 'files) + +(defgroup neotree-vc-options nil + "Neotree-VC customizations." + :prefix "neo-vc-" + :group 'neotree + :link '(info-link "(neotree)Configuration")) + +(defgroup neotree-confirmations nil + "Neotree confirmation customizations." + :prefix "neo-confirm-" + :group 'neotree) + +(defcustom neo-window-position 'left + "*The position of NeoTree window." + :group 'neotree + :type '(choice (const left) + (const right))) + +(defcustom neo-display-action '(neo-default-display-fn) + "*Action to use for displaying NeoTree window. +If you change the action so it doesn't use +`neo-default-display-fn', then other variables such as +`neo-window-position' won't be respected when opening NeoTree +window." + :type 'sexp + :group 'neotree) + +(defcustom neo-create-file-auto-open nil + "*If non-nil, the file will auto open when created." + :type 'boolean + :group 'neotree) + +(defcustom neo-banner-message nil + "*The banner message of neotree window." + :type 'string + :group 'neotree) + +(defcustom neo-show-updir-line t + "*If non-nil, show the updir line (..)." + :type 'boolean + :group 'neotree) + +(defcustom neo-show-slash-for-folder t + "*If non-nil, show the slash at the end of folder (folder/)" + :type 'boolean + :group 'neotree) + +(defcustom neo-reset-size-on-open nil + "*If non-nil, the width of the noetree window will be reseted every time a file is open." + :type 'boolean + :group 'neotree) + +(defcustom neo-theme 'classic + "*The tree style to display. +`classic' use icon to display, it only it suitable for GUI mode. +`ascii' is the simplest style, it will use +/- to display the fold state, +it suitable for terminal. +`arrow' use unicode arrow. +`nerd' use the nerdtree indentation mode and arrow." + :group 'neotree + :type '(choice (const classic) + (const ascii) + (const arrow) + (const icons) + (const nerd))) + +(defcustom neo-mode-line-type 'neotree + "*The mode-line type to display, `default' is a non-modified mode-line, \ +`neotree' is a compact mode-line that shows useful information about the + current node like the parent directory and the number of nodes, +`custom' uses the format stored in `neo-mode-line-custom-format', +`none' hide the mode-line." + :group 'neotree + :type '(choice (const default) + (const neotree) + (const custom) + (const none))) + +(defcustom neo-mode-line-custom-format nil + "*If `neo-mode-line-type' is set to `custom', this variable specifiy \ +the mode-line format." + :type 'sexp + :group 'neotree) + +(defcustom neo-smart-open nil + "*If non-nil, every time when the neotree window is opened, it will try to find current file and jump to node." + :type 'boolean + :group 'neotree) + +(defcustom neo-show-hidden-files nil + "*If non-nil, the hidden files are shown by default." + :type 'boolean + :group 'neotree) + +(defcustom neo-autorefresh nil + "*If non-nil, the neotree buffer will auto refresh." + :type 'boolean + :group 'neotree) + +(defcustom neo-window-width 25 + "*Specifies the width of the NeoTree window." + :type 'integer + :group 'neotree) + +(defcustom neo-window-fixed-size t + "*If the neotree windows is fixed, it won't be resize when rebalance windows." + :type 'boolean + :group 'neotree) + +(defcustom neo-keymap-style 'default + "*The default keybindings for neotree-mode-map." + :group 'neotree + :type '(choice (const default) + (const concise))) + +(defcustom neo-cwd-line-style 'text + "*The default header style." + :group 'neotree + :type '(choice (const text) + (const button))) + +(defcustom neo-help-echo-style 'default + "The message NeoTree displays when the mouse moves onto nodes. +`default' means the node name is displayed if it has a +width (including the indent) larger than `neo-window-width', and +`none' means NeoTree doesn't display any messages." + :group 'neotree + :type '(choice (const default) + (const none))) + +(defcustom neo-click-changes-root nil + "*If non-nil, clicking on a directory will change the current root to the directory." + :type 'boolean + :group 'neotree) + +(defcustom neo-auto-indent-point nil + "*If non-nil the point is autmotically put on the first letter of a node." + :type 'boolean + :group 'neotree) + +(defcustom neo-hidden-regexp-list + '("^\\." "\\.pyc$" "~$" "^#.*#$" "\\.elc$" "\\.o$") + "*The regexp list matching hidden files." + :type '(repeat (choice regexp)) + :group 'neotree) + +(defcustom neo-enter-hook nil + "Functions to run if enter node occured." + :type 'hook + :group 'neotree) + +(defcustom neo-after-create-hook nil + "Hooks called after creating the neotree buffer." + :type 'hook + :group 'neotree) + +(defcustom neo-vc-integration nil + "If non-nil, show VC status." + :group 'neotree-vc + :type '(set (const :tag "Use different faces" face) + (const :tag "Use different characters" char))) + +(defcustom neo-vc-state-char-alist + '((up-to-date . ?\s) + (edited . ?E) + (added . ?+) + (removed . ?-) + (missing . ?!) + (needs-merge . ?M) + (conflict . ?!) + (unlocked-changes . ?!) + (needs-update . ?U) + (ignored . ?\s) + (user . ?U) + (unregistered . ?\s) + (nil . ?\s)) + "Alist of vc-states to indicator characters. +This variable is used in `neo-vc-for-node' when +`neo-vc-integration' contains `char'." + :group 'neotree-vc + :type '(alist :key-type symbol + :value-type character)) + +(defcustom neo-confirm-change-root 'yes-or-no-p + "Confirmation asking for permission to change root if file was not found in root path." + :type '(choice (function-item :tag "Verbose" yes-or-no-p) + (function-item :tag "Succinct" y-or-n-p) + (function-item :tag "Off" off-p)) + :group 'neotree-confirmations) + +(defcustom neo-confirm-create-file 'yes-or-no-p + "Confirmation asking whether *NeoTree* should create a file." + :type '(choice (function-item :tag "Verbose" yes-or-no-p) + (function-item :tag "Succinct" y-or-n-p) + (function-item :tag "Off" off-p)) + :group 'neotree-confirmations) + +(defcustom neo-confirm-create-directory 'yes-or-no-p + "Confirmation asking whether *NeoTree* should create a directory." + :type '(choice (function-item :tag "Verbose" yes-or-no-p) + (function-item :tag "Succinct" y-or-n-p) + (function-item :tag "Off" off-p)) + :group 'neotree-confirmations) + +(defcustom neo-confirm-delete-file 'yes-or-no-p + "Confirmation asking whether *NeoTree* should delete the file." + :type '(choice (function-item :tag "Verbose" yes-or-no-p) + (function-item :tag "Succinct" y-or-n-p) + (function-item :tag "Off" off-p)) + :group 'neotree-confirmations) + +(defcustom neo-confirm-delete-directory-recursively 'yes-or-no-p + "Confirmation asking whether the directory should be deleted recursively." + :type '(choice (function-item :tag "Verbose" yes-or-no-p) + (function-item :tag "Succinct" y-or-n-p) + (function-item :tag "Off" off-p)) + :group 'neotree-confirmations) + +(defcustom neo-confirm-kill-buffers-for-files-in-directory 'yes-or-no-p + "Confirmation asking whether *NeoTree* should kill buffers for the directory in question." + :type '(choice (function-item :tag "Verbose" yes-or-no-p) + (function-item :tag "Succinct" y-or-n-p) + (function-item :tag "Off" off-p)) + :group 'neotree-confirmations) + +(defcustom neo-toggle-window-keep-p nil + "If not nil, not switch to *NeoTree* buffer when executing `neotree-toggle'." + :type 'boolean + :group 'neotree) + +(defcustom neo-force-change-root t + "If not nil, do not prompt when switching root." + :type 'boolean + :group 'neotree) + +(defcustom neo-filepath-sort-function 'string< + "Function to be called when sorting neotree nodes." + :type '(symbol (const :tag "Normal" string<) + (const :tag "Sort Hidden at Bottom" neo-sort-hidden-last) + (function :tag "Other")) + :group 'neotree) + +(defcustom neo-default-system-application "xdg-open" + "*Name of the application that is used to open a file under point. +By default it is xdg-open." + :type 'string + :group 'neotree) + +(defcustom neo-hide-cursor nil + "If not nil, hide cursor in NeoTree buffer and turn on line higlight." + :type 'boolean + :group 'neotree) + +;; +;; Faces +;; + +(defface neo-banner-face + '((((background dark)) (:foreground "lightblue" :weight bold)) + (t (:foreground "DarkMagenta"))) + "*Face used for the banner in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-banner-face 'neo-banner-face) + +(defface neo-header-face + '((((background dark)) (:foreground "White")) + (t (:foreground "DarkMagenta"))) + "*Face used for the header in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-header-face 'neo-header-face) + +(defface neo-root-dir-face + '((((background dark)) (:foreground "lightblue" :weight bold)) + (t (:foreground "DarkMagenta"))) + "*Face used for the root dir in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-root-dir-face 'neo-root-dir-face) + +(defface neo-dir-link-face + '((((background dark)) (:foreground "DeepSkyBlue")) + (t (:foreground "MediumBlue"))) + "*Face used for expand sign [+] in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-dir-link-face 'neo-dir-link-face) + +(defface neo-file-link-face + '((((background dark)) (:foreground "White")) + (t (:foreground "Black"))) + "*Face used for open file/dir in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-file-link-face 'neo-file-link-face) + +(defface neo-button-face + '((t (:underline nil))) + "*Face used for open file/dir in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-button-face 'neo-button-face) + +(defface neo-expand-btn-face + '((((background dark)) (:foreground "SkyBlue")) + (t (:foreground "DarkCyan"))) + "*Face used for open file/dir in neotree buffer." + :group 'neotree :group 'font-lock-highlighting-faces) +(defvar neo-expand-btn-face 'neo-expand-btn-face) + +(defface neo-vc-default-face + '((((background dark)) (:foreground "White")) + (t (:foreground "Black"))) + "*Face used for unknown files in the neotree buffer. +Used only when \(vc-state node\) returns nil." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-default-face 'neo-vc-default-face) + +(defface neo-vc-user-face + '((t (:foreground "Red" :slant italic))) + "*Face used for user-locked files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-user-face 'neo-vc-user-face) + +(defface neo-vc-up-to-date-face + '((((background dark)) (:foreground "LightGray")) + (t (:foreground "DarkGray"))) + "*Face used for vc-up-to-date files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-up-to-date-face 'neo-vc-up-to-date-face) + +(defface neo-vc-edited-face + '((((background dark)) (:foreground "Magenta")) + (t (:foreground "DarkMagenta"))) + "*Face used for vc-edited files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-edited-face 'neo-vc-edited-face) + +(defface neo-vc-needs-update-face + '((t (:underline t))) + "*Face used for vc-needs-update files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-needs-update-face 'neo-vc-needs-update-face) + +(defface neo-vc-needs-merge-face + '((((background dark)) (:foreground "Red1")) + (t (:foreground "Red3"))) + "*Face used for vc-needs-merge files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-needs-merge-face 'neo-vc-needs-merge-face) + +(defface neo-vc-unlocked-changes-face + '((t (:foreground "Red" :background "Blue"))) + "*Face used for vc-unlocked-changes files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-unlocked-changes-face 'neo-vc-unlocked-changes-face) + +(defface neo-vc-added-face + '((((background dark)) (:foreground "LightGreen")) + (t (:foreground "DarkGreen"))) + "*Face used for vc-added files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-added-face 'neo-vc-added-face) + +(defface neo-vc-removed-face + '((t (:strike-through t))) + "*Face used for vc-removed files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-removed-face 'neo-vc-removed-face) + +(defface neo-vc-conflict-face + '((((background dark)) (:foreground "Red1")) + (t (:foreground "Red3"))) + "*Face used for vc-conflict files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-conflict-face 'neo-vc-conflict-face) + +(defface neo-vc-missing-face + '((((background dark)) (:foreground "Red1")) + (t (:foreground "Red3"))) + "*Face used for vc-missing files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-missing-face 'neo-vc-missing-face) + +(defface neo-vc-ignored-face + '((((background dark)) (:foreground "DarkGrey")) + (t (:foreground "LightGray"))) + "*Face used for vc-ignored files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-ignored-face 'neo-vc-ignored-face) + +(defface neo-vc-unregistered-face + nil + "*Face used for vc-unregistered files in the neotree buffer." + :group 'neotree-vc :group 'font-lock-highlighting-faces) +(defvar neo-vc-unregistered-face 'neo-vc-unregistered-face) + +;; +;; Variables +;; + +(defvar neo-global--buffer nil) + +(defvar neo-global--window nil) + +(defvar neo-global--autorefresh-timer nil) + +(defvar neo-mode-line-format + (list + '(:eval + (let* ((fname (neo-buffer--get-filename-current-line)) + (current (if fname fname neo-buffer--start-node)) + (parent (if fname (file-name-directory current) current)) + (nodes (neo-buffer--get-nodes parent)) + (dirs (car nodes)) + (files (cdr nodes)) + (ndirs (length dirs)) + (nfiles (length files)) + (index + (when fname + (1+ (if (file-directory-p current) + (neo-buffer--get-node-index current dirs) + (+ ndirs (neo-buffer--get-node-index current files))))))) + (neo-mode-line--compute-format parent index ndirs nfiles)))) + "Neotree mode-line displaying information on the current node. +This mode-line format is used if `neo-mode-line-type' is set to `neotree'") + +(defvar-local neo-buffer--start-node nil + "Start node(i.e. directory) for the window.") + +(defvar-local neo-buffer--start-line nil + "Index of the start line of the root.") + +(defvar-local neo-buffer--cursor-pos (cons nil 1) + "To save the cursor position. +The car of the pair will store fullpath, and cdr will store line number.") + +(defvar-local neo-buffer--last-window-pos (cons nil 1) + "To save the scroll position for NeoTree window.") + +(defvar-local neo-buffer--show-hidden-file-p nil + "Show hidden nodes in tree.") + +(defvar-local neo-buffer--expanded-node-list nil + "A list of expanded dir nodes.") + +(defvar-local neo-buffer--node-list nil + "The model of current NeoTree buffer.") + +(defvar-local neo-buffer--node-list-1 nil + "The model of current NeoTree buffer (temp).") + +;; +;; Major mode definitions +;; + +(defvar neotree-file-button-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] + (neotree-make-executor + :file-fn 'neo-open-file)) + map) + "Keymap for file-node button.") + +(defvar neotree-dir-button-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] + (neotree-make-executor :dir-fn 'neo-open-dir)) + map) + "Keymap for dir-node button.") + +(defvar neotree-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "TAB") (neotree-make-executor + :dir-fn 'neo-open-dir)) + (define-key map (kbd "RET") (neotree-make-executor + :file-fn 'neo-open-file + :dir-fn 'neo-open-dir)) + (define-key map (kbd "|") (neotree-make-executor + :file-fn 'neo-open-file-vertical-split)) + (define-key map (kbd "-") (neotree-make-executor + :file-fn 'neo-open-file-horizontal-split)) + (define-key map (kbd "a") (neotree-make-executor + :file-fn 'neo-open-file-ace-window)) + (define-key map (kbd "d") (neotree-make-executor + :dir-fn 'neo-open-dired)) + (define-key map (kbd "O") (neotree-make-executor + :dir-fn 'neo-open-dir-recursive)) + (define-key map (kbd "SPC") 'neotree-quick-look) + (define-key map (kbd "g") 'neotree-refresh) + (define-key map (kbd "q") 'neotree-hide) + (define-key map (kbd "p") 'neotree-previous-line) + (define-key map (kbd "C-p") 'neotree-previous-line) + (define-key map (kbd "n") 'neotree-next-line) + (define-key map (kbd "C-n") 'neotree-next-line) + (define-key map (kbd "A") 'neotree-stretch-toggle) + (define-key map (kbd "U") 'neotree-select-up-node) + (define-key map (kbd "D") 'neotree-select-down-node) + (define-key map (kbd "H") 'neotree-hidden-file-toggle) + (define-key map (kbd "S") 'neotree-select-previous-sibling-node) + (define-key map (kbd "s") 'neotree-select-next-sibling-node) + (define-key map (kbd "o") 'neotree-open-file-in-system-application) + (define-key map (kbd "C-x C-f") 'find-file-other-window) + (define-key map (kbd "C-x 1") 'neotree-empty-fn) + (define-key map (kbd "C-x 2") 'neotree-empty-fn) + (define-key map (kbd "C-x 3") 'neotree-empty-fn) + (define-key map (kbd "C-c C-f") 'find-file-other-window) + (define-key map (kbd "C-c C-c") 'neotree-change-root) + (define-key map (kbd "C-c c") 'neotree-dir) + (define-key map (kbd "C-c C-a") 'neotree-collapse-all) + (cond + ((eq neo-keymap-style 'default) + (define-key map (kbd "C-c C-n") 'neotree-create-node) + (define-key map (kbd "C-c C-d") 'neotree-delete-node) + (define-key map (kbd "C-c C-r") 'neotree-rename-node) + (define-key map (kbd "C-c C-p") 'neotree-copy-node)) + ((eq neo-keymap-style 'concise) + (define-key map (kbd "C") 'neotree-change-root) + (define-key map (kbd "c") 'neotree-create-node) + (define-key map (kbd "+") 'neotree-create-node) + (define-key map (kbd "d") 'neotree-delete-node) + (define-key map (kbd "r") 'neotree-rename-node) + (define-key map (kbd "e") 'neotree-enter))) + map) + "Keymap for `neotree-mode'.") + +(define-derived-mode neotree-mode special-mode "NeoTree" + "A major mode for displaying the directory tree in text mode." + (setq indent-tabs-mode nil ; only spaces + buffer-read-only t ; read only + truncate-lines -1 + neo-buffer--show-hidden-file-p neo-show-hidden-files) + (when neo-hide-cursor + (progn + (setq cursor-type nil) + (hl-line-mode +1))) + (pcase neo-mode-line-type + (`neotree + (setq-local mode-line-format neo-mode-line-format) + (add-hook 'post-command-hook 'force-mode-line-update nil t)) + (`none (setq-local mode-line-format nil)) + (`custom + (setq-local mode-line-format neo-mode-line-custom-format) + (add-hook 'post-command-hook 'force-mode-line-update nil t)) + (_ nil)) + ;; fix for electric-indent-mode + ;; for emacs 24.4 + (if (fboundp 'electric-indent-local-mode) + (electric-indent-local-mode -1) + ;; for emacs 24.3 or less + (add-hook 'electric-indent-functions + (lambda (arg) 'no-indent) nil 'local)) + (when neo-auto-indent-point + (add-hook 'post-command-hook 'neo-hook--node-first-letter nil t))) + +;; +;; Global methods +;; + +(defun neo-global--window-exists-p () + "Return non-nil if neotree window exists." + (and (not (null (window-buffer neo-global--window))) + (eql (window-buffer neo-global--window) (neo-global--get-buffer)))) + +(defun neo-global--select-window () + "Select the NeoTree window." + (interactive) + (let ((window (neo-global--get-window t))) + (select-window window))) + +(defun neo-global--get-window (&optional auto-create-p) + "Return the neotree window if it exists, else return nil. +But when the neotree window does not exist and AUTO-CREATE-P is non-nil, +it will create the neotree window and return it." + (unless (neo-global--window-exists-p) + (setf neo-global--window nil)) + (when (and (null neo-global--window) + auto-create-p) + (setq neo-global--window + (neo-global--create-window))) + neo-global--window) + +(defun neo-default-display-fn (buffer _alist) + "Display BUFFER to the left or right of the root window. +The side is decided according to `neo-window-position'. +The root window is the root window of the selected frame. +_ALIST is ignored." + (let ((window-pos (if (eq neo-window-position 'left) 'left 'right))) + (display-buffer-in-side-window buffer `((side . ,window-pos))))) + +(defun neo-global--create-window () + "Create global neotree window." + (let ((window nil) + (buffer (neo-global--get-buffer t))) + (setq window + (select-window + (display-buffer buffer neo-display-action))) + (neo-window--init window buffer) + (neo-global--attach) + (neo-global--reset-width) + window)) + +(defun neo-global--get-buffer (&optional init-p) + "Return the global neotree buffer if it exists. +If INIT-P is non-nil and global NeoTree buffer not exists, then create it." + (unless (equal (buffer-name neo-global--buffer) + neo-buffer-name) + (setf neo-global--buffer nil)) + (when (and init-p + (null neo-global--buffer)) + (save-window-excursion + (setq neo-global--buffer + (neo-buffer--create)))) + neo-global--buffer) + +(defun neo-global--file-in-root-p (path) + "Return non-nil if PATH in root dir." + (neo-global--with-buffer + (and (not (null neo-buffer--start-node)) + (neo-path--file-in-directory-p path neo-buffer--start-node)))) + +(defun neo-global--alone-p () + "Check whether the global neotree window is alone with some other window." + (let ((windows (window-list))) + (and (= (length windows) + 2) + (member neo-global--window windows)))) + +(defun neo-global--do-autorefresh () + "Do auto refresh." + (interactive) + (when (and neo-autorefresh (neo-global--window-exists-p) + (buffer-file-name)) + (neotree-refresh t))) + +(defun neo-global--open () + "Show the NeoTree window." + (let ((valid-start-node-p nil)) + (neo-global--with-buffer + (setf valid-start-node-p (neo-buffer--valid-start-node-p))) + (if (not valid-start-node-p) + (neo-global--open-dir (neo-path--get-working-dir)) + (neo-global--get-window t)))) + +(defun neo-global--open-dir (path) + "Show the NeoTree window, and change root to PATH." + (neo-global--get-window t) + (neo-global--with-buffer + (neo-buffer--change-root path))) + +(defun neo-global--open-and-find (path) + "Quick select node which specified PATH in NeoTree." + (let ((npath path) + root-dir) + (when (null npath) + (throw 'invalid-path "Invalid path to select.")) + (setq root-dir (if (file-directory-p npath) + npath (neo-path--updir npath))) + (when (or (not (neo-global--window-exists-p)) + (not (neo-global--file-in-root-p npath))) + (neo-global--open-dir root-dir)) + (neo-global--with-window + (neo-buffer--select-file-node npath t)))) + +(defun neo-global--select-mru-window (arg) + "Create or find a window to select when open a file node. +The description of ARG is in `neotree-enter'." + (when (eq (safe-length (window-list)) 1) + (neo-buffer--with-resizable-window + (split-window-horizontally))) + (when neo-reset-size-on-open + (neo-global--when-window + (neo-window--zoom 'minimize))) + ;; select target window + (cond + ;; select window with winum + ((and (integerp arg) + (bound-and-true-p winum-mode) + (fboundp 'winum-select-window-by-number)) + (winum-select-window-by-number arg)) + ;; select window with window numbering + ((and (integerp arg) + (boundp 'window-numbering-mode) + (symbol-value window-numbering-mode) + (fboundp 'select-window-by-number)) + (select-window-by-number arg)) + ;; open node in a new vertically split window + ((and (stringp arg) (string= arg "a") + (fboundp 'ace-select-window)) + (ace-select-window)) + ((and (stringp arg) (string= arg "|")) + (select-window (get-mru-window)) + (split-window-right) + (windmove-right)) + ;; open node in a new horizontally split window + ((and (stringp arg) (string= arg "-")) + (select-window (get-mru-window)) + (split-window-below) + (windmove-down))) + ;; open node in last active window + (select-window (get-mru-window))) + +(defun neo-global--detach () + "Detach the global neotree buffer." + (when neo-global--autorefresh-timer + (cancel-timer neo-global--autorefresh-timer)) + (neo-global--with-buffer + (neo-buffer--unlock-width)) + (setq neo-global--buffer nil) + (setq neo-global--window nil)) + +(defun neo-global--attach () + "Attach the global neotree buffer" + (when neo-global--autorefresh-timer + (cancel-timer neo-global--autorefresh-timer)) + (when neo-autorefresh + (setq neo-global--autorefresh-timer + (run-with-idle-timer 2 10 'neo-global--do-autorefresh))) + (setq neo-global--buffer (get-buffer neo-buffer-name)) + (setq neo-global--window (get-buffer-window + neo-global--buffer)) + (neo-global--with-buffer + (neo-buffer--lock-width)) + (run-hook-with-args 'neo-after-create-hook '(window))) + +(defun neo-global--set-window-width (width) + "Set neotree window width to WIDTH." + (neo-global--with-window + (neo-buffer--with-resizable-window + (neo-util--set-window-width (selected-window) width)))) + +(defun neo-global--reset-width () + "Set neotree window width to `neo-window-width'." + (neo-global--set-window-width neo-window-width)) + +;; +;; Advices +;; + +(defadvice mouse-drag-vertical-line + (around neotree-drag-vertical-line (start-event) activate) + "Drag and drop is not affected by the lock." + (neo-buffer--with-resizable-window + ad-do-it)) + +(defadvice balance-windows + (around neotree-balance-windows activate) + "Fix neotree inhibits balance-windows." + (if (neo-global--window-exists-p) + (let (old-width) + (neo-global--with-window + (setq old-width (window-width))) + (neo-buffer--with-resizable-window + ad-do-it) + (neo-global--with-window + (neo-global--set-window-width old-width))) + ad-do-it)) + +(eval-after-load 'popwin + '(progn + (defadvice popwin:create-popup-window + (around neotree/popwin-popup-buffer activate) + (let ((neo-exists-p (neo-global--window-exists-p))) + (when neo-exists-p + (neo-global--detach)) + ad-do-it + (when neo-exists-p + (neo-global--attach) + (neo-global--reset-width)))) + + (defadvice popwin:close-popup-window + (around neotree/popwin-close-popup-window activate) + (let ((neo-exists-p (neo-global--window-exists-p))) + (when neo-exists-p + (neo-global--detach)) + ad-do-it + (when neo-exists-p + (neo-global--attach) + (neo-global--reset-width)))))) + +;; +;; Hooks +;; + +(defun neo-hook--node-first-letter () + "Move point to the first letter of the current node." + (when (or (eq this-command 'next-line) + (eq this-command 'previous-line)) + (neo-point-auto-indent))) + +;; +;; Util methods +;; + +(defun neo-util--filter (condp lst) + "Apply CONDP to elements of LST keeping those that return non-nil. + +Example: + (neo-util--filter 'symbolp '(a \"b\" 3 d4)) + => (a d4) + +This procedure does not work when CONDP is the `null' function." + (delq nil + (mapcar (lambda (x) (and (funcall condp x) x)) lst))) + +(defun neo-util--find (where which) + "Find element of the list WHERE matching predicate WHICH." + (catch 'found + (dolist (elt where) + (when (funcall which elt) + (throw 'found elt))) + nil)) + +(defun neo-util--make-printable-string (string) + "Strip newline character from STRING, like 'Icon\n'." + (replace-regexp-in-string "\n" "" string)) + +(defun neo-util--walk-dir (path) + "Return the subdirectories and subfiles of the PATH." + (let* ((full-path (neo-path--file-truename path))) + (condition-case nil + (directory-files + path 'full directory-files-no-dot-files-regexp) + ('file-error + (message "Walk directory %S failed." path) + nil)))) + +(defun neo-util--hidden-path-filter (node) + "A filter function, if the NODE can not match each item in \ +`neo-hidden-regexp-list', return t." + (if (not neo-buffer--show-hidden-file-p) + (let ((shortname (neo-path--file-short-name node))) + (null (neo-util--filter + (lambda (x) (not (null (string-match-p x shortname)))) + neo-hidden-regexp-list))) + node)) + +(defun neo-str--trim-left (s) + "Remove whitespace at the beginning of S." + (if (string-match "\\`[ \t\n\r]+" s) + (replace-match "" t t s) + s)) + +(defun neo-str--trim-right (s) + "Remove whitespace at the end of S." + (if (string-match "[ \t\n\r]+\\'" s) + (replace-match "" t t s) + s)) + +(defun neo-str--trim (s) + "Remove whitespace at the beginning and end of S." + (neo-str--trim-left (neo-str--trim-right s))) + +(defun neo-path--expand-name (path &optional current-dir) + (expand-file-name (or (if (file-name-absolute-p path) path) + (let ((r-path path)) + (setq r-path (substitute-in-file-name r-path)) + (setq r-path (expand-file-name r-path current-dir)) + r-path)))) + +(defun neo-path--shorten (path len) + "Shorten a given PATH to a specified LEN. +This is needed for paths, which are to long for the window to display +completely. The function cuts of the first part of the path to remain +the last folder (the current one)." + (let ((result + (if (> (length path) len) + (concat "<" (substring path (- (- len 2)))) + path))) + (when result + (decode-coding-string result 'utf-8)))) + +(defun neo-path--insert-chroot-button (label path face) + (insert-button + label + 'action '(lambda (x) (neotree-change-root)) + 'follow-link t + 'face face + 'neo-full-path path)) + +(defun neo-path--insert-header-buttonized (path) + "Shortens the PATH to (window-body-width) and displays any \ +visible remains as buttons that, when clicked, navigate to that +parent directory." + (let* ((dirs (reverse (cl-maplist 'identity (reverse (split-string path "/" :omitnulls))))) + (last (car-safe (car-safe (last dirs))))) + (neo-path--insert-chroot-button "/" "/" 'neo-root-dir-face) + (dolist (dir dirs) + (if (string= (car dir) last) + (neo-buffer--insert-with-face last 'neo-root-dir-face) + (neo-path--insert-chroot-button + (concat (car dir) "/") + (apply 'neo-path--join (cons "/" (reverse dir))) + 'neo-root-dir-face)))) + ;;shorten the line if need be + (when (> (current-column) (window-body-width)) + (forward-char (- (window-body-width))) + (delete-region (point-at-bol) (point)) + (let* ((button (button-at (point))) + (path (if button (overlay-get button 'neo-full-path) "/"))) + (neo-path--insert-chroot-button "<" path 'neo-root-dir-face)) + (end-of-line))) + +(defun neo-path--updir (path) + (let ((r-path (neo-path--expand-name path))) + (if (and (> (length r-path) 0) + (equal (substring r-path -1) "/")) + (setq r-path (substring r-path 0 -1))) + (if (eq (length r-path) 0) + (setq r-path "/")) + (directory-file-name + (file-name-directory r-path)))) + +(defun neo-path--join (root &rest dirs) + "Joins a series of directories together with ROOT and DIRS. +Like Python's os.path.join, + (neo-path--join \"/tmp\" \"a\" \"b\" \"c\") => /tmp/a/b/c ." + (or (if (not dirs) root) + (let ((tdir (car dirs)) + (epath nil)) + (setq epath + (or (if (equal tdir ".") root) + (if (equal tdir "..") (neo-path--updir root)) + (neo-path--expand-name tdir root))) + (apply 'neo-path--join + epath + (cdr dirs))))) + +(defun neo-path--file-short-name (file) + "Base file/directory name by FILE. +Taken from http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01238.html" + (or (if (string= file "/") "/") + (neo-util--make-printable-string (file-name-nondirectory (directory-file-name file))))) + +(defun neo-path--file-truename (path) + (let ((rlt (file-truename path))) + (if (not (null rlt)) + (progn + (if (and (file-directory-p rlt) + (> (length rlt) 0) + (not (equal (substring rlt -1) "/"))) + (setq rlt (concat rlt "/"))) + rlt) + nil))) + +(defun neo-path--has-subfile-p (dir) + "To determine whether a directory(DIR) contain files." + (and (file-exists-p dir) + (file-directory-p dir) + (neo-util--walk-dir dir) + t)) + +(defun neo-path--match-path-directory (path) + (let ((true-path (neo-path--file-truename path)) + (rlt-path nil)) + (setq rlt-path + (catch 'rlt + (if (file-directory-p true-path) + (throw 'rlt true-path)) + (setq true-path + (file-name-directory true-path)) + (if (file-directory-p true-path) + (throw 'rlt true-path)))) + (if (not (null rlt-path)) + (setq rlt-path (neo-path--join "." rlt-path "./"))) + rlt-path)) + +(defun neo-path--get-working-dir () + "Return a directory name of the current buffer." + (file-name-as-directory (file-truename default-directory))) + +(defun neo-path--strip (path) + "Remove whitespace at the end of PATH." + (let* ((rlt (neo-str--trim path)) + (pos (string-match "[\\\\/]+\\'" rlt))) + (when pos + (setq rlt (replace-match "" t t rlt)) + (when (eq (length rlt) 0) + (setq rlt "/"))) + rlt)) + +(defun neo-path--path-equal-p (path1 path2) + "Return non-nil if pathes PATH1 and PATH2 are the same path." + (string-equal (neo-path--strip path1) + (neo-path--strip path2))) + +(defun neo-path--file-equal-p (file1 file2) + "Return non-nil if files FILE1 and FILE2 name the same file. +If FILE1 or FILE2 does not exist, the return value is unspecified." + (unless (or (null file1) + (null file2)) + (let ((nfile1 (neo-path--strip file1)) + (nfile2 (neo-path--strip file2))) + (file-equal-p nfile1 nfile2)))) + +(defun neo-path--file-in-directory-p (file dir) + "Return non-nil if FILE is in DIR or a subdirectory of DIR. +A directory is considered to be \"in\" itself. +Return nil if DIR is not an existing directory." + (let ((nfile (neo-path--strip file)) + (ndir (neo-path--strip dir))) + (setq ndir (concat ndir "/")) + (file-in-directory-p nfile ndir))) + +(defun neo-util--kill-buffers-for-path (path) + "Kill all buffers for files in PATH." + (let ((buffer (find-buffer-visiting path))) + (when buffer + (kill-buffer buffer))) + (dolist (filename (directory-files path t directory-files-no-dot-files-regexp)) + (let ((buffer (find-buffer-visiting filename))) + (when buffer + (kill-buffer buffer)) + (when (and + (file-directory-p filename) + (neo-path--has-subfile-p filename)) + (neo-util--kill-buffers-for-path filename))))) + +(defun neo-util--set-window-width (window n) + "Make WINDOW N columns width." + (let ((w (max n window-min-width))) + (unless (null window) + (if (> (window-width) w) + (shrink-window-horizontally (- (window-width) w)) + (if (< (window-width) w) + (enlarge-window-horizontally (- w (window-width)))))))) + +(defun neo-point-auto-indent () + "Put the point on the first letter of the current node." + (when (neo-buffer--get-filename-current-line) + (beginning-of-line 1) + (re-search-forward "[^-\s+]" (line-end-position 1) t) + (backward-char 1))) + +(defun off-p (msg) + "Returns true regardless of message value in the argument." + t) + +(defun neo-sort-hidden-last (x y) + "Sort normally but with hidden files last." + (let ((x-hidden (neo-filepath-hidden-p x)) + (y-hidden (neo-filepath-hidden-p y))) + (cond + ((and x-hidden (not y-hidden)) + nil) + ((and (not x-hidden) y-hidden) + t) + (t + (string< x y))))) + +(defun neo-filepath-hidden-p (node) + "Return whether or not node is a hidden path." + (let ((shortname (neo-path--file-short-name node))) + (neo-util--filter + (lambda (x) (not (null (string-match-p x shortname)))) + neo-hidden-regexp-list))) + +(defun neo-get-unsaved-buffers-from-projectile () + "Return list of unsaved buffers from projectile buffers." + (interactive) + (let ((rlist '()) + (rtag t)) + (condition-case nil + (projectile-project-buffers) + (error (setq rtag nil))) + (when (and rtag (fboundp 'projectile-project-buffers)) + (dolist (buf (projectile-project-buffers)) + (with-current-buffer buf + (if (and (buffer-modified-p) buffer-file-name) + (setq rlist (cons (buffer-file-name) rlist)) + )))) + rlist)) + +;; +;; Buffer methods +;; + +(defun neo-buffer--newline-and-begin () + "Insert new line." + (newline) + (beginning-of-line)) + +(defun neo-buffer--get-icon (name) + "Get image by NAME." + (let ((icon-path (neo-path--join neo-dir "icons")) + image) + (setq image (create-image + (neo-path--join icon-path (concat name ".xpm")) + 'xpm nil :ascent 'center :mask '(heuristic t))) + image)) + +(defun neo-buffer--insert-fold-symbol (name &optional node-name) + "Write icon by NAME, the icon style affected by neo-theme. +`open' write opened folder icon. +`close' write closed folder icon. +`leaf' write leaf icon. +Optional NODE-NAME is used for the `icons' theme" + (let ((n-insert-image (lambda (n) + (insert-image (neo-buffer--get-icon n)))) + (n-insert-symbol (lambda (n) + (neo-buffer--insert-with-face + n 'neo-expand-btn-face)))) + (cond + ((and (display-graphic-p) (equal neo-theme 'classic)) + (or (and (equal name 'open) (funcall n-insert-image "open")) + (and (equal name 'close) (funcall n-insert-image "close")) + (and (equal name 'leaf) (funcall n-insert-image "leaf")))) + ((equal neo-theme 'arrow) + (or (and (equal name 'open) (funcall n-insert-symbol "▾")) + (and (equal name 'close) (funcall n-insert-symbol "▸")))) + ((equal neo-theme 'nerd) + (or (and (equal name 'open) (funcall n-insert-symbol "▾ ")) + (and (equal name 'close) (funcall n-insert-symbol "▸ ")) + (and (equal name 'leaf) (funcall n-insert-symbol " ")))) + ((and (display-graphic-p) (equal neo-theme 'icons)) + (unless (require 'all-the-icons nil 'noerror) + (error "Package `all-the-icons' isn't installed")) + (setq-local tab-width 1) + (or (and (equal name 'open) (insert (all-the-icons-icon-for-dir-with-chevron (directory-file-name node-name) "down"))) + (and (equal name 'close) (insert (all-the-icons-icon-for-dir-with-chevron (directory-file-name node-name) "right"))) + (and (equal name 'leaf) (insert (format "\t\t\t%s\t" (all-the-icons-icon-for-file node-name)))))) + (t + (or (and (equal name 'open) (funcall n-insert-symbol "- ")) + (and (equal name 'close) (funcall n-insert-symbol "+ "))))))) + +(defun neo-buffer--save-cursor-pos (&optional node-path line-pos) + "Save cursor position. +If NODE-PATH and LINE-POS is nil, it will be save the current line node position." + (let ((cur-node-path nil) + (cur-line-pos nil) + (ws-wind (selected-window)) + (ws-pos (window-start))) + (setq cur-node-path (if node-path + node-path + (neo-buffer--get-filename-current-line))) + (setq cur-line-pos (if line-pos + line-pos + (line-number-at-pos))) + (setq neo-buffer--cursor-pos (cons cur-node-path cur-line-pos)) + (setq neo-buffer--last-window-pos (cons ws-wind ws-pos)))) + +(defun neo-buffer--goto-cursor-pos () + "Jump to saved cursor position." + (let ((line-pos nil) + (node (car neo-buffer--cursor-pos)) + (line-pos (cdr neo-buffer--cursor-pos)) + (ws-wind (car neo-buffer--last-window-pos)) + (ws-pos (cdr neo-buffer--last-window-pos))) + (catch 'line-pos-founded + (unless (null node) + (setq line-pos 0) + (mapc + (lambda (x) + (setq line-pos (1+ line-pos)) + (unless (null x) + (when (neo-path--path-equal-p x node) + (throw 'line-pos-founded line-pos)))) + neo-buffer--node-list)) + (setq line-pos (cdr neo-buffer--cursor-pos)) + (throw 'line-pos-founded line-pos)) + ;; goto line + (goto-char (point-min)) + (neo-buffer--forward-line (1- line-pos)) + ;; scroll window + (when (equal (selected-window) ws-wind) + (set-window-start ws-wind ws-pos t)))) + +(defun neo-buffer--node-list-clear () + "Clear node list." + (setq neo-buffer--node-list nil)) + +(defun neo-buffer--node-list-set (line-num path) + "Set value in node list. +LINE-NUM is the index of node list. +PATH is value." + (let ((node-list-length (length neo-buffer--node-list)) + (node-index line-num)) + (when (null node-index) + (setq node-index (line-number-at-pos))) + (when (< node-list-length node-index) + (setq neo-buffer--node-list + (vconcat neo-buffer--node-list + (make-vector (- node-index node-list-length) nil)))) + (aset neo-buffer--node-list (1- node-index) path)) + neo-buffer--node-list) + +(defun neo-buffer--insert-with-face (content face) + (let ((pos-start (point))) + (insert content) + (set-text-properties pos-start + (point) + (list 'face face)))) + +(defun neo-buffer--valid-start-node-p () + (and (not (null neo-buffer--start-node)) + (file-accessible-directory-p neo-buffer--start-node))) + +(defun neo-buffer--create () + "Create and switch to NeoTree buffer." + (switch-to-buffer + (generate-new-buffer-name neo-buffer-name)) + (neotree-mode) + ;; disable linum-mode + (when (and (boundp 'linum-mode) + (not (null linum-mode))) + (linum-mode -1)) + ;; Use inside helm window in NeoTree + ;; Refs https://github.com/jaypei/emacs-neotree/issues/226 + (setq-local helm-split-window-inside-p t) + (current-buffer)) + +(defun neo-buffer--insert-banner () + (unless (null neo-banner-message) + (let ((start (point))) + (insert neo-banner-message) + (set-text-properties start (point) '(face neo-banner-face))) + (neo-buffer--newline-and-begin))) + +(defun neo-buffer--insert-root-entry (node) + (neo-buffer--node-list-set nil node) + (cond ((eq neo-cwd-line-style 'button) + (neo-path--insert-header-buttonized node)) + (t + (neo-buffer--insert-with-face (neo-path--shorten node (window-body-width)) + 'neo-root-dir-face))) + (neo-buffer--newline-and-begin) + (when neo-show-updir-line + (neo-buffer--insert-fold-symbol 'close node) + (insert-button ".." + 'action '(lambda (x) (neotree-change-root)) + 'follow-link t + 'face neo-dir-link-face + 'neo-full-path (neo-path--updir node)) + (neo-buffer--newline-and-begin))) + +(defun neo-buffer--help-echo-message (node-name) + (cond + ((eq neo-help-echo-style 'default) + (if (<= (+ (current-column) (string-width node-name)) + neo-window-width) + nil + node-name)) + (t nil))) + +(defun neo-buffer--insert-dir-entry (node depth expanded) + (let ((node-short-name (neo-path--file-short-name node))) + (insert-char ?\s (* (- depth 1) 2)) ; indent + (when (memq 'char neo-vc-integration) + (insert-char ?\s 2)) + (neo-buffer--insert-fold-symbol + (if expanded 'open 'close) node) + (insert-button (if neo-show-slash-for-folder (concat node-short-name "/") node-short-name) + 'follow-link t + 'face neo-dir-link-face + 'neo-full-path node + 'keymap neotree-dir-button-keymap + 'help-echo (neo-buffer--help-echo-message node-short-name)) + (neo-buffer--node-list-set nil node) + (neo-buffer--newline-and-begin))) + +(defun neo-buffer--insert-file-entry (node depth) + (let ((node-short-name (neo-path--file-short-name node)) + (vc (when neo-vc-integration (neo-vc-for-node node)))) + (insert-char ?\s (* (- depth 1) 2)) ; indent + (when (memq 'char neo-vc-integration) + (insert-char (car vc)) + (insert-char ?\s)) + (neo-buffer--insert-fold-symbol 'leaf node-short-name) + (insert-button node-short-name + 'follow-link t + 'face (if (memq 'face neo-vc-integration) + (cdr vc) + neo-file-link-face) + 'neo-full-path node + 'keymap neotree-file-button-keymap + 'help-echo (neo-buffer--help-echo-message node-short-name)) + (neo-buffer--node-list-set nil node) + (neo-buffer--newline-and-begin))) + +(defun neo-vc-for-node (node) + (let* ((backend (ignore-errors + (vc-responsible-backend node))) + (vc-state (when backend (vc-state node backend)))) + (cons (cdr (assoc vc-state neo-vc-state-char-alist)) + (cl-case vc-state + (up-to-date neo-vc-up-to-date-face) + (edited neo-vc-edited-face) + (needs-update neo-vc-needs-update-face) + (needs-merge neo-vc-needs-merge-face) + (unlocked-changes neo-vc-unlocked-changes-face) + (added neo-vc-added-face) + (removed neo-vc-removed-face) + (conflict neo-vc-conflict-face) + (missing neo-vc-missing-face) + (ignored neo-vc-ignored-face) + (unregistered neo-vc-unregistered-face) + (user neo-vc-user-face) + (otherwise neo-vc-default-face))))) + +(defun neo-buffer--get-nodes (path) + (let* ((nodes (neo-util--walk-dir path)) + (comp neo-filepath-sort-function) + (nodes (neo-util--filter 'neo-util--hidden-path-filter nodes))) + (cons (sort (neo-util--filter 'file-directory-p nodes) comp) + (sort (neo-util--filter #'(lambda (f) (not (file-directory-p f))) nodes) comp)))) + +(defun neo-buffer--get-node-index (node nodes) + "Return the index of NODE in NODES. + +NODES can be a list of directory or files. +Return nil if NODE has not been found in NODES." + (let ((i 0) + (l (length nodes)) + (cur (car nodes)) + (rest (cdr nodes))) + (while (and cur (not (equal cur node))) + (setq i (1+ i)) + (setq cur (car rest)) + (setq rest (cdr rest))) + (if (< i l) i))) + +(defun neo-buffer--expanded-node-p (node) + "Return non-nil if NODE is expanded." + (neo-util--to-bool + (neo-util--find + neo-buffer--expanded-node-list + #'(lambda (x) (equal x node))))) + +(defun neo-buffer--set-expand (node do-expand) + "Set the expanded state of the NODE to DO-EXPAND. +Return the new expand state for NODE (t for expanded, nil for collapsed)." + (if (not do-expand) + (setq neo-buffer--expanded-node-list + (neo-util--filter + #'(lambda (x) (not (equal node x))) + neo-buffer--expanded-node-list)) + (push node neo-buffer--expanded-node-list)) + do-expand) + +(defun neo-buffer--toggle-expand (node) + (neo-buffer--set-expand node (not (neo-buffer--expanded-node-p node)))) + +(defun neo-buffer--insert-tree (path depth) + (if (eq depth 1) + (neo-buffer--insert-root-entry path)) + (let* ((contents (neo-buffer--get-nodes path)) + (nodes (car contents)) + (leafs (cdr contents)) + (default-directory path)) + (dolist (node nodes) + (let ((expanded (neo-buffer--expanded-node-p node))) + (neo-buffer--insert-dir-entry + node depth expanded) + (if expanded (neo-buffer--insert-tree (concat node "/") (+ depth 1))))) + (dolist (leaf leafs) + (neo-buffer--insert-file-entry leaf depth)))) + +(defun neo-buffer--refresh (save-pos-p &optional non-neotree-buffer) + "Refresh the NeoTree buffer. +If SAVE-POS-P is non-nil, it will be auto save current line number." + (let ((start-node neo-buffer--start-node)) + (unless start-node + (setq start-node default-directory)) + (neo-buffer--with-editing-buffer + ;; save context + (when save-pos-p + (neo-buffer--save-cursor-pos)) + (when non-neotree-buffer + (setq neo-buffer--start-node start-node)) + ;; starting refresh + (erase-buffer) + (neo-buffer--node-list-clear) + (neo-buffer--insert-banner) + (setq neo-buffer--start-line neo-header-height) + (neo-buffer--insert-tree start-node 1)) + ;; restore context + (neo-buffer--goto-cursor-pos))) + +(defun neo-buffer--post-move () + "Reset current directory when position moved." + (funcall + (neotree-make-executor + :file-fn + '(lambda (path _) + (setq default-directory (neo-path--updir btn-full-path))) + :dir-fn + '(lambda (path _) + (setq default-directory (file-name-as-directory path)))))) + +(defun neo-buffer--get-button-current-line () + "Return the first button in current line." + (let* ((btn-position nil) + (pos-line-start (line-beginning-position)) + (pos-line-end (line-end-position)) + ;; NOTE: cannot find button when the button + ;; at beginning of the line + (current-button (or (button-at (point)) + (button-at pos-line-start)))) + (if (null current-button) + (progn + (setf btn-position + (catch 'ret-button + (let* ((next-button (next-button pos-line-start)) + (pos-btn nil)) + (if (null next-button) (throw 'ret-button nil)) + (setf pos-btn (overlay-start next-button)) + (if (> pos-btn pos-line-end) (throw 'ret-button nil)) + (throw 'ret-button pos-btn)))) + (if (null btn-position) + nil + (setf current-button (button-at btn-position))))) + current-button)) + +(defun neo-buffer--get-filename-current-line (&optional default) + "Return filename for first button in current line. +If there is no button in current line, then return DEFAULT." + (let ((btn (neo-buffer--get-button-current-line))) + (if (not (null btn)) + (button-get btn 'neo-full-path) + default))) + +(defun neo-buffer--lock-width () + "Lock the width size for NeoTree window." + (if neo-window-fixed-size + (setq window-size-fixed 'width))) + +(defun neo-buffer--unlock-width () + "Unlock the width size for NeoTree window." + (setq window-size-fixed nil)) + +(defun neo-buffer--rename-node () + "Rename current node as another path." + (interactive) + (let* ((current-path (neo-buffer--get-filename-current-line)) + (buffer (find-buffer-visiting current-path)) + to-path + msg) + (unless (null current-path) + (setq msg (format "Rename [%s] to: " (neo-path--file-short-name current-path))) + (setq to-path (read-file-name msg (file-name-directory current-path))) + (if buffer + (with-current-buffer buffer + (set-visited-file-name to-path nil t))) + (rename-file current-path to-path 1) + (neo-buffer--refresh t) + (message "Rename successful.")))) + +(defun neo-buffer--copy-node () + "Copies current node as another path." + (interactive) + (let* ((current-path (neo-buffer--get-filename-current-line)) + (buffer (find-buffer-visiting current-path)) + to-path + msg) + (unless (null current-path) + (setq msg (format "Copy [%s] to: " (neo-path--file-short-name current-path))) + (setq to-path (read-file-name msg (file-name-directory current-path))) + (if (file-directory-p current-path) + (copy-directory current-path to-path) + (copy-file current-path to-path)) + (neo-buffer--refresh t) + (message "Copy successful.")))) + +(defun neo-buffer--select-file-node (file &optional recursive-p) + "Select the node that corresponds to the FILE. +If RECURSIVE-P is non nil, find files will recursively." + (let ((efile file) + (iter-curr-dir nil) + (file-node-find-p nil) + (file-node-list nil)) + (unless (file-name-absolute-p efile) + (setq efile (expand-file-name efile))) + (setq iter-curr-dir efile) + (catch 'return + (while t + (setq iter-curr-dir (neo-path--updir iter-curr-dir)) + (push iter-curr-dir file-node-list) + (when (neo-path--file-equal-p iter-curr-dir neo-buffer--start-node) + (setq file-node-find-p t) + (throw 'return nil)) + (let ((niter-curr-dir (file-remote-p iter-curr-dir 'localname))) + (unless niter-curr-dir + (setq niter-curr-dir iter-curr-dir)) + (when (neo-path--file-equal-p niter-curr-dir "/") + (setq file-node-find-p nil) + (throw 'return nil))))) + (when file-node-find-p + (dolist (p file-node-list) + (neo-buffer--set-expand p t)) + (neo-buffer--save-cursor-pos file) + (neo-buffer--refresh nil)))) + +(defun neo-buffer--change-root (root-dir) + "Change the tree root to ROOT-DIR." + (let ((path root-dir) + start-path) + (unless (and (file-exists-p path) + (file-directory-p path)) + (throw 'error "The path is not a valid directory.")) + (setq start-path (expand-file-name (substitute-in-file-name path))) + (setq neo-buffer--start-node start-path) + (cd start-path) + (neo-buffer--save-cursor-pos path nil) + (neo-buffer--refresh nil))) + +(defun neo-buffer--get-nodes-for-select-down-node (path) + "Return the node list for the down dir selection." + (if path + (when (file-name-directory path) + (if (neo-buffer--expanded-node-p path) + (neo-buffer--get-nodes path) + (neo-buffer--get-nodes (file-name-directory path)))) + (neo-buffer--get-nodes (file-name-as-directory neo-buffer--start-node)))) + +(defun neo-buffer--get-nodes-for-sibling (path) + "Return the node list for the sibling selection. Return nil of no nodes can +be found. +The returned list is a directory list if path is a directory, otherwise it is +a file list." + (when path + (let ((nodes (neo-buffer--get-nodes (file-name-directory path)))) + (if (file-directory-p path) + (car nodes) + (cdr nodes))))) + +(defun neo-buffer--sibling (path &optional previous) + "Return the next sibling of node PATH. +If PREVIOUS is non-nil the previous sibling is returned." + (let* ((nodes (neo-buffer--get-nodes-for-sibling path))) + (when nodes + (let ((i (neo-buffer--get-node-index path nodes)) + (l (length nodes))) + (if i (nth (mod (+ i (if previous -1 1)) l) nodes)))))) + +(defun neo-buffer--execute (arg &optional file-fn dir-fn) + "Define the behaviors for keyboard event. +ARG is the parameter for command. +If FILE-FN is non-nil, it will executed when a file node. +If DIR-FN is non-nil, it will executed when a dir node." + (interactive "P") + (let* ((btn-full-path (neo-buffer--get-filename-current-line)) + is-file-p + enter-fn) + (unless (null btn-full-path) + (setq is-file-p (not (file-directory-p btn-full-path)) + enter-fn (if is-file-p file-fn dir-fn)) + (unless (null enter-fn) + (funcall enter-fn btn-full-path arg) + (run-hook-with-args + 'neo-enter-hook + (if is-file-p 'file 'directory) + btn-full-path + arg))) + btn-full-path)) + +(defun neo-buffer--set-show-hidden-file-p (show-p) + "If SHOW-P is non-nil, show hidden nodes in tree." + (setq neo-buffer--show-hidden-file-p show-p) + (neo-buffer--refresh t)) + +(defun neo-buffer--forward-line (n) + "Move N lines forward in NeoTree buffer." + (forward-line (or n 1)) + (neo-buffer--post-move)) + +;; +;; Mode-line methods +;; + +(defun neo-mode-line--compute-format (parent index ndirs nfiles) + "Return a formated string to be used in the `neotree' mode-line." + (let* ((nall (+ ndirs nfiles)) + (has-dirs (> ndirs 0)) + (has-files (> nfiles 0)) + (msg-index (when index (format "[%s/%s] " index nall))) + (msg-ndirs (when has-dirs (format (if has-files " (D:%s" " (D:%s)") ndirs))) + (msg-nfiles (when has-files (format (if has-dirs " F:%s)" " (F:%s)") nfiles))) + (msg-directory (file-name-nondirectory (directory-file-name parent))) + (msg-directory-max-length (- (window-width) + (length msg-index) + (length msg-ndirs) + (length msg-nfiles)))) + (setq msg-directory (if (<= (length msg-directory) msg-directory-max-length) + msg-directory + (concat (substring msg-directory + 0 (- msg-directory-max-length 3)) + "..."))) + (propertize + (decode-coding-string (concat msg-index msg-directory msg-ndirs msg-nfiles) 'utf-8) + 'help-echo (decode-coding-string parent 'utf-8)))) + +;; +;; Window methods +;; + +(defun neo-window--init (window buffer) + "Make WINDOW a NeoTree window. +NeoTree buffer is BUFFER." + (neo-buffer--with-resizable-window + (switch-to-buffer buffer) + (set-window-parameter window 'no-delete-other-windows t) + (set-window-dedicated-p window t)) + window) + +(defun neo-window--zoom (method) + "Zoom the NeoTree window, the METHOD should one of these options: +'maximize 'minimize 'zoom-in 'zoom-out." + (neo-buffer--unlock-width) + (cond + ((eq method 'maximize) + (maximize-window)) + ((eq method 'minimize) + (neo-util--set-window-width (selected-window) neo-window-width)) + ((eq method 'zoom-in) + (shrink-window-horizontally 2)) + ((eq method 'zoom-out) + (enlarge-window-horizontally 2))) + (neo-buffer--lock-width)) + +(defun neo-window--minimize-p () + "Return non-nil when the NeoTree window is minimize." + (<= (window-width) neo-window-width)) + +;; +;; Interactive functions +;; + +(defun neotree-next-line (&optional count) + "Move next line in NeoTree buffer. +Optional COUNT argument, moves COUNT lines down." + (interactive "p") + (neo-buffer--forward-line (or count 1))) + +(defun neotree-previous-line (&optional count) + "Move previous line in NeoTree buffer. +Optional COUNT argument, moves COUNT lines up." + (interactive "p") + (neo-buffer--forward-line (- (or count 1)))) + +;;;###autoload +(defun neotree-find (&optional path default-path) + "Quick select node which specified PATH in NeoTree. +If path is nil and no buffer file name, then use DEFAULT-PATH," + (interactive) + (let* ((ndefault-path (if default-path default-path + (neo-path--get-working-dir))) + (npath (if path path + (or (buffer-file-name) ndefault-path))) + (do-open-p nil)) + (if (and (not neo-force-change-root) + (not (neo-global--file-in-root-p npath)) + (neo-global--window-exists-p)) + (setq do-open-p (funcall neo-confirm-change-root "File not found in root path, do you want to change root?")) + (setq do-open-p t)) + (when do-open-p + (neo-global--open-and-find npath)) + (when neo-auto-indent-point + (neo-point-auto-indent))) + (neo-global--select-window)) + +(defun neotree-click-changes-root-toggle () + "Toggle the variable neo-click-changes-root. +If true, clicking on a directory will change the current root to +the directory instead of showing the directory contents." + (interactive) + (setq neo-click-changes-root (not neo-click-changes-root))) + +(defun neo-open-dir (full-path &optional arg) + "Toggle fold a directory node. + +FULL-PATH is the path of the directory. +ARG is ignored." + (if neo-click-changes-root + (neotree-change-root) + (progn + (let ((new-state (neo-buffer--toggle-expand full-path))) + (neo-buffer--refresh t) + (when neo-auto-indent-point + (when new-state (forward-line 1)) + (neo-point-auto-indent)))))) + + +(defun neo--expand-recursive (path state) + "Set the state of children recursively. + +The children of PATH will have state STATE." + (let ((children (car (neo-buffer--get-nodes path) ))) + (dolist (node children) + (neo-buffer--set-expand node state) + (neo--expand-recursive node state )))) + +(defun neo-open-dir-recursive (full-path &optional arg) + "Toggle fold a directory node recursively. + +The children of the node will also be opened recursively. +FULL-PATH is the path of the directory. +ARG is ignored." + (if neo-click-changes-root + (neotree-change-root) + (let ((new-state (neo-buffer--toggle-expand full-path)) + (children (car (neo-buffer--get-nodes full-path)))) + (dolist (node children) + (neo-buffer--set-expand node new-state) + (neo--expand-recursive node new-state)) + (neo-buffer--refresh t)))) + +(defun neo-open-dired (full-path &optional arg) + "Open file or directory node in `dired-mode'. + +FULL-PATH is the path of node. +ARG is same as `neo-open-file'." + (neo-global--select-mru-window arg) + (dired full-path)) + +(defun neo-open-file (full-path &optional arg) + "Open a file node. + +FULL-PATH is the file path you want to open. +If ARG is an integer then the node is opened in a window selected via +`winum' or`window-numbering' (if available) according to the passed number. +If ARG is `|' then the node is opened in new vertically split window. +If ARG is `-' then the node is opened in new horizontally split window." + (neo-global--select-mru-window arg) + (find-file full-path)) + +(defun neo-open-file-vertical-split (full-path arg) + "Open the current node is a vertically split window. +FULL-PATH and ARG are the same as `neo-open-file'." + (neo-open-file full-path "|")) + +(defun neo-open-file-horizontal-split (full-path arg) + "Open the current node is horizontally split window. +FULL-PATH and ARG are the same as `neo-open-file'." + (neo-open-file full-path "-")) + +(defun neo-open-file-ace-window (full-path arg) + "Open the current node in a window chosen by ace-window. +FULL-PATH and ARG are the same as `neo-open-file'." + (neo-open-file full-path "a")) + +(defun neotree-open-file-in-system-application () + "Open a file under point in the system application." + (interactive) + (call-process neo-default-system-application nil 0 nil + (neo-buffer--get-filename-current-line))) + +(defun neotree-change-root () + "Change root to current node dir. +If current node is a file, then it will do nothing. +If cannot find any node in current line, it equivalent to using `neotree-dir'." + (interactive) + (neo-global--select-window) + (let ((btn-full-path (neo-buffer--get-filename-current-line))) + (if (null btn-full-path) + (call-interactively 'neotree-dir) + (neo-global--open-dir btn-full-path)))) + +(defun neotree-select-up-node () + "Select the parent directory of the current node. Change the root if +necessary. " + (interactive) + (neo-global--select-window) + (let* ((btn-full-path (neo-buffer--get-filename-current-line)) + (btn-parent-dir (if btn-full-path (file-name-directory btn-full-path))) + (root-slash (file-name-as-directory neo-buffer--start-node))) + (cond + ((equal btn-parent-dir root-slash) (neo-global--open-dir root-slash)) + (btn-parent-dir (neotree-find btn-parent-dir)) + (t (neo-global--open-dir (file-name-directory + (directory-file-name root-slash))))))) + +(defun neotree-select-down-node () + "Select an expanded directory or content directory according to the +current node, in this order: +- select the first expanded child node if the current node has one +- select the content of current node if it is expanded +- select the next expanded sibling if the current node is not expanded." + (interactive) + (let* ((btn-full-path (neo-buffer--get-filename-current-line)) + (path (if btn-full-path btn-full-path neo-buffer--start-node)) + (nodes (neo-buffer--get-nodes-for-select-down-node path))) + (when nodes + (if (or (equal path neo-buffer--start-node) + (neo-buffer--expanded-node-p path)) + ;; select the first expanded child node + (let ((expanded-dir (catch 'break + (dolist (node (car nodes)) + (if (neo-buffer--expanded-node-p node) + (throw 'break node))) + nil))) + (if expanded-dir + (neotree-find expanded-dir) + ;; select the directory content if needed + (let ((dirs (car nodes)) + (files (cdr nodes))) + (if (> (length dirs) 0) + (neotree-find (car dirs)) + (when (> (length files) 0) + (neotree-find (car files))))))) + ;; select the next expanded sibling + (let ((sibling (neo-buffer--sibling path))) + (while (and (not (neo-buffer--expanded-node-p sibling)) + (not (equal sibling path))) + (setq sibling (neo-buffer--sibling sibling))) + (when (not (string< sibling path)) + ;; select next expanded sibling + (neotree-find sibling))))))) + +(defun neotree-select-next-sibling-node () + "Select the next sibling of current node. +If the current node is the last node then the first node is selected." + (interactive) + (let ((sibling (neo-buffer--sibling (neo-buffer--get-filename-current-line)))) + (when sibling (neotree-find sibling)))) + +(defun neotree-select-previous-sibling-node () + "Select the previous sibling of current node. +If the current node is the first node then the last node is selected." + (interactive) + (let ((sibling (neo-buffer--sibling (neo-buffer--get-filename-current-line) t))) + (when sibling (neotree-find sibling)))) + +(defun neotree-create-node (filename) + "Create a file or directory use specified FILENAME in current node." + (interactive + (let* ((current-dir (neo-buffer--get-filename-current-line neo-buffer--start-node)) + (current-dir (neo-path--match-path-directory current-dir)) + (filename (read-file-name "Filename:" current-dir))) + (if (file-directory-p filename) + (setq filename (concat filename "/"))) + (list filename))) + (catch 'rlt + (let ((is-file nil)) + (when (= (length filename) 0) + (throw 'rlt nil)) + (setq is-file (not (equal (substring filename -1) "/"))) + (when (file-exists-p filename) + (message "File %S already exists." filename) + (throw 'rlt nil)) + (when (and is-file + (funcall neo-confirm-create-file (format "Do you want to create file %S ?" + filename))) + ;; ensure parent directory exist before saving + (mkdir (substring filename 0 (+ 1 (cl-position ?/ filename :from-end t))) t) + ;; NOTE: create a empty file + (write-region "" nil filename) + (neo-buffer--save-cursor-pos filename) + (neo-buffer--refresh nil) + (if neo-create-file-auto-open + (find-file-other-window filename))) + (when (and (not is-file) + (funcall neo-confirm-create-directory (format "Do you want to create directory %S?" + filename))) + (mkdir filename t) + (neo-buffer--save-cursor-pos filename) + (neo-buffer--refresh nil))))) + +(defun neotree-delete-node () + "Delete current node." + (interactive) + (let* ((filename (neo-buffer--get-filename-current-line)) + (buffer (find-buffer-visiting filename)) + (deleted-p nil) + (trash delete-by-moving-to-trash)) + (catch 'end + (if (null filename) (throw 'end nil)) + (if (not (file-exists-p filename)) (throw 'end nil)) + (if (not (funcall neo-confirm-delete-file (format "Do you really want to delete %S?" + filename))) + (throw 'end nil)) + (if (file-directory-p filename) + ;; delete directory + (progn + (unless (neo-path--has-subfile-p filename) + (delete-directory filename nil trash) + (setq deleted-p t) + (throw 'end nil)) + (when (funcall neo-confirm-delete-directory-recursively + (format "%S is a directory, delete it recursively?" + filename)) + (when (funcall neo-confirm-kill-buffers-for-files-in-directory + (format "kill buffers for files in directory %S?" + filename)) + (neo-util--kill-buffers-for-path filename)) + (delete-directory filename t trash) + (setq deleted-p t))) + ;; delete file + (progn + (delete-file filename trash) + (when buffer + (kill-buffer-ask buffer)) + (setq deleted-p t)))) + (when deleted-p + (message "%S deleted." filename) + (neo-buffer--refresh t)) + filename)) + +(defun neotree-rename-node () + "Rename current node." + (interactive) + (neo-buffer--rename-node)) + +(defun neotree-copy-node () + "Copy current node." + (interactive) + (neo-buffer--copy-node)) + +(defun neotree-hidden-file-toggle () + "Toggle show hidden files." + (interactive) + (neo-buffer--set-show-hidden-file-p (not neo-buffer--show-hidden-file-p))) + +(defun neotree-empty-fn () + "Used to bind the empty function to the shortcut." + (interactive)) + +(defun neotree-refresh (&optional is-auto-refresh) + "Refresh the NeoTree buffer." + (interactive) + (if (eq (current-buffer) (neo-global--get-buffer)) + (neo-buffer--refresh t) + (save-excursion + (let ((cw (selected-window))) ;; save current window + (if is-auto-refresh + (let ((origin-buffer-file-name (buffer-file-name))) + (when (and (fboundp 'projectile-project-p) + (projectile-project-p) + (fboundp 'projectile-project-root)) + (neo-global--open-dir (projectile-project-root)) + (neotree-find (projectile-project-root))) + (neotree-find origin-buffer-file-name)) + (neo-buffer--refresh t t)) + (recenter) + (when (or is-auto-refresh neo-toggle-window-keep-p) + (select-window cw)))))) + +(defun neotree-stretch-toggle () + "Make the NeoTree window toggle maximize/minimize." + (interactive) + (neo-global--with-window + (if (neo-window--minimize-p) + (neo-window--zoom 'maximize) + (neo-window--zoom 'minimize)))) + +(defun neotree-collapse-all () + (interactive) + "Collapse all expanded folders in the neotree buffer" + (setq list-of-expanded-folders neo-buffer--expanded-node-list) + (dolist (folder list-of-expanded-folders) + (neo-buffer--toggle-expand folder) + (neo-buffer--refresh t) + ) + ) +;;;###autoload +(defun neotree-projectile-action () + "Integration with `Projectile'. + +Usage: + (setq projectile-switch-project-action 'neotree-projectile-action). + +When running `projectile-switch-project' (C-c p p), `neotree' will change root +automatically." + (interactive) + (cond + ((fboundp 'projectile-project-root) + (neotree-dir (projectile-project-root))) + (t + (error "Projectile is not available")))) + +;;;###autoload +(defun neotree-toggle () + "Toggle show the NeoTree window." + (interactive) + (if (neo-global--window-exists-p) + (neotree-hide) + (neotree-show))) + +;;;###autoload +(defun neotree-show () + "Show the NeoTree window." + (interactive) + (let ((cw (selected-window)) + (path (buffer-file-name))) ;; save current window and buffer + (if neo-smart-open + (progn + (when (and (fboundp 'projectile-project-p) + (projectile-project-p) + (fboundp 'projectile-project-root)) + (neotree-dir (projectile-project-root))) + (neotree-find path)) + (neo-global--open)) + (neo-global--select-window) + (when neo-toggle-window-keep-p + (select-window cw)))) + +;;;###autoload +(defun neotree-hide () + "Close the NeoTree window." + (interactive) + (if (neo-global--window-exists-p) + (delete-window neo-global--window))) + +;;;###autoload +(defun neotree-dir (path) + "Show the NeoTree window, and change root to PATH." + (interactive "DDirectory: ") + (neo-global--open-dir path) + (neo-global--select-window)) + +;;;###autoload +(defalias 'neotree 'neotree-show "Show the NeoTree window.") + +;; +;; backward compatible +;; + +(defun neo-bc--make-obsolete-message (from to) + (message "Warning: `%S' is obsolete. Use `%S' instead." from to)) + +(defun neo-buffer--enter-file (path) + (neo-bc--make-obsolete-message 'neo-buffer--enter-file 'neo-open-file)) + +(defun neo-buffer--enter-dir (path) + (neo-bc--make-obsolete-message 'neo-buffer--enter-dir 'neo-open-dir)) + +(defun neotree-enter (&optional arg) + "NeoTree typical open event. +ARG are the same as `neo-open-file'." + (interactive "P") + (neo-buffer--execute arg 'neo-open-file 'neo-open-dir)) + +(defun neotree-quick-look (&optional arg) + "Quick Look like NeoTree open event. +ARG are the same as `neo-open-file'." + (interactive "P") + (neotree-enter arg) + (neo-global--select-window)) + +(defun neotree-enter-vertical-split () + "NeoTree open event, file node will opened in new vertically split window." + (interactive) + (neo-buffer--execute nil 'neo-open-file-vertical-split 'neo-open-dir)) + +(defun neotree-enter-horizontal-split () + "NeoTree open event, file node will opened in new horizontally split window." + (interactive) + (neo-buffer--execute nil 'neo-open-file-horizontal-split 'neo-open-dir)) + +(defun neotree-enter-ace-window () + "NeoTree open event, file node will be opened in window chosen by ace-window." + (interactive) + (neo-buffer--execute nil 'neo-open-file-ace-window 'neo-open-dir)) + +(defun neotree-copy-filepath-to-yank-ring () + "Neotree convenience interactive function: file node path will be added to the kill ring." + (interactive) + (kill-new (neo-buffer--get-filename-current-line))) + +(defun neotree-split-window-sensibly (&optional window) + "An neotree-version of split-window-sensibly, +which is used to fix issue #209. +(setq split-window-preferred-function 'neotree-split-window-sensibly)" + (let ((window (or window (selected-window)))) + (or (split-window-sensibly window) + (and (get-buffer-window neo-buffer-name) + (not (window-minibuffer-p window)) + ;; If WINDOW is the only window on its frame + ;; (or only include Neo window) and is not the + ;; minibuffer window, try to split it vertically disregarding + ;; the value of `split-height-threshold'. + (let ((split-height-threshold 0)) + (when (window-splittable-p window) + (with-selected-window window + (split-window-below)))))))) + +(provide 'neotree) +;;; neotree.el ends here + diff --git a/lisp/org-bullets.el b/lisp/org-bullets.el new file mode 100644 index 0000000..b161148 --- /dev/null +++ b/lisp/org-bullets.el @@ -0,0 +1,126 @@ +;;; org-bullets.el --- Show bullets in org-mode as UTF-8 characters +;;; Version: 0.2.4 +;;; Author: sabof +;;; URL: https://github.com/sabof/org-bullets + +;; This file is NOT part of GNU Emacs. +;; +;; 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, 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 ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; The project is hosted at https://github.com/sabof/org-bullets +;; The latest version, and all the relevant information can be found there. + +;;; Code: + +(eval-when-compile (require 'cl)) + +(defgroup org-bullets nil + "Display bullets as UTF-8 characters" + :group 'org-appearance) + +;; A nice collection of unicode bullets: +;; http://nadeausoftware.com/articles/2007/11/latency_friendly_customized_bullets_using_unicode_characters +(defcustom org-bullets-bullet-list + '(;;; Large + "◉" + "○" + "✸" + "✿" + ;; ♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ☢ ❀ ◆ ◖ ▶ + ;;; Small + ;; ► • ★ ▸ + ) + "This variable contains the list of bullets. +It can contain any number of symbols, which will be repeated." + :group 'org-bullets + :type '(repeat (string :tag "Bullet character"))) + +(defcustom org-bullets-face-name nil + "This variable allows the org-mode bullets face to be + overridden. If set to a name of a face, that face will be + used. Otherwise the face of the heading level will be used." + :group 'org-bullets + :type 'symbol) + +(defvar org-bullets-bullet-map + '(keymap + (mouse-1 . org-cycle) + (mouse-2 + . (lambda (e) + (interactive "e") + (mouse-set-point e) + (org-cycle)))) + "Mouse events for bullets. +Should this be undesirable, one can remove them with + +\(setcdr org-bullets-bullet-map nil\)") + +(defun org-bullets-level-char (level) + (string-to-char + (nth (mod (1- level) + (length org-bullets-bullet-list)) + org-bullets-bullet-list))) + +;;;###autoload +(define-minor-mode org-bullets-mode + "UTF8 Bullets for org-mode" + nil nil nil + (let* (( keyword + `(("^\\*+ " + (0 (let* (( level (- (match-end 0) (match-beginning 0) 1)) + ( is-inline-task + (and (boundp 'org-inlinetask-min-level) + (>= level org-inlinetask-min-level)))) + (compose-region (- (match-end 0) 2) + (- (match-end 0) 1) + (org-bullets-level-char level)) + (when is-inline-task + (compose-region (- (match-end 0) 3) + (- (match-end 0) 2) + (org-bullets-level-char level))) + (when (facep org-bullets-face-name) + (put-text-property (- (match-end 0) + (if is-inline-task 3 2)) + (- (match-end 0) 1) + 'face + org-bullets-face-name)) + (put-text-property (match-beginning 0) + (- (match-end 0) 2) + 'face (list :foreground + (face-attribute + 'default :background))) + (put-text-property (match-beginning 0) + (match-end 0) + 'keymap + org-bullets-bullet-map) + nil)))))) + (if org-bullets-mode + (progn + (font-lock-add-keywords nil keyword) + (font-lock-fontify-buffer)) + (save-excursion + (goto-char (point-min)) + (font-lock-remove-keywords nil keyword) + (while (re-search-forward "^\\*+ " nil t) + (decompose-region (match-beginning 0) (match-end 0))) + (font-lock-fontify-buffer)) + ))) + +(provide 'org-bullets) + +;;; org-bullets.el ends here diff --git a/lisp/org-custom.el b/lisp/org-custom.el new file mode 100644 index 0000000..10adab9 --- /dev/null +++ b/lisp/org-custom.el @@ -0,0 +1,68 @@ +;; https://zzamboni.org/post/beautifying-org-mode-in-emacs/ + +(defun org-custom-hook() + (setq org-hide-emphasis-markers t) + (font-lock-add-keywords 'org-mode + '(("^ *\\([-]\\) " + (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) "•")))))) + + (let* ((variable-tuple + (cond ((x-list-fonts "ETBembo") '(:font "ETBembo")) + ((x-list-fonts "Source Sans Pro") '(:font "Source Sans Pro")) + ((x-list-fonts "Lucida Grande") '(:font "Lucida Grande")) + ((x-list-fonts "Verdana") '(:font "Verdana")) + ((x-family-fonts "Sans Serif") '(:family "Sans Serif")) + (nil (warn "Cannot find a Sans Serif Font. Install Source Sans Pro.")))) + (base-font-color (face-foreground 'default nil 'default)) + (headline `(:inherit default :weight normal :foreground ,base-font-color))) + + (custom-theme-set-faces + 'user + `(org-level-8 ((t (,@headline ,@variable-tuple)))) + `(org-level-7 ((t (,@headline ,@variable-tuple)))) + `(org-level-6 ((t (,@headline ,@variable-tuple)))) + `(org-level-5 ((t (,@headline ,@variable-tuple)))) + `(org-level-4 ((t (,@headline ,@variable-tuple :height 0.8)))) + `(org-level-3 ((t (,@headline ,@variable-tuple :height 0.9)))) + `(org-level-2 ((t (,@headline ,@variable-tuple :height 1.0)))) + `(org-level-1 ((t (,@headline ,@variable-tuple :height 1.1 :weight bold)))) + `(org-document-title ((t (,@headline ,@variable-tuple :height 1.5 :underline t :weight:bold)))))) + + (custom-theme-set-faces + 'user + '(org-block ((t (:inherit fixed-pitch)))) + '(org-code ((t (:inherit (shadow fixed-pitch))))) + '(org-document-info ((t (:foreground "dark orange")))) + '(org-document-info-keyword ((t (:inherit (shadow fixed-pitch))))) + '(org-indent ((t (:inherit (org-hide fixed-pitch))))) + '(org-link ((t (:foreground "royal blue" :underline t)))) + '(org-meta-line ((t (:inherit (font-lock-comment-face fixed-pitch))))) + '(org-property-value ((t (:inherit fixed-pitch))) t) + '(org-special-keyword ((t (:inherit (font-lock-comment-face fixed-pitch))))) + '(org-table ((t (:inherit fixed-pitch :foreground "#83a598")))) + '(org-tag ((t (:inherit (shadow fixed-pitch) :weight bold :height 0.8)))) + '(org-verbatim ((t (:inherit (shadow fixed-pitch)))))) + + (variable-pitch-mode) + (visual-line-mode) + + (require 'org-bullets) + (org-bullets-mode 1) + + (setq org-blank-before-new-entry (quote ((heading . nil) + (plain-list-item . nil)))) +) + +(custom-set-variables + '(org-directory "~/Documents/org") + '(org-agenda-files (list org-directory))) + +(setq org-todo-keywords + '((sequence "TODO" "PROGRESS" "VERIFY" "|" "DONE" "ABANDONED"))) + +(setq org-todo-keyword-faces + '(("TODO" . "RED") ("PROGRESS" . "royal blue") ("VERIFY" . "#E0A526") ("ABANDONED" . "light gray") ("DONE" . "dark green")) + ) + + +(provide 'org-custom) diff --git a/lisp/perfect-margin.el b/lisp/perfect-margin.el new file mode 100644 index 0000000..4453f85 --- /dev/null +++ b/lisp/perfect-margin.el @@ -0,0 +1,336 @@ +;;; perfect-margin.el --- auto center windows, work with minimap and/or linum-mode +;; Copyright (C) 2014 Randall Wang + +;; Author: Randall Wang <randall.wjz@gmail.com> +;; Created: 19 Nov 2014 +;; Version: 0.1 +;; URL: https://github.com/mpwang/perfect-margin +;; Keywords: convenience, frames +;; Package-Requires: ((emacs "24.0") (cl-lib "0.5")) + +;; This file is *NOT* part of GNU Emacs. + +;; 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 +;; MERCHANT ABILITY 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: +;; +;; # Usage +;; +;; Put perfect-margin under your Emacs load path, and add this to your init.el +;; +;; (require 'perfect-margin) +;; +;; Use `M-x perfect-margin-mode` to turn on/off perfect-margin. +;; +;; To make it permanent add this to your init.el after require. +;; +;; (perfect-margin-mode 1) +;; +;; Note: when using together with minimap or linum, make sure you place config for perfect-margin *AFTER* minimap and linum. +;; +;; # Customization +;; +;; Via `M-x customize-group` and enter perfect-margin. +;; +;; Change `perfect-margin-visible-width` and `Apply and Save`. That's it. +;; +;; *Or* you can change the visible window width by setup `perfect-margin-visible-width` on the init.el. +;; +;; (setq perfect-margin-visible-width 128) +;; +;; # Additional binding on margin area +;; +;; You can place this in your init.el to make mouse wheel scroll on margin area just like it scroll on the visible window. +;; +;; (dolist (margin '("<left-margin> " "<right-margin> ")) +;; (global-set-key (kbd (concat margin "<mouse-1>")) 'ignore) +;; (global-set-key (kbd (concat margin "<mouse-3>")) 'ignore) +;; (dolist (multiple '("" "double-" "triple-")) +;; (global-set-key (kbd (concat margin "<" multiple "wheel-up>")) 'mwheel-scroll) +;; (global-set-key (kbd (concat margin "<" multiple "wheel-down>")) 'mwheel-scroll))) + +;;; Code: + +(require 'linum) +(require 'cl-lib) + +(defvar minimap-width-fraction) +(defvar minimap-buffer-name) +(declare-function minimap-get-window "minimap") + +(defgroup perfect-margin nil + "Auto center windows, work with minimap and/or linum-mode." + :group 'emacs) + +(defcustom perfect-margin-lighter " \u24c2" + "Mode-line indicator for symbol `perfect-margin-mode'." + :type '(choice (const :tag "No lighter" "") string) + :safe 'stringp + :group 'perfect-margin) + +(defcustom perfect-margin-visible-width 128 + "The visible width of main window to be kept at center." + :group 'perfect-margin + :type 'number) + +(defcustom perfect-margin-ignore-regexps + '("^minibuf" "^[*]") + "List of strings to determine if window is ignored. +Each string is used as regular expression to match the window buffer name." + :group 'perfect-margin + :type '(repeat regexp)) + +(defcustom perfect-margin-ignore-filters + '(window-minibuffer-p) + "List of functions to determine if window is ignored. +Each function is called with window as its sole arguemnt, returning a non-nil value indicate to ignore the window." + :group 'perfect-margin + :type '(list function)) + +(defcustom perfect-margin-ignore-modes + '(exwm-mode + doc-view-mode + nov-mode) + "List of symbols of ignored major modes." + :type '(repeat symbol) + :group 'perfect-margin) + +;;---------------------------------------------------------------------------- +;; env predictors +;;---------------------------------------------------------------------------- +(defun perfect-margin-with-linum-p () + "Whether linum is found and turn on." + (bound-and-true-p linum-mode)) + +(defun perfect-margin-with-minimap-p () + "Whether minimap is found." + (bound-and-true-p minimap-mode)) + +;;---------------------------------------------------------------------------- +;; Private functions +;;---------------------------------------------------------------------------- +(defun perfect-margin--width-with-margins (win) + "Calculate size of window(WIN) with it's margins." + (let ((margins (window-margins win))) + (+ (window-width win) + (or (car margins) 0) + (or (cdr margins) 0)))) + +(defun perfect-margin--minimap-window-p (win) + "Judge if the window(WIN) is the minimap window itself, when it's live." + (when (and (perfect-margin-with-minimap-p) + (minimap-get-window) + (window-live-p (minimap-get-window))) + (let ((minimap-edges (window-edges (minimap-get-window))) + (current-edges (window-edges win))) + (and (= (nth 0 minimap-edges) (nth 0 current-edges)) + (= (nth 1 minimap-edges) (nth 1 current-edges)) + (= (nth 2 minimap-edges) (nth 2 current-edges)))))) + +(defun perfect-margin--minimap-left-adjacent-covered-p (win) + "Judge if the window(WIN) is left adjacent to minimap window." + (when (and (perfect-margin-with-minimap-p) + (minimap-get-window) + (window-live-p (minimap-get-window))) + (let ((minimap-edges (window-edges (minimap-get-window))) + (current-edges (window-edges win))) + (and (= (nth 2 minimap-edges) (nth 0 current-edges)) + (<= (nth 1 minimap-edges) (nth 1 current-edges)) + (>= (nth 3 minimap-edges) (nth 3 current-edges)))))) + +(defun perfect-margin--init-window-margins () + "Calculate target window margins as if there is only one window on frame." + (let ((init-margin-width (round (max 0 (/ (- (frame-width) perfect-margin-visible-width) 2))))) + (cons init-margin-width init-margin-width))) + +(defun perfect-margin--auto-margin-ignore-p (win) + "Conditions for filtering window (WIN) to setup margin." + (let* ((buffer (window-buffer win)) + (name (buffer-name buffer))) + (or (with-current-buffer buffer + (apply #'derived-mode-p perfect-margin-ignore-modes)) + (cl-some #'identity + (nconc (mapcar (lambda (regexp) (string-match-p regexp name)) perfect-margin-ignore-regexps) + (mapcar (lambda (func) (funcall func win)) perfect-margin-ignore-filters)))))) + +;;---------------------------------------------------------------------------- +;; Minimap +;;---------------------------------------------------------------------------- +(defun perfect-margin-minimap-margin-window (win) + "Setup window margins with minimap at different stage. +WIN will be any visible window, including the minimap window." + ;; Hint: do not reply on (window-width (minimap-get-window)) + (let ((init-window-margins (perfect-margin--init-window-margins)) + (win-edges (window-edges win))) + (cond + ((perfect-margin--auto-margin-ignore-p win) + (set-window-margins win (if (perfect-margin-with-linum-p) 3 0) 0)) + ((not (minimap-get-window)) + ;; minimap-window is not available + (cond + ((= (frame-width) (perfect-margin--width-with-margins win)) + (set-window-margins win (car init-window-margins) (cdr init-window-margins))) + ;; When the window is first splited and minimap-window is not set, + ;; the minimap has the same buffer name with it's target window. + ;; Distinguish the minimap and target window base on edge and size. + ;; + ;; the left hand side window when minimap window is created by + ;; split-window-horizontally the first time. + ;; catch and don't set minimap window + ((and (= (nth 0 win-edges) 0) + (= (nth 2 win-edges) (round (* perfect-margin-visible-width minimap-width-fraction))))) + ((and (= (nth 0 win-edges) (round (* perfect-margin-visible-width minimap-width-fraction))) + (= (or (car (window-margins win)) 0) (car init-window-margins)) + (= (or (cdr (window-margins win)) 0) (cdr init-window-margins))) + ;; the newly split-off window on the right hand side, which carries init-window-margins + (set-window-margins win + (max (if (perfect-margin-with-linum-p) 3 0) + (- (car init-window-margins) + (round (* perfect-margin-visible-width minimap-width-fraction)))) + (cdr init-window-margins))) + (t + (set-window-margins win (if (perfect-margin-with-linum-p) 3 0) 0)))) + ;; catch and don't set minimap window + ((string-match minimap-buffer-name (buffer-name (window-buffer win)))) + ((not (window-live-p (minimap-get-window))) + ;; minimap-window is not live yet + (cond + ;; catch and don't set minimap window + ((and (= (nth 0 win-edges) 0) + (= (nth 2 win-edges) (round (* perfect-margin-visible-width minimap-width-fraction))))) + ((and (= (nth 0 win-edges) (round (* perfect-margin-visible-width minimap-width-fraction))) + ;; the splited target window carries original margins + (= (or (car (window-margins win)) 0) (car init-window-margins)) + (= (or (cdr (window-margins win)) 0) (cdr init-window-margins))) + (set-window-margins win + (max (if (perfect-margin-with-linum-p) 3 0) + (- (car init-window-margins) + (round (* perfect-margin-visible-width minimap-width-fraction)))) + (cdr init-window-margins))) + ((= (frame-width) (perfect-margin--width-with-margins win)) + ;; when switch window, the minimap window is kill first, set it's left adjacent window margins to nil. + ;; left edge of win extends to frame's left-most edge, it's width increased by width of minimap window. + (set-window-margins win (car init-window-margins) (cdr init-window-margins))) + (t + (set-window-margins win (if (perfect-margin-with-linum-p) 3 0) 0)))) + ;; minimap window is created, but it has the same name with it's target window + ;; catch and don't set minimap window + ((perfect-margin--minimap-window-p win)) + ((perfect-margin--minimap-left-adjacent-covered-p win) + (cond + ((not (>= (nth 2 win-edges) (frame-width))) + (set-window-margins win (if (perfect-margin-with-linum-p) 3 0) 0)) + (t + (set-window-margins win + (max (if (perfect-margin-with-linum-p) 3 0) + (- (car init-window-margins) + (round (* perfect-margin-visible-width minimap-width-fraction)))) + (cdr init-window-margins))))) + ((= (frame-width) (perfect-margin--width-with-margins win)) + (set-window-margins win (car init-window-margins) (cdr init-window-margins))) + (t + (set-window-margins win (if (perfect-margin-with-linum-p) 3 0) 0))))) + +;;---------------------------------------------------------------------------- +;; Main +;;---------------------------------------------------------------------------- +(defun perfect-margin-margin-windows () + "Main logic to setup window's margin, keep the visible main window always at center." + (dolist (win (window-list)) + (cond + ((perfect-margin-with-minimap-p) (perfect-margin-minimap-margin-window win)) + ((and (not (perfect-margin--auto-margin-ignore-p win)) + (<= (frame-width) (perfect-margin--width-with-margins win))) + (let ((init-window-margins (perfect-margin--init-window-margins))) + (set-window-margins win (car init-window-margins) (cdr init-window-margins)))) + (t (set-window-margins win (if (perfect-margin-with-linum-p) 3 0) 0))) + (set-window-fringes win 0 0))) + +(defun perfect-margin-margin-frame (&optional _) + "Hook to resize window when frame size change." + (when (frame-size-changed-p) + (perfect-margin-margin-windows))) + +;;---------------------------------------------------------------------------- +;; Advice +;;---------------------------------------------------------------------------- +(defun perfect-margin--linum-format (line) + "Function for `linum-format' to set left margin for LINE to be 3 as maximum." + (propertize + (format (concat "%" (number-to-string (max 3 (length (number-to-string line)))) "d") line) + 'face + 'linum)) + +(defvar perfect-margin--linum-update-win-left-margin nil + "Variable to store original window marings before `linum-update-window'.") + +(defadvice linum-update-window (before perfect-margin-linum-update-before (win)) + "Save window's original left margin." + (setq perfect-margin--linum-update-win-left-margin (or (car (window-margins win)) 0))) + +(defadvice linum-update-window (after perfect-margin-linum-update-after (win)) + "Restore windonw's original left margin, as `linum-update-window' always reset left margin." + (set-window-margins win perfect-margin--linum-update-win-left-margin (cdr (window-margins win)))) + +(defadvice minimap-update (after minimap-update-no-fringe nil) + "Prevent fringe overlay of target buffer from drawing on `minimap-window'." + (when (and (minimap-get-window) + (window-live-p (minimap-get-window)) + minimap-hide-fringes) + (set-window-fringes (minimap-get-window) 0 0))) + +(defadvice split-window (before perfect-margin--disable-margins nil) + (dolist (win (window-list)) + (set-window-margins win 0 0) + (set-window-fringes win 0 0))) + +;;---------------------------------------------------------------------------- +;; MINOR mode definition +;;---------------------------------------------------------------------------- +;;;###autoload +(define-minor-mode perfect-margin-mode + "Auto center windows." + :init-value nil + :lighter perfect-margin-lighter + :global t + (if perfect-margin-mode + ;; add hook and activate + (progn + (when (perfect-margin-with-linum-p) + (ad-activate 'linum-update-window) + (when (eq linum-format 'dynamic) + (setq linum-format 'perfect-margin--linum-format))) + (when (perfect-margin-with-minimap-p) + (ad-activate 'minimap-update)) + (ad-activate 'split-window) + (add-hook 'window-configuration-change-hook 'perfect-margin-margin-windows) + (add-hook 'window-size-change-functions 'perfect-margin-margin-frame) + (perfect-margin-margin-windows)) + ;; remove hook and restore margin + (when (perfect-margin-with-linum-p) + (ad-deactivate 'linum-update-window) + (when (eq linum-format 'perfect-margin--linum-format) + (setq linum-format 'dynamic)) + (linum-update-current)) + (when (perfect-margin-with-minimap-p) + (ad-deactivate 'minimap-update)) + (ad-deactivate 'split-window) + (remove-hook 'window-configuration-change-hook 'perfect-margin-margin-windows) + (remove-hook 'window-size-change-functions 'perfect-margin-margin-frame) + (dolist (window (window-list)) + (set-window-margins window 0 0)))) + +(provide 'perfect-margin) + +;;; perfect-margin.el ends here diff --git a/lisp/smooth-scrolling.el b/lisp/smooth-scrolling.el new file mode 100644 index 0000000..98df30e --- /dev/null +++ b/lisp/smooth-scrolling.el @@ -0,0 +1,327 @@ +;;; smooth-scrolling.el --- Make emacs scroll smoothly +;; +;; Copyright (c) 2007-2016 Adam Spiers +;; +;; Filename: smooth-scrolling.el +;; Description: Make emacs scroll smoothly +;; Author: Adam Spiers <emacs-ss@adamspiers.org> +;; Jeremy Bondeson <jbondeson@gmail.com> +;; Ryan C. Thompson <rct+github@thompsonclan.org> +;; Maintainer: Adam Spiers <emacs-ss@adamspiers.org> +;; Homepage: http://github.com/aspiers/smooth-scrolling/ +;; Version: 2.0.0 +;; Keywords: convenience +;; GitHub: http://github.com/aspiers/smooth-scrolling/ + +;; This file is not part of GNU Emacs + +;;; License: +;; +;; 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 Street, Fifth Floor, Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; To interactively toggle the mode on / off: +;; +;; M-x smooth-scrolling-mode +;; +;; To make the mode permanent, put this in your .emacs: +;; +;; (require 'smooth-scrolling) +;; (smooth-scrolling-mode 1) +;; +;; This package offers a global minor mode which make emacs scroll +;; smoothly. It keeps the point away from the top and bottom of the +;; current buffer's window in order to keep lines of context around +;; the point visible as much as possible, whilst minimising the +;; frequency of sudden scroll jumps which are visually confusing. +;; +;; This is a nice alternative to all the native `scroll-*` custom +;; variables, which unfortunately cannot provide this functionality +;; perfectly. For example, when using the built-in variables, clicking +;; with the mouse in the margin will immediately scroll the window to +;; maintain the margin, so the text that you clicked on will no longer be +;; under the mouse. This can be disorienting. In contrast, this mode +;; will not do any scrolling until you actually move up or down a line. +;; +;; Also, the built-in margin code does not interact well with small +;; windows. If the margin is more than half the window height, you get +;; some weird behavior, because the point is always hitting both the top +;; and bottom margins. This package auto-adjusts the margin in each +;; buffer to never exceed half the window height, so the top and bottom +;; margins never overlap. + +;; See the README.md for more details. + +;;; Change Log: +;; 27 Feb 2016 -- v2.0.0 +;; * Converted to global minor mode "smooth-scrolling-mode". This +;; means that simply loading the file no longer enables smooth +;; scrolling; you must also enable the mode. +;; * Internal code restructuring that should improve some edge +;; cases, but otherwise have no user-visible effects. +;; 19 Dec 2013 -- v1.0.4 +;; * Disabled scrolling while a keyboard macro is executing in +;; order to prevent a premature termination of the macro by +;; the mode throwing an error such as "End of Buffer" +;; 02 Jun 2013 -- v1.0.3 +;; * Fixed Issue #3 where bounds checking was not being performed +;; prior to calls to 'count-lines' and 'count-screen-lines' +;; functions. +;; 14 Apr 2013 -- v1.0.2 +;; * Adam Spiers GitHub account now houses the canonical +;; repository. +;; 06 Dec 2011 -- v1.0.1 +;; * Altered structure to conform to package.el standards. +;; * Restructured code to group settings changes +;; * Set "redisplay-dont-pause" to true. +;; ?? ??? 2007 -- v1.0.0 +;; * Original version from Adam Spiers + +;;; Code: + +;;;_ + internal variables +(defvar smooth-scroll-orig-scroll-margin nil) + +;;;_ + defcustoms + +(defgroup smooth-scrolling nil + "Make emacs scroll smoothly" + :group 'convenience) + +;;;###autoload +(define-minor-mode smooth-scrolling-mode + "Make emacs scroll smoothly" + :init-value nil + :global t + :group 'smooth-scrolling + (if smooth-scrolling-mode + (setq smooth-scroll-orig-scroll-margin scroll-margin + scroll-margin 0) + (setq scroll-margin smooth-scroll-orig-scroll-margin + smooth-scroll-orig-scroll-margin nil))) + +;;;###autoload +(defcustom smooth-scroll-margin 10 + "Number of lines of visible margin at the top and bottom of a window. +If the point is within these margins, then scrolling will occur +smoothly for `previous-line' at the top of the window, and for +`next-line' at the bottom. + +This is very similar in its goal to `scroll-margin'. However, it +is implemented by activating `smooth-scroll-down' and +`smooth-scroll-up' advise via `defadvice' for `previous-line' and +`next-line' respectively. As a result it avoids problems +afflicting `scroll-margin', such as a sudden jump and unexpected +highlighting of a region when the mouse is clicked in the margin. + +Scrolling only occurs when the point is closer to the window +boundary it is heading for (top or bottom) than the middle of the +window. This is to intelligently handle the case where the +margins cover the whole buffer (e.g. `smooth-scroll-margin' set +to 5 and `window-height' returning 10 or less). + +See also `smooth-scroll-strict-margins'." + :type 'integer + :group 'smooth-scrolling) + +;;;###autoload +(defcustom smooth-scroll-strict-margins t + "If true, the advice code supporting `smooth-scroll-margin' +will use `count-screen-lines' to determine the number of +*visible* lines between the point and the window top/bottom, +rather than `count-lines' which obtains the number of actual +newlines. This is because there might be extra newlines hidden +by a mode such as folding-mode, outline-mode, org-mode etc., or +fewer due to very long lines being displayed wrapped when +`truncate-lines' is nil. + +However, using `count-screen-lines' can supposedly cause +performance issues in buffers with extremely long lines. Setting +`cache-long-line-scans' may be able to address this; +alternatively you can set this variable to nil so that the advice +code uses `count-lines', and put up with the fact that sometimes +the point will be allowed to stray into the margin." + :type 'boolean + :group 'smooth-scrolling) + +;;;_ + helper functions +(defmacro smooth-scroll-ignore-scroll-errors (&rest body) + "Like `progn', but ignores beginning/end of line errors. + +If BODY encounters such an error, further evaluation is stopped +and this form returns nil. Any other error is raised as normal." + (declare (indent 0)) + `(condition-case err + (progn ,@body) + (end-of-buffer nil) + (beginning-of-buffer nil) + (error (signal (car err) (cdr err))))) + +(defun smooth-scroll-line-beginning-position () + "Return position at beginning of (logical/visual) line. + +If `smooth-scroll-strict-margins' is non-nil, this looks to the +beginning of the visual line. Otherwise it uses the beginning of +the logical line." + (save-excursion + ;; Cannot use `line-beginning-position' here because there is no + ;; visual-line equivalent. + (funcall (if smooth-scroll-strict-margins + #'beginning-of-visual-line + #'beginning-of-line)) + (point))) + +(defun smooth-scroll-count-lines (start end) + "Return number of (logical/visual) lines between START and END. + +If `smooth-scroll-strict-margins' is non-nil, this counts visual +lines. Otherwise it counts logical lines. + +If END is less than START, this returns zero, so it is important +to pass them in order." + (if (< end start) + 0 + (funcall (if smooth-scroll-strict-margins + #'count-screen-lines + #'count-lines) + start end))) + +(defun smooth-scroll-lines-above-point () + "Return the number of lines in window above point. + +This does not include the line that point is on." + (smooth-scroll-count-lines (window-start) + (smooth-scroll-line-beginning-position))) + +(defun smooth-scroll-lines-below-point () + "Return the number of lines in window above point. + +This does not include the line that point is on." + ;; We don't rely on `window-end' because if we are scrolled near the + ;; end of the buffer, it will only give the number of lines + ;; remaining in the file, not the number of lines to the bottom of + ;; the window. + (- (window-height) 2 (smooth-scroll-lines-above-point))) + +(defun smooth-scroll-window-allowed-margin () + "Return the maximum allowed margin above or below point. + +This only matters for windows whose height is +`smooth-scroll-margin' * 2 lines or less." + ;; We subtract 1 for the modeline, which is counted in + ;; `window-height', and one more for the line that point is on. Then + ;; we divide by 2, rouding down. + (/ (- (window-height) 2) 2)) + +(defsubst window-is-at-bob-p () + "Returns non-nil if `(window-start)' is 1 (or less)." + (<= (window-start) 1)) + +;;;_ + main function +(defun do-smooth-scroll () + "Ensure that point is not to close to window edges. + +This function scrolls the window until there are at least +`smooth-scroll-margin' lines between the point and both the top +and bottom of the window. If this is not possible because the +window is too small, th window is scrolled such that the point is +roughly centered within the window." + (interactive) + (when smooth-scrolling-mode + (let* ((desired-margin + ;; For short windows, we reduce `smooth-scroll-margin' to + ;; half the window height minus 1. + (min (smooth-scroll-window-allowed-margin) + smooth-scroll-margin)) + (upper-margin (smooth-scroll-lines-above-point)) + (lower-margin (smooth-scroll-lines-below-point))) + (smooth-scroll-ignore-scroll-errors + (cond + ((< upper-margin desired-margin) + (save-excursion + (dotimes (i (- desired-margin upper-margin)) + (scroll-down 1)))) + ((< lower-margin desired-margin) + (save-excursion + (dotimes (i (- desired-margin lower-margin)) + (scroll-up 1))))))))) + +;;;_ + advice setup + +;;;###autoload +(defmacro enable-smooth-scroll-for-function (func) + "Define advice on FUNC to do smooth scrolling. + +This adds after advice with name `smooth-scroll' to FUNC. + +Note that the advice will not have an effect unless +`smooth-scrolling-mode' is enabled." + `(defadvice ,func (after smooth-scroll activate) + "Do smooth scrolling after command finishes. + +This advice only has an effect when `smooth-scrolling-mode' is +enabled. See `smooth-scrolling-mode' for details. To remove this +advice, use `disable-smooth-scroll-for-function'." + (do-smooth-scroll))) + +(defmacro enable-smooth-scroll-for-function-conditionally (func cond) + "Define advice on FUNC to do smooth scrolling conditionally. + +This adds after advice with name `smooth-scroll' to FUNC. The +advice runs smooth scrolling if expression COND evaluates to +true. COND is included within the advice and therefore has access +to all of FUNC's arguments. + +Note that the advice will not have an effect unless +`smooth-scrolling-mode' is enabled." + (declare (indent 1)) + `(defadvice ,func (after smooth-scroll activate) + ,(format "Do smooth scrolling conditionally after command finishes. + +Smooth sccrolling will only be performed if the following +expression evaluates to true after the function has run: + +%s +This advice only has an effect when `smooth-scrolling-mode' is +enabled. See `smooth-scrolling-mode' for details. To remove this +advice, use `disable-smooth-scroll-for-function'." + (pp-to-string cond)) + (when ,cond + (do-smooth-scroll)))) + +(defmacro disable-smooth-scroll-for-function (func) + "Delete smooth-scroll advice for FUNC." + ;; This doesn't actually need to be a macro, but it is one for + ;; consistency with the enabling macro. Errors are ignored in case + ;; the advice has already been removed. + `(ignore-errors + (ad-remove-advice ',func 'after 'smooth-scroll) + (ad-activate ',func))) + +(progn + (enable-smooth-scroll-for-function previous-line) + (enable-smooth-scroll-for-function next-line) + (enable-smooth-scroll-for-function dired-previous-line) + (enable-smooth-scroll-for-function dired-next-line) + (enable-smooth-scroll-for-function isearch-repeat) + (enable-smooth-scroll-for-function-conditionally scroll-up-command + (not (window-is-at-bob-p))) + (enable-smooth-scroll-for-function-conditionally scroll-down-command + (not (window-is-at-bob-p)))) + +;;;_ + provide +(provide 'smooth-scrolling) +;;; smooth-scrolling.el ends here diff --git a/lisp/text.el b/lisp/text.el new file mode 100644 index 0000000..498a373 --- /dev/null +++ b/lisp/text.el @@ -0,0 +1,7 @@ +;; Text file section +(defun setup-text-mode () + (setq word-wrap t) + (global-hl-line-mode 0) + ) + +(provide 'text) |