mirror of
https://github.com/lliding/ld-emacs.git
synced 2025-10-13 05:23:05 +00:00
Remove unused parts and reorganize config files.
This commit is contained in:
parent
92c3e19a46
commit
215097dbdb
27
.gitmodules
vendored
27
.gitmodules
vendored
@ -1,33 +1,6 @@
|
||||
[submodule "site-lisp/extensions-submodule/go-mode.el"]
|
||||
path = site-lisp/extensions-submodule/go-mode.el
|
||||
url = git@github.com:dominikh/go-mode.el.git
|
||||
[submodule "site-lisp/extensions-submodule/jsonian"]
|
||||
path = site-lisp/extensions-submodule/jsonian
|
||||
url = git@github.com:iwahbe/jsonian.git
|
||||
[submodule "site-lisp/extensions-submodule/ace-window"]
|
||||
path = site-lisp/extensions-submodule/ace-window
|
||||
url = git@github.com:abo-abo/ace-window.git
|
||||
[submodule "site-lisp/extensions-submodule/dash.el"]
|
||||
path = site-lisp/extensions-submodule/dash.el
|
||||
url = git@github.com:magnars/dash.el.git
|
||||
[submodule "site-lisp/extensions-submodule/avy"]
|
||||
path = site-lisp/extensions-submodule/avy
|
||||
url = git@github.com:abo-abo/avy.git
|
||||
[submodule "site-lisp/extensions-submodule/emacs-which-key"]
|
||||
path = site-lisp/extensions-submodule/emacs-which-key
|
||||
url = git@github.com:justbur/emacs-which-key.git
|
||||
[submodule "site-lisp/extensions-submodule/lua-mode"]
|
||||
path = site-lisp/extensions-submodule/lua-mode
|
||||
url = git@github.com:immerrr/lua-mode.git
|
||||
[submodule "site-lisp/extensions-submodule/markdown-mode"]
|
||||
path = site-lisp/extensions-submodule/markdown-mode
|
||||
url = git@github.com:jrblevin/markdown-mode.git
|
||||
[submodule "site-lisp/extensions-submodule/modus-themes"]
|
||||
path = site-lisp/extensions-submodule/modus-themes
|
||||
url = git@github.com:protesilaos/modus-themes.git
|
||||
[submodule "site-lisp/extensions-submodule/swiper"]
|
||||
path = site-lisp/extensions-submodule/swiper
|
||||
url = git@github.com:abo-abo/swiper.git
|
||||
[submodule "site-lisp/extensions-submodule/web-mode"]
|
||||
path = site-lisp/extensions-submodule/web-mode
|
||||
url = git@github.com:fxbois/web-mode.git
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
;;; company-ctags.el --- Fastest company-mode completion backend for ctags -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2019,2020 Chen Bin
|
||||
;; Copyright (C) 2019-2024 Chen Bin
|
||||
|
||||
;; Author: Chen Bin <chenbin.sh@gmail.com>
|
||||
;; URL: https://github.com/redguardtoo/company-ctags
|
||||
;; Version: 0.0.7
|
||||
;; Version: 0.1.1
|
||||
;; Keywords: convenience
|
||||
;; Package-Requires: ((emacs "25.1") (company "0.9.0"))
|
||||
;; Package-Requires: ((emacs "27.1") (company "0.9.0"))
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
@ -90,8 +90,7 @@ buffer automatically."
|
||||
|
||||
(defcustom company-ctags-ignore-case nil
|
||||
"Non-nil to ignore case in completion candidates."
|
||||
:type 'boolean
|
||||
:package-version '(company . "0.7.3"))
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom company-ctags-extra-tags-files nil
|
||||
"List of extra tags files which are loaded only once.
|
||||
@ -120,16 +119,15 @@ Set it to t or to a list of major modes."
|
||||
:type '(choice (const :tag "Off" nil)
|
||||
(const :tag "Any supported mode" t)
|
||||
(repeat :tag "Some major modes"
|
||||
(symbol :tag "Major mode")))
|
||||
:package-version '(company . "0.9.0"))
|
||||
(symbol :tag "Major mode"))))
|
||||
|
||||
(defcustom company-ctags-check-tags-file-interval 30
|
||||
"The interval (seconds) to check tags file.
|
||||
Default value is 30 seconds."
|
||||
:type 'integer)
|
||||
|
||||
(defcustom company-ctags-tags-file-name "TAGS"
|
||||
"The name of tags file."
|
||||
(defcustom company-ctags-tags-file-name '("tags" "TAGS")
|
||||
"The name or name list of tags file."
|
||||
:type 'string)
|
||||
|
||||
(defcustom company-ctags-tag-name-valid-characters
|
||||
@ -163,25 +161,25 @@ the candidate."
|
||||
(defvar company-ctags-tags-file-caches nil
|
||||
"The cached tags files.")
|
||||
|
||||
(defvar company-ctags-debug nil
|
||||
"Enable debug logging")
|
||||
|
||||
(defvar company-ctags-cached-candidates nil
|
||||
"The cached candidates searched with certain prefix.")
|
||||
|
||||
(defconst company-ctags-fast-pattern
|
||||
"\177\\([^\177\001\n]+\\)\001"
|
||||
"Pattern to extract tag name created by Ctags only.")
|
||||
|
||||
(defconst company-ctags-slow-pattern
|
||||
"\\([^\f\t\n\r()=,; ]*\\)[\f\t\n\r()=,; ]*\177\\\(?:\\([^\n\001]+\\)\001\\)?"
|
||||
"Pattern to extract tag name created by Ctags/Etags.")
|
||||
|
||||
(defun company-ctags-find-table ()
|
||||
"Find tags file."
|
||||
(let* ((file (expand-file-name
|
||||
company-ctags-tags-file-name
|
||||
(locate-dominating-file (or buffer-file-name
|
||||
default-directory)
|
||||
company-ctags-tags-file-name))))
|
||||
(when (and file (file-regular-p file))
|
||||
(let* ((file-name company-ctags-tags-file-name)
|
||||
(file-names (if (stringp file-name) (list file-name) file-name))
|
||||
file)
|
||||
(when (cl-find-if (lambda (fn)
|
||||
(setq file (expand-file-name
|
||||
fn
|
||||
(locate-dominating-file (or buffer-file-name
|
||||
default-directory)
|
||||
fn)))
|
||||
(and file (file-regular-p file)))
|
||||
file-names)
|
||||
(list file))))
|
||||
|
||||
(defun company-ctags-buffer-table ()
|
||||
@ -252,20 +250,27 @@ the candidate."
|
||||
(setq i (1+ i)))
|
||||
dict))
|
||||
|
||||
(defun company-ctags-parse-tags (text &optional dict)
|
||||
"Extract tag names from TEXT.
|
||||
(defun company-ctags-parse-tags (text emacs-tags-file-p &optional dict)
|
||||
"Extract tag names from TEXT of tags file.
|
||||
If EMACS-TAGS-FILE-P is t, the tags file in Emacs format. Or else Vim format.
|
||||
DICT is the existing lookup dictionary contains tag names.
|
||||
If it's nil, return a dictionary, or else return the existing dictionary."
|
||||
(let* ((start 0)
|
||||
(emacs-regex "\177\\([^\177\001\n]+\\)\001")
|
||||
(etags-regex "\\([^\f\t\n\r()=,; ]*\\)[\f\t\n\r()=,; ]*\177\\\(?:\\([^\n\001]+\\)\001\\)?")
|
||||
(vim-regex "^\\([^!\f\t\n\r()=,; ]+\\)\t\\(.+\\)$")
|
||||
(case-fold-search company-ctags-ignore-case))
|
||||
|
||||
(when company-ctags-debug (message "company-ctags-parse-tags called"))
|
||||
(unless dict (setq dict (company-ctags-init-tagname-dict)))
|
||||
|
||||
;; Code inside the loop should be optimized.
|
||||
;; Please avoid calling lisp function inside the loop.
|
||||
(cond
|
||||
(company-ctags-support-etags
|
||||
;; tags file is in emacs format with support on some legacy stuff
|
||||
((and company-ctags-support-etags emacs-tags-file-p)
|
||||
;; slow algorithm, need support both explicit and implicit tags name
|
||||
(while (string-match company-ctags-slow-pattern text start)
|
||||
(while (string-match etags-regex text start)
|
||||
(cond
|
||||
((match-beginning 2)
|
||||
;; There is an explicit tag name.
|
||||
@ -277,12 +282,21 @@ If it's nil, return a dictionary, or else return the existing dictionary."
|
||||
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
|
||||
dict)))
|
||||
(setq start (+ 4 (match-end 0)))))
|
||||
(t
|
||||
|
||||
;; tags file is in emacs format
|
||||
(emacs-tags-file-p
|
||||
;; fast algorithm, support explicit tags name only
|
||||
(while (string-match company-ctags-fast-pattern text start)
|
||||
(while (string-match emacs-regex text start)
|
||||
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
|
||||
dict)
|
||||
(setq start (+ 4 (match-end 0))))))
|
||||
(setq start (+ 4 (match-end 0)))))
|
||||
|
||||
;; tags file is in vim format
|
||||
(t
|
||||
(while (string-match vim-regex text start)
|
||||
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
|
||||
dict)
|
||||
(setq start (match-end 2)))))
|
||||
|
||||
dict))
|
||||
|
||||
@ -330,8 +344,13 @@ If `company-ctags-fuzzy-match-p' is t, check if the match contains STRING."
|
||||
(t
|
||||
(company-ctags-fetch-by-first-char (elt prefix 0) prefix tagname-dict))))
|
||||
|
||||
(defun company-ctags-check-tags-file-format (content)
|
||||
"Check tags file's format by analyzing CONTENT."
|
||||
;; Emacs tags file has character "Form Feed"
|
||||
(string-match-p "\014" content))
|
||||
|
||||
(defun company-ctags-load-tags-file (file static-p &optional force no-diff-prog)
|
||||
"Load tags from FILE.
|
||||
"Load tags from FILE. Tags file generated by Emacs and Vim is supported.
|
||||
If STATIC-P is t, the corresponding tags file is read only once.
|
||||
If FORCE is t, tags file is read without `company-ctags-tags-file-caches'.
|
||||
If NO-DIFF-PROG is t, do NOT use diff on tags file.
|
||||
@ -343,6 +362,7 @@ This function return t if any tag file is reloaded."
|
||||
file-info
|
||||
(plist-get file-info :raw-content)
|
||||
(executable-find diff-command)))
|
||||
emacs-tags-file-p
|
||||
tagname-dict
|
||||
reloaded)
|
||||
|
||||
@ -381,15 +401,20 @@ This function return t if any tag file is reloaded."
|
||||
;; should be merged with old tag names
|
||||
(setq tagname-dict
|
||||
(company-ctags-parse-tags diff-output
|
||||
(plist-get file-info :emacs-tags-file-p)
|
||||
(plist-get file-info :tagname-dict)))))
|
||||
(t
|
||||
(unless company-ctags-quiet (message "Please be patient when loading %s" file))
|
||||
(setq raw-content (with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(buffer-string)))
|
||||
(setq emacs-tags-file-p (company-ctags-check-tags-file-format raw-content))
|
||||
;; collect all tag names
|
||||
(setq tagname-dict (company-ctags-parse-tags raw-content))
|
||||
(unless company-ctags-quiet (message "%s is loaded." file))))
|
||||
(setq tagname-dict (company-ctags-parse-tags raw-content emacs-tags-file-p))
|
||||
(unless company-ctags-quiet
|
||||
(message "%s with %s format is loaded."
|
||||
file
|
||||
(if emacs-tags-file-p "Emacs" "Vim")))))
|
||||
|
||||
;; initialize hash table if needed
|
||||
(unless company-ctags-tags-file-caches
|
||||
@ -403,6 +428,7 @@ This function return t if any tag file is reloaded."
|
||||
(list :raw-content (unless static-p raw-content)
|
||||
:tagname-dict tagname-dict
|
||||
:static-p static-p
|
||||
:emacs-tags-file-p emacs-tags-file-p
|
||||
:timestamp (float-time (current-time))
|
||||
:filesize (nth 7 (file-attributes file)))
|
||||
company-ctags-tags-file-caches))
|
||||
@ -422,6 +448,9 @@ This function return t if any tag file is reloaded."
|
||||
|
||||
(defun company-ctags--candidates (prefix)
|
||||
"Get candidate with PREFIX."
|
||||
(when company-ctags-debug
|
||||
(message "company-ctags--candidates called => %s" prefix))
|
||||
|
||||
(when (and prefix (> (length prefix) 0))
|
||||
(let* ((file (and tags-file-name (file-truename tags-file-name)))
|
||||
(completion-ignore-case company-ctags-ignore-case)
|
||||
|
||||
@ -1,87 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defcustom dired-display-buffer-switch-window t
|
||||
"Switch focus to the newly created buffer window. nil to disable."
|
||||
:type 'boolean
|
||||
)
|
||||
|
||||
(defun ld-display-buffer (buffer-or-name alist direction &optional size pixelwise)
|
||||
"BUFFER: The buffer that will be displayed.
|
||||
ALIST: See the doc-string of `display-buffer' for more information.
|
||||
DIRECTION: Must use one of these symbols: 'left 'right 'below 'above
|
||||
SIZE: See the doc-string for `split-window'.
|
||||
PIXELWISE: See the doc-string for `split-window'.
|
||||
There are three possibilities:
|
||||
- (1) If a window on the frame already displays the target buffer,
|
||||
then just reuse the same window.
|
||||
- (2) If there is already a window in the specified direction in relation
|
||||
to the selected window, then display the target buffer in said window.
|
||||
- (3) If there is no window in the specified direction, then create one
|
||||
in that direction and display the target buffer in said window."
|
||||
(let* ((buffer
|
||||
(if (bufferp buffer-or-name)
|
||||
buffer-or-name
|
||||
(get-buffer buffer-or-name)))
|
||||
(window
|
||||
(cond
|
||||
((get-buffer-window buffer (selected-frame)))
|
||||
((window-in-direction direction))
|
||||
(t
|
||||
(split-window (selected-window) size direction pixelwise)))))
|
||||
;; (window--display-buffer buffer window 'window alist display-buffer-mark-dedicated)
|
||||
(window--display-buffer buffer window 'window alist)
|
||||
(if dired-display-buffer-switch-window
|
||||
(select-window window))
|
||||
))
|
||||
|
||||
(defun dired-display-buffer (&optional direction alist)
|
||||
"Display a dired-mode buffer or a file underneath point in a dired-mode buffer."
|
||||
(interactive)
|
||||
(let* ((file-or-dir (or (and (eq major-mode 'dired-mode) (dired-get-file-for-visit))
|
||||
(read-directory-name "Directory: ")))
|
||||
(buffer (find-file-noselect file-or-dir))
|
||||
(direction
|
||||
(if direction
|
||||
direction
|
||||
(let ((char (read-char-exclusive (concat
|
||||
"["
|
||||
(propertize "l" 'face '(:foreground "red"))
|
||||
"]"
|
||||
(propertize "eft" 'face '(:foreground "blue"))
|
||||
" | ["
|
||||
(propertize "r" 'face '(:foreground "red"))
|
||||
"]"
|
||||
(propertize "ight" 'face '(:foreground "blue"))
|
||||
" | ["
|
||||
(propertize "a" 'face '(:foreground "red"))
|
||||
"]"
|
||||
(propertize "bove" 'face '(:foreground "blue"))
|
||||
" | ["
|
||||
(propertize "b" 'face '(:foreground "red"))
|
||||
"]"
|
||||
(propertize "elow" 'face '(:foreground "blue"))))))
|
||||
(cond
|
||||
((eq char ?l)
|
||||
'left)
|
||||
((eq char ?r)
|
||||
'right)
|
||||
((eq char ?a)
|
||||
'above)
|
||||
((eq char ?b)
|
||||
'below)
|
||||
;;; FIXME: @lawlist may add a loop similar to `org-capture'
|
||||
;;; whereby a new `read-char-exclusive' will be initiated if
|
||||
;;; a user did not initially choose a valid option (l/r/a/b).
|
||||
(t
|
||||
(let ((debug-on-quit nil)
|
||||
(msg (concat "dired-display-buffer: "
|
||||
"You did not select l/r/a/b "
|
||||
"-- exiting.")))
|
||||
(signal 'quit `(,msg)))))))))
|
||||
(ld-display-buffer buffer alist direction)))
|
||||
|
||||
(provide 'dired-display-buffer)
|
||||
|
||||
;;; dired-display-buffer.el ends here
|
||||
@ -1,273 +0,0 @@
|
||||
;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection
|
||||
|
||||
;; Copyright (C) 2014-2015 Matúš Goljer
|
||||
|
||||
;; Author: Matúš Goljer <matus.goljer@gmail.com>
|
||||
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
|
||||
;; Keywords: files
|
||||
;; Version: 0.0.1
|
||||
;; Created: 14th February 2014
|
||||
;; Package-Requires: ((dash "2.5.0"))
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Utilities and helpers for `dired-hacks' collection of dired
|
||||
;; improvements.
|
||||
|
||||
;; This package also provides these interactive functions:
|
||||
;; * `dired-hacks-next-file' - go to next file, skipping empty and non-file lines
|
||||
;; * `dired-hacks-previous-file' - go to previous file, skipping empty
|
||||
;; and non-file lines
|
||||
;; * `dired-utils-format-information-line-mode' - Format the information
|
||||
;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576).
|
||||
|
||||
|
||||
;; See https://github.com/Fuco1/dired-hacks for the entire collection
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'dired)
|
||||
|
||||
(defgroup dired-hacks ()
|
||||
"Collection of useful dired additions."
|
||||
:group 'dired
|
||||
:prefix "dired-hacks-")
|
||||
|
||||
(defcustom dired-hacks-file-size-formatter #'file-size-human-readable
|
||||
"The function used to format file sizes.
|
||||
|
||||
See `dired-utils-format-file-sizes'."
|
||||
:type 'function
|
||||
:group 'dired-hacks)
|
||||
|
||||
(defcustom dired-hacks-datetime-regexp
|
||||
"\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)"
|
||||
"A regexp matching the date/time in the dired listing.
|
||||
|
||||
It is used to determine where the filename starts. It should
|
||||
*not* match any characters after the last character of the
|
||||
timestamp. It is assumed that the timestamp is preceded and
|
||||
followed by at least one space character. You should only use
|
||||
shy groups (prefixed with ?:) because the first group is used by
|
||||
the font-lock to determine what portion of the name should be
|
||||
colored."
|
||||
:type 'regexp
|
||||
:group 'dired-hacks)
|
||||
|
||||
(defalias 'dired-utils--string-trim
|
||||
(if (and (require 'subr-x nil t)
|
||||
(fboundp 'string-trim))
|
||||
#'string-trim
|
||||
(lambda (string)
|
||||
(let ((s string))
|
||||
(when (string-match "\\`[ \t\n\r]+" s)
|
||||
(setq s (replace-match "" t t s)))
|
||||
(when (string-match "[ \t\n\r]+\\'" s)
|
||||
(setq s (replace-match "" t t s)))
|
||||
s)))
|
||||
"Trim STRING of trailing whitespace.
|
||||
|
||||
\(fn STRING)")
|
||||
|
||||
(defun dired-utils-get-filename (&optional localp)
|
||||
"Like `dired-get-filename' but never signal an error.
|
||||
|
||||
Optional arg LOCALP with value `no-dir' means don't include
|
||||
directory name in result."
|
||||
(dired-get-filename localp t))
|
||||
|
||||
(defun dired-utils-get-all-files (&optional localp)
|
||||
"Return all files in this dired buffer as a list.
|
||||
|
||||
LOCALP has same semantics as in `dired-get-filename'."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(let (r)
|
||||
(while (= 0 (forward-line))
|
||||
(--when-let (dired-utils-get-filename localp)
|
||||
(push it r)))
|
||||
(nreverse r))))
|
||||
|
||||
(defconst dired-utils-file-attributes-keywords
|
||||
'(:isdir :nlinks :uid :gid :atime :mtime :ctime :size :modes :gidchg :inode :devnum)
|
||||
"List of keywords to map with `file-attributes'.")
|
||||
|
||||
(defconst dired-utils-info-keywords
|
||||
`(:name :issym :target ,@dired-utils-file-attributes-keywords)
|
||||
"List of keywords available for `dired-utils-get-info'.")
|
||||
|
||||
(defun dired-utils--get-keyword-info (keyword)
|
||||
"Get file information about KEYWORD."
|
||||
(let ((filename (dired-utils-get-filename)))
|
||||
(cl-case keyword
|
||||
(:name filename)
|
||||
(:isdir (file-directory-p filename))
|
||||
(:issym (and (file-symlink-p filename) t))
|
||||
(:target (file-symlink-p filename))
|
||||
(t
|
||||
(nth (-elem-index keyword dired-utils-file-attributes-keywords)
|
||||
(file-attributes filename))))))
|
||||
|
||||
(defun dired-utils-get-info (&rest keywords)
|
||||
"Query for info about the file at point.
|
||||
|
||||
KEYWORDS is a list of attributes to query.
|
||||
|
||||
When querying for one attribute, its value is returned. When
|
||||
querying for more than one, a list of results is returned.
|
||||
|
||||
The available keywords are listed in
|
||||
`dired-utils-info-keywords'."
|
||||
(let ((attributes (mapcar 'dired-utils--get-keyword-info keywords)))
|
||||
(if (> (length attributes) 1)
|
||||
attributes
|
||||
(car attributes))))
|
||||
|
||||
(defun dired-utils-goto-line (filename)
|
||||
"Go to line describing FILENAME in listing.
|
||||
|
||||
Should be absolute file name matched against
|
||||
`dired-get-filename'."
|
||||
(goto-char (point-min))
|
||||
(let (stop)
|
||||
(while (and (not stop)
|
||||
(= (forward-line) 0))
|
||||
(when (equal filename (dired-utils-get-filename))
|
||||
(setq stop t)
|
||||
(dired-move-to-filename)))
|
||||
stop))
|
||||
|
||||
(defun dired-utils-match-filename-regexp (filename alist)
|
||||
"Match FILENAME against each car in ALIST and return first matched cons.
|
||||
|
||||
Each car in ALIST is a regular expression.
|
||||
|
||||
The matching is done using `string-match-p'."
|
||||
(let (match)
|
||||
(--each-while alist (not match)
|
||||
(when (string-match-p (car it) filename)
|
||||
(setq match it)))
|
||||
match))
|
||||
|
||||
(defun dired-utils-match-filename-extension (filename alist)
|
||||
"Match FILENAME against each car in ALIST and return first matched cons.
|
||||
|
||||
Each car in ALIST is a string representing file extension
|
||||
*without* the delimiting dot."
|
||||
(let (done)
|
||||
(--each-while alist (not done)
|
||||
(when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") filename)
|
||||
(setq done it)))
|
||||
done))
|
||||
|
||||
(defun dired-utils-format-information-line ()
|
||||
"Format the disk space on the Dired information line."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(forward-line)
|
||||
(let ((inhibit-read-only t)
|
||||
(limit (line-end-position)))
|
||||
(while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+$\\>\\)" nil t)
|
||||
(replace-match
|
||||
(save-match-data
|
||||
(propertize (dired-utils--string-trim
|
||||
(funcall dired-hacks-file-size-formatter
|
||||
(* 1024 (string-to-number (match-string 1))) t))
|
||||
'invisible 'dired-hide-details-information))
|
||||
t nil nil 1)))))
|
||||
|
||||
|
||||
;;; Predicates
|
||||
(defun dired-utils-is-file-p ()
|
||||
"Return non-nil if the line at point is a file or a directory."
|
||||
(dired-utils-get-filename 'no-dir))
|
||||
|
||||
(defun dired-utils-is-dir-p ()
|
||||
"Return non-nil if the line at point is a directory."
|
||||
(--when-let (dired-utils-get-filename)
|
||||
(file-directory-p it)))
|
||||
|
||||
|
||||
;;; Interactive
|
||||
;; TODO: add wrap-around option
|
||||
(defun dired-hacks-next-file (&optional arg)
|
||||
"Move point to the next file.
|
||||
|
||||
Optional prefix ARG says how many lines to move; default is one
|
||||
line."
|
||||
(interactive "p")
|
||||
(unless arg (setq arg 1))
|
||||
(if (< arg 0)
|
||||
(dired-hacks-previous-file (- arg))
|
||||
(--dotimes arg
|
||||
(forward-line)
|
||||
(while (and (or (not (dired-utils-is-file-p))
|
||||
(get-text-property (point) 'invisible))
|
||||
(= (forward-line) 0))))
|
||||
(if (not (= (point) (point-max)))
|
||||
(dired-move-to-filename)
|
||||
(forward-line -1)
|
||||
(dired-move-to-filename)
|
||||
nil)))
|
||||
|
||||
(defun dired-hacks-previous-file (&optional arg)
|
||||
"Move point to the previous file.
|
||||
|
||||
Optional prefix ARG says how many lines to move; default is one
|
||||
line."
|
||||
(interactive "p")
|
||||
(unless arg (setq arg 1))
|
||||
(if (< arg 0)
|
||||
(dired-hacks-next-file (- arg))
|
||||
(--dotimes arg
|
||||
(forward-line -1)
|
||||
(while (and (or (not (dired-utils-is-file-p))
|
||||
(get-text-property (point) 'invisible))
|
||||
(= (forward-line -1) 0))))
|
||||
(if (not (= (point) (point-min)))
|
||||
(dired-move-to-filename)
|
||||
(dired-hacks-next-file)
|
||||
nil)))
|
||||
|
||||
(defun dired-hacks-compare-files (file-a file-b)
|
||||
"Test if two files FILE-A and FILE-B are the (probably) the same."
|
||||
(interactive (let ((other-dir (dired-dwim-target-directory)))
|
||||
(list (read-file-name "File A: " default-directory (car (dired-get-marked-files)) t)
|
||||
(read-file-name "File B: " other-dir (with-current-buffer (cdr (assoc other-dir dired-buffers))
|
||||
(car (dired-get-marked-files))) t))))
|
||||
(let ((md5-a (with-temp-buffer
|
||||
(shell-command (format "md5sum %s" file-a) (current-buffer))
|
||||
(buffer-string)))
|
||||
(md5-b (with-temp-buffer
|
||||
(shell-command (format "md5sum %s" file-b) (current-buffer))
|
||||
(buffer-string))))
|
||||
(message "%s%sFiles are %s." md5-a md5-b
|
||||
(if (equal (car (split-string md5-a))
|
||||
(car (split-string md5-b)))
|
||||
"probably the same" "different"))))
|
||||
|
||||
(define-minor-mode dired-utils-format-information-line-mode
|
||||
"Toggle formatting of disk space in the Dired information line."
|
||||
:group 'dired-utils
|
||||
:lighter ""
|
||||
(if dired-utils-format-information-line-mode
|
||||
(add-hook 'dired-after-readin-hook #'dired-utils-format-information-line)
|
||||
(remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line)))
|
||||
|
||||
(provide 'dired-hacks-utils)
|
||||
|
||||
;;; dired-hacks-utils.el ends here
|
||||
@ -1,356 +0,0 @@
|
||||
;;; dired-narrow.el --- Live-narrowing of search results for dired
|
||||
|
||||
;; Copyright (C) 2014-2015 Matúš Goljer
|
||||
|
||||
;; Author: Matúš Goljer <matus.goljer@gmail.com>
|
||||
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
|
||||
;; Version: 0.0.1
|
||||
;; Created: 14th February 2014
|
||||
;; Package-Requires: ((dash "2.7.0") (dired-hacks-utils "0.0.1"))
|
||||
;; Keywords: files
|
||||
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License
|
||||
;; as published by the Free Software Foundation; either version 3
|
||||
;; of the License, or (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This package provides live filtering of files in dired buffers. In
|
||||
;; general, after calling the respective narrowing function you type a
|
||||
;; filter string into the minibuffer. After each change the changes
|
||||
;; automatically reflect in the buffer. Typing C-g will cancel the
|
||||
;; narrowing and restore the original view, typing RET will exit the
|
||||
;; live filtering mode and leave the dired buffer in the narrowed
|
||||
;; state. To bring it back to the original view, you can call
|
||||
;; `revert-buffer' (usually bound to `g').
|
||||
|
||||
;; During the filtering process, several special functions are
|
||||
;; available. You can customize the binding by changing
|
||||
;; `dired-narrow-map'.
|
||||
|
||||
;; * `dired-narrow-next-file' (<down> or C-n) - move the point to the
|
||||
;; next file
|
||||
;; * `dired-narrow-previous-file' (<up> or C-p) - move the point to the
|
||||
;; previous file
|
||||
;; * `dired-narrow-enter-directory' (<right> or C-j) - descend into the
|
||||
;; directory under point and immediately go back to narrowing mode
|
||||
|
||||
;; You can customize what happens after exiting the live filtering
|
||||
;; mode by customizing `dired-narrow-exit-action'.
|
||||
|
||||
;; These narrowing functions are provided:
|
||||
|
||||
;; * `dired-narrow'
|
||||
;; * `dired-narrow-regexp'
|
||||
;; * `dired-narrow-fuzzy'
|
||||
|
||||
;; You can also create your own narrowing functions quite easily. To
|
||||
;; define new narrowing function, use `dired-narrow--internal' and
|
||||
;; pass it an apropriate filter. The filter should take one argument
|
||||
;; which is the filter string from the minibuffer. It is then called
|
||||
;; at each line that describes a file with point at the beginning of
|
||||
;; the file name. If the filter returns nil, the file is removed from
|
||||
;; the view. As an inspiration, look at the built-in functions
|
||||
;; mentioned above.
|
||||
|
||||
;; See https://github.com/Fuco1/dired-hacks for the entire collection.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
(require 'dired-hacks-utils)
|
||||
|
||||
(require 'delsel)
|
||||
|
||||
(defgroup dired-narrow ()
|
||||
"Live-narrowing of search results for dired."
|
||||
:group 'dired-hacks
|
||||
:prefix "dired-narrow-")
|
||||
|
||||
(defvar dired-narrow-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map (kbd "<up>") 'dired-narrow-previous-file)
|
||||
(define-key map (kbd "<down>") 'dired-narrow-next-file)
|
||||
(define-key map (kbd "<right>") 'dired-narrow-enter-directory)
|
||||
(define-key map (kbd "C-p") 'dired-narrow-previous-file)
|
||||
(define-key map (kbd "C-n") 'dired-narrow-next-file)
|
||||
(define-key map (kbd "C-j") 'dired-narrow-enter-directory)
|
||||
(define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
|
||||
(define-key map (kbd "RET") 'exit-minibuffer)
|
||||
(define-key map (kbd "<return>") 'exit-minibuffer)
|
||||
map)
|
||||
"Keymap used while `dired-narrow' is reading the pattern.")
|
||||
|
||||
(defcustom dired-narrow-exit-action 'ignore
|
||||
"Function to call after exiting minibuffer.
|
||||
|
||||
Function takes no argument and is called with point over the file
|
||||
we should act on."
|
||||
:type '(choice (const :tag "Open file under point" dired-narrow-find-file)
|
||||
(function :tag "Use custom function."))
|
||||
:group 'dired-narrow)
|
||||
|
||||
(defcustom dired-narrow-exit-when-one-left nil
|
||||
"If there is only one file left while narrowing,
|
||||
exit minibuffer and call `dired-narrow-exit-action'."
|
||||
:type 'boolean
|
||||
:group 'dired-narrow)
|
||||
|
||||
(defcustom dired-narrow-enable-blinking t
|
||||
"If non-nil, highlight the chosen file shortly.
|
||||
Only works when `dired-narrow-exit-when-one-left' is non-nil."
|
||||
:type 'boolean
|
||||
:group 'dired-narrow)
|
||||
|
||||
(defcustom dired-narrow-blink-time 0.2
|
||||
"How many seconds should a chosen file be highlighted."
|
||||
:type 'number
|
||||
:group 'dired-narrow)
|
||||
|
||||
(defface dired-narrow-blink
|
||||
'((t :background "#eadc62"
|
||||
:foreground "black"))
|
||||
"The face used to highlight a chosen file
|
||||
when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are true."
|
||||
:group 'dired-narrow)
|
||||
|
||||
|
||||
;; Utils
|
||||
|
||||
;; this is `gnus-remove-text-with-property'
|
||||
(defun dired-narrow--remove-text-with-property (prop)
|
||||
"Delete all text in the current buffer with text property PROP."
|
||||
(let ((start (point-min))
|
||||
end)
|
||||
(unless (get-text-property start prop)
|
||||
(setq start (next-single-property-change start prop)))
|
||||
(while start
|
||||
(setq end (text-property-any start (point-max) prop nil))
|
||||
(delete-region start (or end (point-max)))
|
||||
(setq start (when end
|
||||
(next-single-property-change start prop))))))
|
||||
|
||||
(defvar dired-narrow-filter-function 'identity
|
||||
"Filter function used to filter the dired view.")
|
||||
|
||||
(defvar dired-narrow--current-file nil
|
||||
"Value of point just before exiting minibuffer.")
|
||||
|
||||
(defun dired-narrow--update (filter)
|
||||
"Make the files not matching the FILTER invisible.
|
||||
Return the count of visible files that are left after update."
|
||||
|
||||
(let ((inhibit-read-only t)
|
||||
(visible-files-cnt 0))
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
;; TODO: we might want to call this only if the filter gets less
|
||||
;; specialized.
|
||||
(dired-narrow--restore)
|
||||
(while (dired-hacks-next-file)
|
||||
(if (funcall dired-narrow-filter-function filter)
|
||||
(progn
|
||||
(setq visible-files-cnt (1+ visible-files-cnt))
|
||||
(when (fboundp 'dired-insert-set-properties)
|
||||
(dired-insert-set-properties (line-beginning-position) (1+ (line-end-position)))))
|
||||
(put-text-property (line-beginning-position) (1+ (line-end-position)) :dired-narrow t)
|
||||
(put-text-property (line-beginning-position) (1+ (line-end-position)) 'invisible :dired-narrow))))
|
||||
(unless (dired-hacks-next-file)
|
||||
(dired-hacks-previous-file))
|
||||
(unless (dired-utils-get-filename)
|
||||
(dired-hacks-previous-file))
|
||||
visible-files-cnt))
|
||||
|
||||
(defun dired-narrow--restore ()
|
||||
"Restore the invisible files of the current buffer."
|
||||
(let ((inhibit-read-only t))
|
||||
(remove-list-of-text-properties (point-min) (point-max)
|
||||
'(invisible :dired-narrow))
|
||||
(when (fboundp 'dired-insert-set-properties)
|
||||
(dired-insert-set-properties (point-min) (point-max)))))
|
||||
|
||||
|
||||
(defun dired-narrow--blink-current-file ()
|
||||
(let* ((beg (line-beginning-position))
|
||||
(end (line-end-position))
|
||||
(overlay (make-overlay beg end)))
|
||||
(overlay-put overlay 'face 'dired-narrow-blink)
|
||||
(redisplay)
|
||||
(sleep-for dired-narrow-blink-time)
|
||||
(discard-input)
|
||||
(delete-overlay overlay)))
|
||||
|
||||
|
||||
;; Live filtering
|
||||
|
||||
(defvar dired-narrow-buffer nil
|
||||
"Dired buffer we are currently filtering.")
|
||||
|
||||
(defvar dired-narrow--minibuffer-content ""
|
||||
"Content of the minibuffer during narrowing.")
|
||||
|
||||
(defun dired-narrow--minibuffer-setup ()
|
||||
"Set up the minibuffer for live filtering."
|
||||
(when dired-narrow-buffer
|
||||
(add-hook 'post-command-hook 'dired-narrow--live-update nil :local)))
|
||||
|
||||
(add-hook 'minibuffer-setup-hook 'dired-narrow--minibuffer-setup)
|
||||
|
||||
(defun dired-narrow--live-update ()
|
||||
"Update the dired buffer based on the contents of the minibuffer."
|
||||
(when dired-narrow-buffer
|
||||
(let ((current-filter (minibuffer-contents-no-properties))
|
||||
visible-files-cnt)
|
||||
(with-current-buffer dired-narrow-buffer
|
||||
(setq visible-files-cnt
|
||||
(unless (equal current-filter dired-narrow--minibuffer-content)
|
||||
(dired-narrow--update current-filter)))
|
||||
|
||||
(setq dired-narrow--minibuffer-content current-filter)
|
||||
(setq dired-narrow--current-file (dired-utils-get-filename))
|
||||
(set-window-point (get-buffer-window (current-buffer)) (point))
|
||||
|
||||
(when (and dired-narrow-exit-when-one-left
|
||||
visible-files-cnt
|
||||
(= visible-files-cnt 1))
|
||||
(when dired-narrow-enable-blinking
|
||||
(dired-narrow--blink-current-file))
|
||||
(exit-minibuffer))))))
|
||||
|
||||
(defun dired-narrow--internal (filter-function)
|
||||
"Narrow a dired buffer to the files matching a filter.
|
||||
|
||||
The function FILTER-FUNCTION is called on each line: if it
|
||||
returns non-nil, the line is kept, otherwise it is removed. The
|
||||
function takes one argument, which is the current filter string
|
||||
read from minibuffer."
|
||||
(let ((dired-narrow-buffer (current-buffer))
|
||||
(dired-narrow-filter-function filter-function)
|
||||
(disable-narrow nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(dired-narrow-mode 1)
|
||||
(add-to-invisibility-spec :dired-narrow)
|
||||
(setq disable-narrow (read-from-minibuffer
|
||||
(pcase dired-narrow-filter-function
|
||||
('dired-narrow--regexp-filter
|
||||
"Regex Filter:\s")
|
||||
('dired-narrow--fuzzy-filter
|
||||
"Fuzzy Filter:\s")
|
||||
(_ "Filter:\s"))
|
||||
nil dired-narrow-map))
|
||||
(let ((inhibit-read-only t))
|
||||
(dired-narrow--remove-text-with-property :dired-narrow))
|
||||
;; If the file no longer exists, we can't do anything, so
|
||||
;; set to nil
|
||||
(unless (dired-utils-goto-line dired-narrow--current-file)
|
||||
(setq dired-narrow--current-file nil)))
|
||||
(with-current-buffer dired-narrow-buffer
|
||||
(unless disable-narrow (dired-narrow-mode -1))
|
||||
(remove-from-invisibility-spec :dired-narrow)
|
||||
(dired-narrow--restore))
|
||||
(when (and disable-narrow
|
||||
dired-narrow--current-file
|
||||
dired-narrow-exit-action)
|
||||
(funcall dired-narrow-exit-action))
|
||||
(cond
|
||||
((equal disable-narrow "dired-narrow-enter-directory")
|
||||
(dired-narrow--internal filter-function))))))
|
||||
|
||||
|
||||
;; Interactive
|
||||
|
||||
(defun dired-narrow--regexp-filter (filter)
|
||||
(condition-case nil
|
||||
(string-match-p filter (dired-utils-get-filename 'no-dir))
|
||||
;; Return t if your regexp is incomplete/has errors, thus
|
||||
;; filtering nothing until you fix the regexp.
|
||||
(invalid-regexp t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-narrow-regexp ()
|
||||
"Narrow a dired buffer to the files matching a regular expression."
|
||||
(interactive)
|
||||
(dired-narrow--internal 'dired-narrow--regexp-filter))
|
||||
|
||||
(defun dired-narrow--string-filter (filter)
|
||||
(let ((words (split-string filter " ")))
|
||||
(--all? (save-excursion (search-forward it (line-end-position) t)) words)))
|
||||
|
||||
(defun dired-narrow-next-file ()
|
||||
"Move point to the next file."
|
||||
(interactive)
|
||||
(with-current-buffer dired-narrow-buffer
|
||||
(dired-hacks-next-file)))
|
||||
|
||||
(defun dired-narrow-previous-file ()
|
||||
"Move point to the previous file."
|
||||
(interactive)
|
||||
(with-current-buffer dired-narrow-buffer
|
||||
(dired-hacks-previous-file)))
|
||||
|
||||
(defun dired-narrow-find-file ()
|
||||
"Run `dired-find-file' or any remapped action on file under point."
|
||||
(interactive)
|
||||
(let ((function (or (command-remapping 'dired-find-file)
|
||||
'dired-find-file)))
|
||||
(funcall function)))
|
||||
|
||||
(defun dired-narrow-enter-directory ()
|
||||
"Descend into directory under point and initiate narrowing."
|
||||
(interactive)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(insert "dired-narrow-enter-directory"))
|
||||
(exit-minibuffer))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-narrow ()
|
||||
"Narrow a dired buffer to the files matching a string.
|
||||
|
||||
If the string contains spaces, then each word is matched against
|
||||
the file name separately. To succeed, all of them have to match
|
||||
but the order does not matter.
|
||||
|
||||
For example \"foo bar\" matches filename \"bar-and-foo.el\"."
|
||||
(interactive)
|
||||
(dired-narrow--internal 'dired-narrow--string-filter))
|
||||
|
||||
(defun dired-narrow--fuzzy-filter (filter)
|
||||
(re-search-forward
|
||||
(mapconcat 'regexp-quote
|
||||
(mapcar 'char-to-string (string-to-list filter))
|
||||
".*")
|
||||
(line-end-position) t))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-narrow-fuzzy ()
|
||||
"Narrow a dired buffer to the files matching a fuzzy string.
|
||||
|
||||
A fuzzy string is constructed from the filter string by inserting
|
||||
\".*\" between each letter. This is then matched as regular
|
||||
expression against the file name."
|
||||
(interactive)
|
||||
(dired-narrow--internal 'dired-narrow--fuzzy-filter))
|
||||
|
||||
(define-minor-mode dired-narrow-mode
|
||||
"Minor mode for indicating when narrowing is in progress."
|
||||
:lighter " dired-narrow")
|
||||
|
||||
(defun dired-narrow--disable-on-revert ()
|
||||
"Disable `dired-narrow-mode' after revert."
|
||||
(dired-narrow-mode -1))
|
||||
|
||||
(add-hook 'dired-after-readin-hook 'dired-narrow--disable-on-revert)
|
||||
|
||||
(provide 'dired-narrow)
|
||||
;;; dired-narrow.el ends here
|
||||
@ -1,784 +0,0 @@
|
||||
;;; dired-subtree.el --- Insert subdirectories in a tree-like fashion
|
||||
|
||||
;; Copyright (C) 2014-2015 Matúš Goljer
|
||||
|
||||
;; Author: Matúš Goljer <matus.goljer@gmail.com>
|
||||
;; Maintainer: Matúš Goljer <matus.goljer@gmail.com>
|
||||
;; Keywords: files
|
||||
;; Version: 0.0.1
|
||||
;; Created: 25th February 2014
|
||||
;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1"))
|
||||
|
||||
;; 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:
|
||||
|
||||
;; Introduction
|
||||
;; ------------
|
||||
|
||||
;; The basic command to work with subdirectories in dired is `i',
|
||||
;; which inserts the subdirectory as a separate listing in the active
|
||||
;; dired buffer.
|
||||
|
||||
;; This package defines function `dired-subtree-insert' which instead
|
||||
;; inserts the subdirectory directly below its line in the original
|
||||
;; listing, and indent the listing of subdirectory to resemble a
|
||||
;; tree-like structure (somewhat similar to tree(1) except the pretty
|
||||
;; graphics). The tree display is somewhat more intuitive than the
|
||||
;; default "flat" subdirectory manipulation provided by `i'.
|
||||
|
||||
;; There are several presentation options and faces you can customize
|
||||
;; to change the way subtrees are displayed.
|
||||
|
||||
;; You can further remove the unwanted lines from the subtree by using
|
||||
;; `k' command or some of the built-in "focusing" functions, such as
|
||||
;; `dired-subtree-only-*' (see list below).
|
||||
|
||||
;; If you have the package `dired-filter', you can additionally filter
|
||||
;; the subtrees with global or local filters.
|
||||
|
||||
;; A demo of basic functionality is available on youtube:
|
||||
;; https://www.youtube.com/watch?v=z26b8HKFsNE
|
||||
|
||||
;; Interactive functions
|
||||
;; ---------------------
|
||||
|
||||
;; Here's a list of available interactive functions. You can read
|
||||
;; more about each one by using the built-in documentation facilities
|
||||
;; of emacs. It is adviced to place bindings for these into a
|
||||
;; convenient prefix key map, for example C-,
|
||||
|
||||
;; * `dired-subtree-insert'
|
||||
;; * `dired-subtree-remove'
|
||||
;; * `dired-subtree-toggle'
|
||||
;; * `dired-subtree-cycle'
|
||||
;; * `dired-subtree-revert'
|
||||
;; * `dired-subtree-narrow'
|
||||
;; * `dired-subtree-up'
|
||||
;; * `dired-subtree-down'
|
||||
;; * `dired-subtree-next-sibling'
|
||||
;; * `dired-subtree-previous-sibling'
|
||||
;; * `dired-subtree-beginning'
|
||||
;; * `dired-subtree-end'
|
||||
;; * `dired-subtree-mark-subtree'
|
||||
;; * `dired-subtree-unmark-subtree'
|
||||
;; * `dired-subtree-only-this-file'
|
||||
;; * `dired-subtree-only-this-directory'
|
||||
|
||||
;; If you have package `dired-filter', additional command
|
||||
;; `dired-subtree-apply-filter' is available.
|
||||
|
||||
;; See https://github.com/Fuco1/dired-hacks for the entire collection.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dired-hacks-utils)
|
||||
(require 'dash)
|
||||
(require 'cl-lib)
|
||||
|
||||
(defgroup dired-subtree ()
|
||||
"Insert subdirectories in a tree-like fashion."
|
||||
:group 'dired-hacks
|
||||
:prefix "dired-subtree-")
|
||||
|
||||
(defcustom dired-subtree-line-prefix " "
|
||||
"A prefix put into each nested subtree.
|
||||
|
||||
The prefix is repeated \"depth\" times.
|
||||
|
||||
Alternatively, it can be a function taking one argument---the
|
||||
depth---that creates the prefix."
|
||||
:type '(choice string function)
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defcustom dired-subtree-line-prefix-face 'parents
|
||||
"Specifies how the prefix is fontified."
|
||||
:type '(radio
|
||||
(const :tag "No face applied" nil)
|
||||
(const :tag "Inherit from current subtree" subtree)
|
||||
(const :tag "Inherit from all parents" parents))
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defcustom dired-subtree-use-backgrounds t
|
||||
"When non-nil, add a background face to a subtree listing."
|
||||
:type 'boolean
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defcustom dired-subtree-after-insert-hook ()
|
||||
"Hook run at the end of `dired-subtree-insert'."
|
||||
:type 'hook
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defcustom dired-subtree-after-remove-hook ()
|
||||
"Hook run at the end of `dired-subtree-remove'."
|
||||
:type 'hook
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defcustom dired-subtree-cycle-depth 3
|
||||
"Default depth expanded by `dired-subtree-cycle'."
|
||||
:type 'natnum
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defcustom dired-subtree-ignored-regexp
|
||||
(concat "^" (regexp-opt vc-directory-exclusion-list) "$")
|
||||
"Matching directories will not be expanded in `dired-subtree-cycle'."
|
||||
:type 'regexp
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defgroup dired-subtree-faces ()
|
||||
"Faces used in `dired-subtree'."
|
||||
:group 'dired-subtree)
|
||||
|
||||
(defface dired-subtree-depth-1-face
|
||||
'((t (:background "#252e30")))
|
||||
"Background for depth 1 subtrees"
|
||||
:group 'dired-subtree-faces)
|
||||
|
||||
(defface dired-subtree-depth-2-face
|
||||
'((t (:background "#232a2b")))
|
||||
"Background for depth 2 subtrees"
|
||||
:group 'dired-subtree-faces)
|
||||
|
||||
(defface dired-subtree-depth-3-face
|
||||
'((t (:background "#212627")))
|
||||
"Background for depth 3 subtrees"
|
||||
:group 'dired-subtree-faces)
|
||||
|
||||
(defface dired-subtree-depth-4-face
|
||||
'((t (:background "#1e2223")))
|
||||
"Background for depth 4 subtrees"
|
||||
:group 'dired-subtree-faces)
|
||||
|
||||
(defface dired-subtree-depth-5-face
|
||||
'((t (:background "#1c1d1e")))
|
||||
"Background for depth 5 subtrees"
|
||||
:group 'dired-subtree-faces)
|
||||
|
||||
(defface dired-subtree-depth-6-face
|
||||
'((t (:background "#1a191a")))
|
||||
"Background for depth 6 subtrees"
|
||||
:group 'dired-subtree-faces)
|
||||
|
||||
(defvar dired-subtree-overlays nil
|
||||
"Subtree overlays in this buffer.")
|
||||
(make-variable-buffer-local 'dired-subtree-overlays)
|
||||
|
||||
|
||||
;;; Overlay manipulation
|
||||
;; Maybe we should abstract the overlay-foo into some subtree
|
||||
;; functions instead!!!
|
||||
|
||||
(defun dired-subtree--remove-overlay (ov)
|
||||
"Remove dired-subtree overlay OV."
|
||||
(setq dired-subtree-overlays
|
||||
(--remove (equal it ov) dired-subtree-overlays))
|
||||
(delete-overlay ov))
|
||||
|
||||
(defun dired-subtree--remove-overlays (ovs)
|
||||
"Remove dired-subtree overlays OVS."
|
||||
(mapc 'dired-subtree--remove-overlay ovs))
|
||||
|
||||
(defun dired-subtree--cleanup-overlays ()
|
||||
"Remove the `nil' values from `dired-subtree-overlays'."
|
||||
(setq dired-subtree-overlays
|
||||
(--remove (not (overlay-buffer it)) dired-subtree-overlays)))
|
||||
|
||||
(defun dired-subtree--get-all-ovs ()
|
||||
"Get all dired-subtree overlays in this buffer."
|
||||
(--filter (overlay-get it 'dired-subtree-depth) (overlays-in (point-min) (point-max))))
|
||||
|
||||
(defun dired-subtree--get-all-ovs-at-point (&optional p)
|
||||
"Get all dired-subtree overlays at point P."
|
||||
(setq p (or p (point)))
|
||||
(--filter (overlay-get it 'dired-subtree-depth) (overlays-at (point))))
|
||||
|
||||
(defun dired-subtree--get-ovs-in (&optional beg end)
|
||||
"Get all dired-subtree overlays between BEG and END.
|
||||
|
||||
BEG and END default to the region spanned by overlay at point."
|
||||
(when (not beg)
|
||||
(let ((ov (dired-subtree--get-ov)))
|
||||
(setq beg (overlay-start ov))
|
||||
(setq end (overlay-end ov))))
|
||||
(--filter (and (overlay-get it 'dired-subtree-depth)
|
||||
(>= (overlay-start it) beg)
|
||||
(<= (overlay-end it) end))
|
||||
(overlays-in (point-min) (point-max))))
|
||||
|
||||
(defun dired-subtree--get-ov (&optional p)
|
||||
"Get the parent subtree overlay at point."
|
||||
(setq p (or p (point)))
|
||||
(car (--sort (> (overlay-get it 'dired-subtree-depth)
|
||||
(overlay-get other 'dired-subtree-depth))
|
||||
(dired-subtree--get-all-ovs-at-point p))))
|
||||
|
||||
(defun dired-subtree--get-depth (ov)
|
||||
"Get subtree depth."
|
||||
(or (and ov (overlay-get ov 'dired-subtree-depth)) 0))
|
||||
|
||||
|
||||
|
||||
;;; helpers
|
||||
(defvar dired-subtree-preserve-properties '(dired-subtree-filter)
|
||||
"Properties that should be preserved between read-ins.")
|
||||
|
||||
(defun dired-subtree--after-readin (&optional subtrees)
|
||||
"Insert the SUBTREES again after dired buffer has been reverted.
|
||||
|
||||
If no SUBTREES are specified, use `dired-subtree-overlays'."
|
||||
(-when-let (subtrees-to-process (or subtrees dired-subtree-overlays))
|
||||
(let* ((ovs-by-depth (--sort (< (car it) (car other))
|
||||
(--group-by (overlay-get it 'dired-subtree-depth)
|
||||
subtrees-to-process)))
|
||||
(sorted-ovs (--map (cons (car it)
|
||||
(--map (-cons* it
|
||||
(overlay-get it 'dired-subtree-name)
|
||||
(-map (lambda (x) (cons x (overlay-get it x)))
|
||||
dired-subtree-preserve-properties)) (cdr it)))
|
||||
ovs-by-depth)))
|
||||
;; (depth (path1 ov1 (prop1 . value1) (prop2 . value2)) (path2 ...))
|
||||
(--each sorted-ovs
|
||||
(--each (cdr it)
|
||||
(when (dired-utils-goto-line (cadr it))
|
||||
(dired-subtree--remove-overlay (car it))
|
||||
(dired-subtree-insert)
|
||||
(let ((ov (dired-subtree--get-ov)))
|
||||
(--each (cddr it)
|
||||
(overlay-put ov (car it) (cdr it)))
|
||||
(dired-subtree--filter-subtree ov))))))))
|
||||
|
||||
(defun dired-subtree--after-insert ()
|
||||
"After inserting the subtree, setup dired-details/dired-hide-details-mode."
|
||||
(if (fboundp 'dired-insert-set-properties)
|
||||
(let ((inhibit-read-only t)
|
||||
(ov (dired-subtree--get-ov)))
|
||||
(dired-insert-set-properties (overlay-start ov) (overlay-end ov)))
|
||||
(when (featurep 'dired-details)
|
||||
(dired-details-delete-overlays)
|
||||
(dired-details-activate))))
|
||||
|
||||
(add-hook 'dired-after-readin-hook 'dired-subtree--after-readin)
|
||||
|
||||
(add-hook 'dired-subtree-after-insert-hook 'dired-subtree--after-insert)
|
||||
|
||||
(defun dired-subtree--unmark ()
|
||||
"Unmark a file without moving point."
|
||||
(save-excursion (dired-unmark 1)))
|
||||
|
||||
(defun dired-subtree--dired-line-is-directory-or-link-p ()
|
||||
"Return non-nil if line under point is a directory or symlink"
|
||||
;; We've replaced `file-directory-p' with the regexp test to
|
||||
;; speed up filters over TRAMP. So long as dired/ls format
|
||||
;; doesn't change, we're good.
|
||||
;; 'd' for directories, 'l' for potential symlinks to directories.
|
||||
(save-excursion (beginning-of-line) (looking-at "..[dl]")))
|
||||
|
||||
(defun dired-subtree--is-expanded-p ()
|
||||
"Return non-nil if directory under point is expanded."
|
||||
(save-excursion
|
||||
(when (dired-utils-get-filename)
|
||||
(let ((depth (dired-subtree--get-depth (dired-subtree--get-ov))))
|
||||
(dired-next-line 1)
|
||||
(< depth (dired-subtree--get-depth (dired-subtree--get-ov)))))))
|
||||
|
||||
(defmacro dired-subtree-with-subtree (&rest forms)
|
||||
"Run FORMS on each file in this subtree."
|
||||
(declare (debug (body)))
|
||||
`(save-excursion
|
||||
(dired-subtree-beginning)
|
||||
,@forms
|
||||
(while (dired-subtree-next-sibling)
|
||||
,@forms)))
|
||||
|
||||
|
||||
;;;; Interactive
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-narrow ()
|
||||
"Narrow the buffer to this subtree."
|
||||
(interactive)
|
||||
(-when-let (ov (dired-subtree--get-ov))
|
||||
(narrow-to-region (overlay-start ov)
|
||||
(overlay-end ov))))
|
||||
|
||||
;;; Navigation
|
||||
|
||||
;; make the arguments actually do something
|
||||
;;;###autoload
|
||||
(defun dired-subtree-up (&optional arg)
|
||||
"Jump up one directory."
|
||||
(interactive "p")
|
||||
(-when-let (ov (dired-subtree--get-ov))
|
||||
(goto-char (overlay-start ov))
|
||||
(dired-previous-line 1)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-down (&optional arg)
|
||||
"Jump down one directory."
|
||||
(interactive "p")
|
||||
(-when-let* ((p (point))
|
||||
(ov (car (--sort
|
||||
(< (overlay-start it)
|
||||
(overlay-start other))
|
||||
(--remove
|
||||
(< (overlay-start it) p)
|
||||
(dired-subtree--get-all-ovs))))))
|
||||
(goto-char (overlay-start ov))
|
||||
(dired-move-to-filename)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-next-sibling (&optional arg)
|
||||
"Go to the next sibling."
|
||||
(interactive "p")
|
||||
(let ((current-ov (dired-subtree--get-ov)))
|
||||
(dired-next-line 1)
|
||||
(let ((new-ov (dired-subtree--get-ov)))
|
||||
(cond
|
||||
((not (dired-utils-is-file-p))
|
||||
nil)
|
||||
((< (dired-subtree--get-depth current-ov)
|
||||
(dired-subtree--get-depth new-ov))
|
||||
(goto-char (overlay-end new-ov))
|
||||
(dired-move-to-filename)
|
||||
t)
|
||||
((> (dired-subtree--get-depth current-ov)
|
||||
(dired-subtree--get-depth new-ov))
|
||||
;; add option to either go to top or stay at the end
|
||||
(dired-previous-line 1)
|
||||
nil)
|
||||
(t t)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-previous-sibling (&optional arg)
|
||||
"Go to the previous sibling."
|
||||
(interactive "p")
|
||||
(let ((current-ov (dired-subtree--get-ov)))
|
||||
(dired-previous-line 1)
|
||||
(let ((new-ov (dired-subtree--get-ov)))
|
||||
(cond
|
||||
;; this will need better handlign if we have inserted
|
||||
;; subdirectories
|
||||
((not (dired-utils-is-file-p))
|
||||
nil)
|
||||
((< (dired-subtree--get-depth current-ov)
|
||||
(dired-subtree--get-depth new-ov))
|
||||
(goto-char (overlay-start new-ov))
|
||||
(dired-previous-line 1)
|
||||
t)
|
||||
((> (dired-subtree--get-depth current-ov)
|
||||
(dired-subtree--get-depth new-ov))
|
||||
;; add option to either go to top or stay at the end
|
||||
(dired-next-line 1)
|
||||
nil)
|
||||
(t t)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-beginning ()
|
||||
"Go to the first file in this subtree."
|
||||
(interactive)
|
||||
(let ((ov (dired-subtree--get-ov)))
|
||||
(if (not ov)
|
||||
;; do something when not in subtree
|
||||
t
|
||||
(goto-char (overlay-start ov))
|
||||
(dired-move-to-filename))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-end ()
|
||||
"Go to the first file in this subtree."
|
||||
(interactive)
|
||||
(let ((ov (dired-subtree--get-ov)))
|
||||
(if (not ov)
|
||||
;; do something when not in subtree
|
||||
t
|
||||
(goto-char (overlay-end ov))
|
||||
(dired-previous-line 1))))
|
||||
|
||||
;;; Marking
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-mark-subtree (&optional all)
|
||||
"Mark all files in this subtree.
|
||||
|
||||
With prefix argument mark all the files in subdirectories
|
||||
recursively."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(if all
|
||||
(let ((beg (save-excursion
|
||||
(dired-subtree-beginning)
|
||||
(point)))
|
||||
(end (save-excursion
|
||||
(dired-subtree-end)
|
||||
(point))))
|
||||
(dired-mark-files-in-region
|
||||
(progn (goto-char beg) (line-beginning-position))
|
||||
(progn (goto-char end) (line-end-position))))
|
||||
(dired-subtree-beginning)
|
||||
(save-excursion (dired-mark 1))
|
||||
(while (dired-subtree-next-sibling)
|
||||
(save-excursion (dired-mark 1))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-unmark-subtree (&optional all)
|
||||
"Unmark all files in this subtree.
|
||||
|
||||
With prefix argument unmark all the files in subdirectories
|
||||
recursively."
|
||||
(interactive)
|
||||
(let ((dired-marker-char ? ))
|
||||
(dired-subtree-mark-subtree all)))
|
||||
|
||||
;;; Insertion/deletion
|
||||
;;;###autoload
|
||||
(defun dired-subtree-revert ()
|
||||
"Revert the subtree.
|
||||
|
||||
This means reinserting the content of this subtree and all its
|
||||
children."
|
||||
(interactive)
|
||||
(let ((inhibit-read-only t)
|
||||
(file-name (dired-utils-get-filename)))
|
||||
(-when-let* ((ov (dired-subtree--get-ov))
|
||||
(ovs (dired-subtree--get-ovs-in)))
|
||||
(dired-subtree-up)
|
||||
(delete-region (overlay-start ov) (overlay-end ov))
|
||||
(dired-subtree--after-readin ovs)
|
||||
(when file-name
|
||||
(dired-utils-goto-line file-name)))))
|
||||
|
||||
(defun dired-subtree--readin (dir-name)
|
||||
"Read in the directory.
|
||||
|
||||
Return a string suitable for insertion in `dired' buffer."
|
||||
(with-temp-buffer
|
||||
(insert-directory dir-name dired-listing-switches nil t)
|
||||
(delete-char -1)
|
||||
(goto-char (point-min))
|
||||
(delete-region
|
||||
(progn (beginning-of-line) (point))
|
||||
(progn (forward-line
|
||||
(if (save-excursion
|
||||
(forward-line 1)
|
||||
(end-of-line)
|
||||
(looking-back "\\."))
|
||||
3 1)) (point)))
|
||||
(insert " ")
|
||||
(while (= (forward-line) 0)
|
||||
(insert " "))
|
||||
(delete-char -2)
|
||||
(buffer-string)))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-insert ()
|
||||
"Insert subtree under this directory."
|
||||
(interactive)
|
||||
(when (and (dired-subtree--dired-line-is-directory-or-link-p)
|
||||
(not (dired-subtree--is-expanded-p)))
|
||||
(let* ((dir-name (dired-get-filename nil))
|
||||
(listing (dired-subtree--readin (file-name-as-directory dir-name)))
|
||||
beg end)
|
||||
(read-only-mode -1)
|
||||
(move-end-of-line 1)
|
||||
;; this is pretty ugly, I'm sure it can be done better
|
||||
(save-excursion
|
||||
(insert listing)
|
||||
(setq end (+ (point) 2)))
|
||||
(newline)
|
||||
(setq beg (point))
|
||||
(let ((inhibit-read-only t))
|
||||
(remove-text-properties (1- beg) beg '(dired-filename)))
|
||||
(let* ((ov (make-overlay beg end))
|
||||
(parent (dired-subtree--get-ov (1- beg)))
|
||||
(depth (or (and parent (1+ (overlay-get parent 'dired-subtree-depth)))
|
||||
1))
|
||||
(face (intern (format "dired-subtree-depth-%d-face" depth))))
|
||||
(when dired-subtree-use-backgrounds
|
||||
(overlay-put ov 'face face))
|
||||
;; refactor this to some function
|
||||
(overlay-put ov 'line-prefix
|
||||
(if (stringp dired-subtree-line-prefix)
|
||||
(if (not dired-subtree-use-backgrounds)
|
||||
(apply 'concat (-repeat depth dired-subtree-line-prefix))
|
||||
(cond
|
||||
((eq nil dired-subtree-line-prefix-face)
|
||||
(apply 'concat
|
||||
(-repeat depth dired-subtree-line-prefix)))
|
||||
((eq 'subtree dired-subtree-line-prefix-face)
|
||||
(concat
|
||||
dired-subtree-line-prefix
|
||||
(propertize
|
||||
(apply 'concat
|
||||
(-repeat (1- depth) dired-subtree-line-prefix))
|
||||
'face face)))
|
||||
((eq 'parents dired-subtree-line-prefix-face)
|
||||
(concat
|
||||
dired-subtree-line-prefix
|
||||
(apply 'concat
|
||||
(--map
|
||||
(propertize dired-subtree-line-prefix
|
||||
'face
|
||||
(intern (format "dired-subtree-depth-%d-face" it)))
|
||||
(number-sequence 1 (1- depth))))))))
|
||||
(funcall dired-subtree-line-prefix depth)))
|
||||
(overlay-put ov 'dired-subtree-name dir-name)
|
||||
(overlay-put ov 'dired-subtree-parent parent)
|
||||
(overlay-put ov 'dired-subtree-depth depth)
|
||||
(overlay-put ov 'evaporate t)
|
||||
(push ov dired-subtree-overlays))
|
||||
(goto-char beg)
|
||||
(dired-move-to-filename)
|
||||
(read-only-mode 1)
|
||||
(when (bound-and-true-p dired-filter-mode) (dired-filter-mode 1))
|
||||
(run-hooks 'dired-subtree-after-insert-hook))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-remove ()
|
||||
"Remove subtree at point."
|
||||
(interactive)
|
||||
(-when-let* ((ov (dired-subtree--get-ov))
|
||||
(ovs (dired-subtree--get-ovs-in
|
||||
(overlay-start ov)
|
||||
(overlay-end ov))))
|
||||
(let ((inhibit-read-only t))
|
||||
(dired-subtree-up)
|
||||
(delete-region (overlay-start ov)
|
||||
(overlay-end ov))
|
||||
(dired-subtree--remove-overlays ovs)))
|
||||
(run-hooks 'dired-subtree-after-remove-hook))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-toggle ()
|
||||
"Insert subtree at point or remove it if it was not present."
|
||||
(interactive)
|
||||
(if (dired-subtree--is-expanded-p)
|
||||
(progn
|
||||
(dired-next-line 1)
|
||||
(dired-subtree-remove)
|
||||
;; #175 fixes the case of the first line in dired when the
|
||||
;; cursor jumps to the header in dired rather then to the
|
||||
;; first file in buffer
|
||||
(when (bobp)
|
||||
(dired-next-line 1)))
|
||||
(save-excursion (dired-subtree-insert))))
|
||||
|
||||
(defun dired-subtree--insert-recursive (depth max-depth)
|
||||
"Insert full subtree at point."
|
||||
(save-excursion
|
||||
(let ((name (dired-get-filename nil t)))
|
||||
(when (and name (file-directory-p name)
|
||||
(<= depth (or max-depth depth))
|
||||
(or (= 1 depth)
|
||||
(not (string-match-p dired-subtree-ignored-regexp
|
||||
(file-name-nondirectory name)))))
|
||||
(if (dired-subtree--is-expanded-p)
|
||||
(dired-next-line 1)
|
||||
(dired-subtree-insert))
|
||||
(dired-subtree-end)
|
||||
(dired-subtree--insert-recursive (1+ depth) max-depth)
|
||||
(while (dired-subtree-previous-sibling)
|
||||
(dired-subtree--insert-recursive (1+ depth) max-depth))))))
|
||||
|
||||
(defvar dired-subtree--cycle-previous nil
|
||||
"Remember previous action for `dired-subtree-cycle'")
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-cycle (&optional max-depth)
|
||||
"Org-mode like cycle visibility:
|
||||
|
||||
1) Show subtree
|
||||
2) Show subtree recursively (if previous command was cycle)
|
||||
3) Remove subtree
|
||||
|
||||
Numeric prefix will set max depth"
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
(cond
|
||||
;; prefix - show subtrees up to max-depth
|
||||
(max-depth
|
||||
(when (dired-subtree--is-expanded-p)
|
||||
(dired-next-line 1)
|
||||
(dired-subtree-remove))
|
||||
(dired-subtree--insert-recursive 1 (if (integerp max-depth) max-depth nil))
|
||||
(setq dired-subtree--cycle-previous :full))
|
||||
;; if directory is not expanded, expand one level
|
||||
((not (dired-subtree--is-expanded-p))
|
||||
(dired-subtree-insert)
|
||||
(setq dired-subtree--cycle-previous :insert))
|
||||
;; hide if previous command was not cycle or tree was fully expanded
|
||||
((or (not (eq last-command 'dired-subtree-cycle))
|
||||
(eq dired-subtree--cycle-previous :full))
|
||||
(dired-next-line 1)
|
||||
(dired-subtree-remove)
|
||||
(setq dired-subtree--cycle-previous :remove))
|
||||
(t
|
||||
(dired-subtree--insert-recursive 1 dired-subtree-cycle-depth)
|
||||
(setq dired-subtree--cycle-previous :full)))))
|
||||
|
||||
(defun dired-subtree--filter-up (keep-dir kill-siblings)
|
||||
(save-excursion
|
||||
(let (ov)
|
||||
(save-excursion
|
||||
(while (dired-subtree-up))
|
||||
(dired-next-line 1)
|
||||
(dired-subtree-mark-subtree t))
|
||||
(if keep-dir
|
||||
(dired-subtree-unmark-subtree)
|
||||
(dired-subtree--unmark))
|
||||
(while (and (dired-subtree-up)
|
||||
(> (dired-subtree--get-depth (dired-subtree--get-ov)) 0))
|
||||
(if (not kill-siblings)
|
||||
(dired-subtree--unmark)
|
||||
(dired-subtree--unmark)
|
||||
(let ((here (point)))
|
||||
(dired-subtree-with-subtree
|
||||
(when (and (dired-subtree--is-expanded-p)
|
||||
(/= (point) here))
|
||||
(dired-subtree--unmark)
|
||||
(save-excursion
|
||||
(dired-next-line 1)
|
||||
(dired-subtree-unmark-subtree t)))))))
|
||||
(dired-do-kill-lines)
|
||||
(dired-subtree--cleanup-overlays))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-only-this-file (&optional arg)
|
||||
"Remove all the siblings on the route from this file to the top-most directory.
|
||||
|
||||
With ARG non-nil, do not remove expanded directories in parents."
|
||||
(interactive "P")
|
||||
(dired-subtree--filter-up nil arg))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-only-this-directory (&optional arg)
|
||||
"Remove all the siblings on the route from this directory to the top-most directory.
|
||||
|
||||
With ARG non-nil, do not remove expanded directories in parents."
|
||||
(interactive "P")
|
||||
(dired-subtree--filter-up t arg))
|
||||
|
||||
;;; filtering
|
||||
(defun dired-subtree--filter-update-bs (ov)
|
||||
"Update the local filter list.
|
||||
|
||||
This function assumes that `dired-filter-stack' is dynamically
|
||||
bound to relevant value."
|
||||
(let* ((filt (dired-filter--describe-filters))
|
||||
(before-str (if (equal filt "") nil (concat " Local filters: " filt "\n"))))
|
||||
(overlay-put ov 'before-string before-str)))
|
||||
|
||||
(defun dired-subtree--filter-subtree (ov)
|
||||
"Run the filter for this subtree.
|
||||
|
||||
It is only safe to call this from readin.
|
||||
|
||||
This depends on `dired-filter' package."
|
||||
(when (featurep 'dired-filter)
|
||||
(let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter)))
|
||||
(save-restriction
|
||||
(widen)
|
||||
(dired-subtree-narrow)
|
||||
(dired-filter--expunge)
|
||||
(dired-subtree--filter-update-bs ov)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun dired-subtree-apply-filter ()
|
||||
"Push a local filter for this subtree.
|
||||
|
||||
This depends on `dired-filter' package.
|
||||
|
||||
It works exactly the same as global dired filters, only
|
||||
restricted to a subtree. The global filter is also applied to
|
||||
the subtree. The filter action is read from `dired-filter-map'."
|
||||
(interactive)
|
||||
(when (featurep 'dired-filter)
|
||||
(-when-let (ov (dired-subtree--get-ov))
|
||||
(let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter))
|
||||
(glob (current-global-map))
|
||||
(loc (current-local-map))
|
||||
cmd)
|
||||
(cl-flet ((dired-filter--update
|
||||
()
|
||||
(save-restriction
|
||||
(overlay-put ov 'dired-subtree-filter dired-filter-stack)
|
||||
(widen)
|
||||
(dired-subtree-revert)
|
||||
(dired-subtree--filter-update-bs ov))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(use-global-map dired-filter-map)
|
||||
(use-local-map nil)
|
||||
(setq cmd (key-binding (read-key-sequence "Choose filter action: "))))
|
||||
(use-global-map glob)
|
||||
(use-local-map loc))
|
||||
(let ((p (point))
|
||||
(beg (overlay-start ov))
|
||||
(current-file (dired-utils-get-filename)))
|
||||
(unwind-protect
|
||||
(call-interactively cmd)
|
||||
(unless (dired-utils-goto-line current-file)
|
||||
(goto-char beg)
|
||||
(forward-line)
|
||||
(goto-char (min p (1- (overlay-end (dired-subtree--get-ov)))))
|
||||
(dired-move-to-filename)))))))))
|
||||
|
||||
|
||||
;;; Here we redefine a couple of functions from dired.el to make them
|
||||
;;; subtree-aware
|
||||
|
||||
;; If the point is in a subtree, we need to provide a proper
|
||||
;; directory, not the one that would come from `dired-subdir-alist'.
|
||||
(defun dired-current-directory (&optional localp)
|
||||
"Return the name of the subdirectory to which this line belongs.
|
||||
This returns a string with trailing slash, like `default-directory'.
|
||||
Optional argument means return a file name relative to `default-directory'."
|
||||
(let ((here (point))
|
||||
(alist (or dired-subdir-alist
|
||||
;; probably because called in a non-dired buffer
|
||||
(error "No subdir-alist in %s" (current-buffer))))
|
||||
elt dir)
|
||||
(while alist
|
||||
(setq elt (car alist)
|
||||
dir (car elt)
|
||||
;; use `<=' (not `<') as subdir line is part of subdir
|
||||
alist (if (<= (dired-get-subdir-min elt) here)
|
||||
nil ; found
|
||||
(cdr alist))))
|
||||
;; dired-subdir: modify dir here if we are in a "subtree" view
|
||||
(-when-let (parent (dired-subtree--get-ov))
|
||||
(setq dir (concat (overlay-get parent 'dired-subtree-name) "/")))
|
||||
;; end
|
||||
(if localp
|
||||
(dired-make-relative dir default-directory)
|
||||
dir)))
|
||||
|
||||
;; Since the tree-inserted directory is not in the dired-subdir-alist,
|
||||
;; we need to guard against nil.
|
||||
(defun dired-get-subdir ()
|
||||
;;"Return the subdir name on this line, or nil if not on a headerline."
|
||||
;; Look up in the alist whether this is a headerline.
|
||||
(save-excursion
|
||||
(let ((cur-dir (dired-current-directory)))
|
||||
(beginning-of-line) ; alist stores b-o-l positions
|
||||
(and (zerop (- (point)
|
||||
(or (dired-get-subdir-min
|
||||
(assoc cur-dir
|
||||
dired-subdir-alist))
|
||||
0))) ;; dired-subtree: return zero if current
|
||||
;; dir is not in `dired-subdir-alist'.
|
||||
cur-dir))))
|
||||
|
||||
(provide 'dired-subtree)
|
||||
|
||||
;;; dired-subtree.el ends here
|
||||
@ -33,7 +33,7 @@
|
||||
(t
|
||||
(force-indent-line)))))
|
||||
|
||||
(defun un-indent-line ()
|
||||
(defun unindent-line ()
|
||||
(interactive)
|
||||
(let (col)
|
||||
(save-excursion
|
||||
@ -51,13 +51,13 @@
|
||||
(force-indent-line))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun un-indent-region (start stop)
|
||||
(defun unindent-region (start stop)
|
||||
(interactive "r")
|
||||
(setq stop (copy-marker stop))
|
||||
(goto-char start)
|
||||
(while (< (point) stop)
|
||||
(unless (and (bolp) (eolp))
|
||||
(un-indent-line))
|
||||
(unindent-line))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun ld-indent ()
|
||||
@ -68,13 +68,13 @@
|
||||
(setq deactivate-mark nil))
|
||||
(indent-line)))
|
||||
|
||||
(defun ld-un-indent ()
|
||||
(defun ld-unindent ()
|
||||
(interactive)
|
||||
(if (use-region-p)
|
||||
(save-excursion
|
||||
(un-indent-region (region-beginning) (region-end))
|
||||
(unindent-region (region-beginning) (region-end))
|
||||
(setq deactivate-mark nil))
|
||||
(un-indent-line)))
|
||||
(unindent-line)))
|
||||
|
||||
(provide 'force-indent)
|
||||
|
||||
|
||||
@ -1,141 +0,0 @@
|
||||
;;; goto-last-change.el --- Move point through buffer-undo-list positions
|
||||
|
||||
;; Copyright © 2003 Kevin Rodgers
|
||||
|
||||
;; Author: Kevin Rodgers <ihs_4664@yahoo.com>
|
||||
;; Created: 17 Jun 2003
|
||||
;; Version: $Revision: 1.2 $
|
||||
;; Keywords: convenience
|
||||
;; RCS: $Id: goto-last-change.el,v 1.2 2003/07/30 17:43:47 kevinr Exp kevinr $
|
||||
|
||||
;; Contributors:
|
||||
;; Attila Lendvai <attila.lendvai@gmail.com> (line distance and auto marks)
|
||||
|
||||
;; 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., 59 Temple Place, Suite 330, Boston,
|
||||
;; MA 02111-1307 USA
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; After installing goto-last-change.el in a `load-path' directory and
|
||||
;; compiling it with `M-x byte-compile-file', load it with
|
||||
;; (require 'goto-last-change)
|
||||
;; or autoload it with
|
||||
;; (autoload 'goto-last-change "goto-last-change"
|
||||
;; "Set point to the position of the last change." t)
|
||||
;;
|
||||
;; You may also want to bind a key to `M-x goto-last-change', e.g.
|
||||
;; (global-set-key "\C-x\C-\\" 'goto-last-change)
|
||||
|
||||
;; goto-last-change.el was written in response to to the following:
|
||||
;;
|
||||
;; From: Dan Jacobson <jidanni@jidanni.org>
|
||||
;; Newsgroups: gnu.emacs.bug
|
||||
;; Subject: function to go to spot of last change
|
||||
;; Date: Sun, 15 Jun 2003 00:15:08 +0000 (UTC)
|
||||
;; Sender: news <news@main.gmane.org>
|
||||
;; Message-ID: <mailman.7910.1055637181.21513.bug-gnu-emacs@gnu.org>
|
||||
;; NNTP-Posting-Host: monty-python.gnu.org
|
||||
;;
|
||||
;;
|
||||
;; Why of course, a function to get the user to the spot of last changes
|
||||
;; in the current buffer(s?), that's what emacs must lack.
|
||||
;;
|
||||
;; How many times have you found yourself mosying [<-not in spell
|
||||
;; checker!?] thru a file when you wonder, where the heck was I just
|
||||
;; editing? Well, the best you can do is hit undo, ^F, and undo again,
|
||||
;; to get back. Hence the "burning need" for the additional function,
|
||||
;; which you might name the-jacobson-memorial-function, due to its brilliance.
|
||||
;; --
|
||||
;; http://jidanni.org/ Taiwan(04)25854780
|
||||
|
||||
;;; Code:
|
||||
(provide 'goto-last-change)
|
||||
|
||||
(or (fboundp 'last) ; Emacs 20
|
||||
(require 'cl)) ; Emacs 19
|
||||
|
||||
(defvar goto-last-change-undo nil
|
||||
"The `buffer-undo-list' entry of the previous \\[goto-last-change] command.")
|
||||
(make-variable-buffer-local 'goto-last-change-undo)
|
||||
|
||||
;;;###autoload
|
||||
(defun goto-last-change (&optional mark-point minimal-line-distance)
|
||||
"Set point to the position of the last change.
|
||||
Consecutive calls set point to the position of the previous change.
|
||||
With a prefix arg (optional arg MARK-POINT non-nil), set mark so \
|
||||
\\[exchange-point-and-mark]
|
||||
will return point to the current position."
|
||||
(interactive "P")
|
||||
;; (unless (buffer-modified-p)
|
||||
;; (error "Buffer not modified"))
|
||||
(when (eq buffer-undo-list t)
|
||||
(error "No undo information in this buffer"))
|
||||
(when mark-point
|
||||
(push-mark))
|
||||
(unless minimal-line-distance
|
||||
(setq minimal-line-distance 10))
|
||||
(let ((position nil)
|
||||
(undo-list (if (and (eq this-command last-command)
|
||||
goto-last-change-undo)
|
||||
(cdr (memq goto-last-change-undo buffer-undo-list))
|
||||
buffer-undo-list))
|
||||
undo)
|
||||
(while (and undo-list
|
||||
(or (not position)
|
||||
(eql position (point))
|
||||
(and minimal-line-distance
|
||||
;; The first invocation always goes to the last change, subsequent ones skip
|
||||
;; changes closer to (point) then minimal-line-distance.
|
||||
(memq last-command '(goto-last-change
|
||||
goto-last-change-with-auto-marks))
|
||||
(< (count-lines (min position (point-max)) (point))
|
||||
minimal-line-distance))))
|
||||
(setq undo (car undo-list))
|
||||
(cond ((and (consp undo) (integerp (car undo)) (integerp (cdr undo)))
|
||||
;; (BEG . END)
|
||||
(setq position (cdr undo)))
|
||||
((and (consp undo) (stringp (car undo))) ; (TEXT . POSITION)
|
||||
(setq position (abs (cdr undo))))
|
||||
((and (consp undo) (eq (car undo) t))) ; (t HIGH . LOW)
|
||||
((and (consp undo) (null (car undo)))
|
||||
;; (nil PROPERTY VALUE BEG . END)
|
||||
(setq position (cdr (last undo))))
|
||||
((and (consp undo) (markerp (car undo)))) ; (MARKER . DISTANCE)
|
||||
((integerp undo)) ; POSITION
|
||||
((null undo)) ; nil
|
||||
(t (error "Invalid undo entry: %s" undo)))
|
||||
(setq undo-list (cdr undo-list)))
|
||||
(cond (position
|
||||
(setq goto-last-change-undo undo)
|
||||
(goto-char (min position (point-max))))
|
||||
((and (eq this-command last-command)
|
||||
goto-last-change-undo)
|
||||
(setq goto-last-change-undo nil)
|
||||
(error "No further undo information"))
|
||||
(t
|
||||
(setq goto-last-change-undo nil)
|
||||
(error "Buffer not modified")))))
|
||||
|
||||
(defun goto-last-change-with-auto-marks (&optional minimal-line-distance)
|
||||
"Calls goto-last-change and sets the mark at only the first invocations
|
||||
in a sequence of invocations."
|
||||
(interactive "P")
|
||||
(goto-last-change (not (or (eq last-command 'goto-last-change-with-auto-marks)
|
||||
(eq last-command t)))
|
||||
minimal-line-distance))
|
||||
|
||||
;; (global-set-key "\C-x\C-\\" 'goto-last-change)
|
||||
|
||||
;;; goto-last-change.el ends here
|
||||
@ -90,8 +90,8 @@
|
||||
(setq jumped (read-number
|
||||
(let ((lines (line-number-at-pos (point-max))))
|
||||
(format (if goto-line-preview--relative-p
|
||||
"[%d] Goto line relative: (%d to %d) "
|
||||
"[%d] Goto line: (%d to %d) ")
|
||||
"[%d] Goto line preview relative: (%d to %d) "
|
||||
"[%d] Goto line preview: (%d to %d) ")
|
||||
goto-line-preview--prev-line-num
|
||||
(max 0 (min 1 lines))
|
||||
lines))))
|
||||
|
||||
2272
site-lisp/extensions-local/jsonian.el
Normal file
2272
site-lisp/extensions-local/jsonian.el
Normal file
File diff suppressed because it is too large
Load Diff
@ -1,38 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'subword)
|
||||
|
||||
;;; Code:
|
||||
(defun ld-delete-one-block-forward ()
|
||||
(interactive)
|
||||
(if (eobp)
|
||||
(message "End of buffer")
|
||||
(let* ((syntax-move-point
|
||||
(save-excursion
|
||||
(skip-syntax-forward (string (char-syntax (char-after))))
|
||||
(point)
|
||||
))
|
||||
(subword-move-point
|
||||
(save-excursion
|
||||
(subword-forward)
|
||||
(point))))
|
||||
(kill-region (point) (min syntax-move-point subword-move-point)))))
|
||||
|
||||
(defun ld-delete-one-block-backward ()
|
||||
(interactive)
|
||||
(if (bobp)
|
||||
(message "Beginning of buffer")
|
||||
(let* ((syntax-move-point
|
||||
(save-excursion
|
||||
(skip-syntax-backward (string (char-syntax (char-before))))
|
||||
(point)
|
||||
))
|
||||
(subword-move-point
|
||||
(save-excursion
|
||||
(subword-backward)
|
||||
(point))))
|
||||
(kill-region (point) (max syntax-move-point subword-move-point)))))
|
||||
|
||||
(provide 'ld-delete-block)
|
||||
|
||||
;;; ld-delete-block.el ends here
|
||||
@ -6,10 +6,16 @@
|
||||
"Automatic format current buffer."
|
||||
(interactive)
|
||||
(cond
|
||||
;; judge by mode
|
||||
((derived-mode-p 'python-mode)
|
||||
(message "Don't indent python buffer. It will mess up the code syntax."))
|
||||
((derived-mode-p 'yaml-mode)
|
||||
(message "Don't indent yaml buffer. It will mess up the code syntax."))
|
||||
;; judge by buffer name
|
||||
((string-suffix-p ".yml" (buffer-name) t)
|
||||
(message "Don't indent yaml buffer. It will mess up the code syntax."))
|
||||
((string-suffix-p ".yaml" (buffer-name) t)
|
||||
(message "Don't indent yaml buffer. It will mess up the code syntax."))
|
||||
(t
|
||||
(save-excursion
|
||||
(indent-region (point-min) (point-max) nil)
|
||||
@ -67,6 +73,15 @@
|
||||
(switch-to-buffer current-element)
|
||||
(deactivate-mark)))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-find-file-in-root (file)
|
||||
"Find file with root."
|
||||
(interactive "fFind file as sudo: ")
|
||||
(require 'tramp)
|
||||
(tramp-cleanup-all-connections)
|
||||
(find-file (concat "/sudo:root@localhost:" file)))
|
||||
|
||||
(provide 'ld-buffer-operations)
|
||||
|
||||
;;; ld-buffer-operations.el ends here
|
||||
@ -1,14 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defun ld-find-file-in-root (file)
|
||||
"Find file with root."
|
||||
(interactive "fFind file as sudo: ")
|
||||
(require 'tramp)
|
||||
(tramp-cleanup-all-connections)
|
||||
(find-file (concat "/sudo:root@localhost:" file)))
|
||||
|
||||
(provide 'ld-file-operations)
|
||||
|
||||
;;; ld-file-operations.el ends here
|
||||
@ -1,39 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defvar ld-cursor-position-stack nil
|
||||
"Cursor position stack.")
|
||||
|
||||
(defun ld-cursor-position-1-store ()
|
||||
"Remember current position and setup."
|
||||
(interactive)
|
||||
(point-to-register 8)
|
||||
(message "Have remember one position"))
|
||||
|
||||
(defun ld-cursor-position-1-jump ()
|
||||
"Jump to latest position and setup."
|
||||
(interactive)
|
||||
(let ((tmp (point-marker)))
|
||||
(jump-to-register 8)
|
||||
(set-register 8 tmp))
|
||||
(message "Have back to remember position"))
|
||||
|
||||
(defun ld-cursor-position-stack-push ()
|
||||
"Push current point in stack."
|
||||
(interactive)
|
||||
(message "Location marked.")
|
||||
(setq ld-cursor-position-stack (cons (list (current-buffer) (point)) ld-cursor-position-stack)))
|
||||
|
||||
(defun ld-cursor-position-stack-pop ()
|
||||
"Pop point from stack."
|
||||
(interactive)
|
||||
(if (null ld-cursor-position-stack)
|
||||
(message "Stack is empty.")
|
||||
(switch-to-buffer (caar ld-cursor-position-stack))
|
||||
(goto-char (cadar ld-cursor-position-stack))
|
||||
(setq ld-cursor-position-stack (cdr ld-cursor-position-stack))))
|
||||
|
||||
(provide 'ld-goto-cursor-stack)
|
||||
|
||||
;;; ld-goto-cursor-stack.el ends here
|
||||
@ -1,22 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defvar ld-toggle-one-window-config-of-window nil
|
||||
"The window configuration used for `toggle-one-window'.")
|
||||
|
||||
(defun ld-toggle-one-window ()
|
||||
"Toggle between window layout and one window."
|
||||
(interactive)
|
||||
(if (equal (length (cl-remove-if #'window-dedicated-p (window-list))) 1)
|
||||
(if toggle-one-window-config-of-window
|
||||
(progn
|
||||
(set-window-configuration toggle-one-window-config-of-window)
|
||||
(setq toggle-one-window-config-of-window nil))
|
||||
(message "No other windows exist."))
|
||||
(setq toggle-one-window-config-of-window (current-window-configuration))
|
||||
(delete-other-windows)))
|
||||
|
||||
(provide 'ld-toggle-one-window)
|
||||
|
||||
;;; ld-toggle-one-window.el ends here
|
||||
10422
site-lisp/extensions-local/markdown-mode.el
Normal file
10422
site-lisp/extensions-local/markdown-mode.el
Normal file
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
361
site-lisp/extensions-local/outline-toc.el
Normal file
361
site-lisp/extensions-local/outline-toc.el
Normal file
@ -0,0 +1,361 @@
|
||||
;;; outline-toc.el --- Sidebar showing a "table of contents".
|
||||
|
||||
;; Copyright (C) 2017 Austin Bingham
|
||||
|
||||
;; Author: Austin Bingham <austin.bingham@gmail.com>
|
||||
;; Keywords: convenience outlines
|
||||
;; URL: https://github.com/abingham/outline-toc.el
|
||||
;; Version: 0.1
|
||||
|
||||
;; This file is not part of GNU Emacs.
|
||||
|
||||
;;; License:
|
||||
;;
|
||||
;; Permission is hereby granted, free of charge, to any person
|
||||
;; obtaining a copy of this software and associated documentation
|
||||
;; files (the "Software"), to deal in the Software without
|
||||
;; restriction, including without limitation the rights to use, copy,
|
||||
;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;; of the Software, and to permit persons to whom the Software is
|
||||
;; furnished to do so, subject to the following conditions:
|
||||
;;
|
||||
;; The above copyright notice and this permission notice shall be
|
||||
;; included in all copies or substantial portions of the Software.
|
||||
;;
|
||||
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
|
||||
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
|
||||
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||||
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
;; SOFTWARE.
|
||||
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This provides a sidebar buffer which shows a "table of
|
||||
;; contents" for an associated outline-mode buffer. Basically,
|
||||
;; this shows you the sections of the outline-mode buffer, but
|
||||
;; not the bodies. This is to help you remember where you are in
|
||||
;; a large document.
|
||||
|
||||
;; Simply use M-x outline-toc-mode to toggle activation of the
|
||||
;; outline-toc. Use 'M-x customize-group RET outline-toc RET' to
|
||||
;; adapt outline-toc to your needs.
|
||||
|
||||
;; Much of this was originally adapated from David Engster's
|
||||
;; excellent minimap.el (https://github.com/dengste/minimap).
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'outline)
|
||||
|
||||
(defgroup outline-toc nil
|
||||
"A outline-toc sidebar."
|
||||
:group 'convenience)
|
||||
|
||||
(defface outline-toc-font-face nil
|
||||
"Face used for text in outline-toc 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 outline-toc to avoid problems with recentering."
|
||||
:group 'outline-toc)
|
||||
|
||||
(defface outline-toc-current-section
|
||||
'((t (:inherit highlight)))
|
||||
"Face for the current line in the TOC."
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-width-fraction 0.15
|
||||
"Fraction of width which should be used for outline-toc sidebar."
|
||||
:type 'number
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-minimum-width 30
|
||||
"Minimum width of outline-toc in characters (default size).
|
||||
Use nil to disable."
|
||||
:type 'number
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-window-location 'left
|
||||
"Location of the outline-toc window.
|
||||
Can be either the symbol `left' or `right'."
|
||||
:type '(choice (const :tag "Left" left)
|
||||
(const :tag "Right" right))
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-buffer-name " *OUTLINE-TOC*"
|
||||
"Buffer name of outline-toc sidebar."
|
||||
:type 'string
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-update-delay 0.1
|
||||
"Delay in seconds after which sidebar gets updated.
|
||||
Setting this to 0 will let the outline-toc react immediately, but
|
||||
this will slow down scrolling."
|
||||
:type 'number
|
||||
:set (lambda (sym value)
|
||||
(set sym value)
|
||||
(when (and (boundp 'outline-toc--timer-object)
|
||||
outline-toc--timer-object)
|
||||
(cancel-timer outline-toc--timer-object)
|
||||
(setq outline-toc--timer-object
|
||||
(run-with-idle-timer
|
||||
outline-toc-update-delay t 'outline-toc--update))))
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-hide-scroll-bar t
|
||||
"Whether the outline-toc should hide the vertical scrollbar."
|
||||
:type 'boolean
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-hide-fringes nil
|
||||
"Whether the outline-toc should hide the fringes."
|
||||
:type 'boolean
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-dedicated-window t
|
||||
"Whether the outline-toc should create a dedicated window."
|
||||
:type 'boolean
|
||||
:group 'outline-toc)
|
||||
|
||||
;; TODO: How do we specify "for all outline-mode" docs? Outline-mode is minor, I think...
|
||||
(defcustom outline-toc-major-modes '(markdown-mode org-mode outline-mode rst-mode)
|
||||
"Major modes for which a outline-toc should be created.
|
||||
This can also be a parent mode like 'prog-mode.
|
||||
If nil, a outline-toc must be explicitly created for each buffer."
|
||||
:type '(repeat symbol)
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-recreate-window t
|
||||
"Whether the outline-toc window should be automatically re-created.
|
||||
If this is non-nil, the side window for the outline-toc will be
|
||||
automatically re-created as soon as you kill it."
|
||||
:type 'boolean
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-automatically-delete-window t
|
||||
"Whether the outline-toc window should be automatically deleted.
|
||||
Setting this to non-nil will delete the minibuffer side window
|
||||
when you enter a buffer which is not derived from
|
||||
`outline-toc-major-modes' (excluding the minibuffer)."
|
||||
:type 'boolean
|
||||
:group 'outline-toc)
|
||||
|
||||
(defcustom outline-toc-highlight-line t
|
||||
"Whether the outline-toc should highlight the current line."
|
||||
:type 'boolean
|
||||
:group 'outline-toc)
|
||||
|
||||
;;; Internal variables
|
||||
|
||||
(defvar outline-toc--active-buffer nil
|
||||
"The buffer currently displayed in the outline-toc.")
|
||||
|
||||
;; Window start/end from the base buffer
|
||||
(defvar outline-toc--start nil)
|
||||
(defvar outline-toc--end nil)
|
||||
|
||||
;; General overlay for the outline-toc
|
||||
(defvar outline-toc--base-overlay nil)
|
||||
|
||||
;; Timer
|
||||
(defvar outline-toc--timer-object nil)
|
||||
|
||||
;; Lines the outline-toc can display
|
||||
(defvar outline-toc--numlines nil)
|
||||
|
||||
;; Line overlay
|
||||
(defvar outline-toc--line-overlay nil)
|
||||
|
||||
|
||||
;;; Helpers
|
||||
|
||||
(defun outline-toc-active-current-buffer-p ()
|
||||
"Whether the current buffer is displayed in the outline-toc."
|
||||
(and (eq (current-buffer) outline-toc--active-buffer)
|
||||
(get-buffer outline-toc-buffer-name)
|
||||
(with-current-buffer outline-toc-buffer-name
|
||||
(eq outline-toc--active-buffer (buffer-base-buffer)))))
|
||||
|
||||
(defsubst outline-toc--get-window ()
|
||||
"Get current outline-toc window."
|
||||
(when (get-buffer outline-toc-buffer-name)
|
||||
(get-buffer-window outline-toc-buffer-name)))
|
||||
|
||||
(defsubst outline-toc-kill-buffer ()
|
||||
"Kill the outline-toc buffer."
|
||||
(when (get-buffer outline-toc-buffer-name)
|
||||
(kill-buffer outline-toc-buffer-name)))
|
||||
|
||||
(defun outline-toc-create-window ()
|
||||
"Create TOC sidebare window."
|
||||
(let ((width (round (* (window-width)
|
||||
outline-toc-width-fraction))))
|
||||
(when (< width outline-toc-minimum-width)
|
||||
(setq width outline-toc-minimum-width))
|
||||
(if (eq outline-toc-window-location 'left)
|
||||
(split-window-horizontally width)
|
||||
(split-window-horizontally
|
||||
(* -1 width))
|
||||
(other-window 1))
|
||||
;; Set up the outline-toc window:
|
||||
;; You should not be able to enter the outline-toc window.
|
||||
(set-window-parameter nil 'no-other-window t)
|
||||
;; Hide things.
|
||||
(when outline-toc-hide-scroll-bar
|
||||
(setq vertical-scroll-bar nil))
|
||||
(when outline-toc-hide-fringes
|
||||
(set-window-fringes nil 0 0))
|
||||
;; Switch to buffer.
|
||||
(switch-to-buffer
|
||||
(get-buffer-create outline-toc-buffer-name) t t)
|
||||
;; Do not fold lines in the outline-toc.
|
||||
(setq truncate-lines t)
|
||||
;; Make it dedicated.
|
||||
(when outline-toc-dedicated-window
|
||||
(set-window-dedicated-p nil t))
|
||||
(prog1
|
||||
(selected-window)
|
||||
(other-window 1))))
|
||||
|
||||
;;; Outline-Toc creation / killing
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode outline-toc-mode
|
||||
"Toggle outline-toc mode."
|
||||
:global t
|
||||
:group 'outline-toc
|
||||
:lighter " OToc"
|
||||
(if outline-toc-mode
|
||||
(progn
|
||||
(when (and outline-toc-major-modes
|
||||
(apply 'derived-mode-p outline-toc-major-modes))
|
||||
(unless (outline-toc--get-window)
|
||||
(outline-toc-create-window))
|
||||
;; Create outline-toc.
|
||||
(outline-toc-new-outline-toc))
|
||||
;; Create timer.
|
||||
(setq outline-toc--timer-object
|
||||
(run-with-idle-timer outline-toc-update-delay t 'outline-toc--update)))
|
||||
;; Turn it off
|
||||
(outline-toc-kill)
|
||||
(outline-toc-setup-hooks t)))
|
||||
|
||||
(defun outline-toc-create ()
|
||||
"Create a outline-toc sidebar."
|
||||
(interactive)
|
||||
(outline-toc-mode 1))
|
||||
|
||||
(defun outline-toc-new-outline-toc ()
|
||||
"Create new outline-toc BUFNAME for current buffer and window.
|
||||
Re-use already existing outline-toc window if possible."
|
||||
(interactive)
|
||||
(let ((currentbuffer (current-buffer))
|
||||
(maj-mode major-mode)
|
||||
(win (outline-toc--get-window))
|
||||
(indbuf (make-indirect-buffer (current-buffer)
|
||||
(concat outline-toc-buffer-name "_temp")))
|
||||
(edges (window-pixel-edges)))
|
||||
|
||||
;; Remember the active buffer currently displayed in the outline-toc.
|
||||
(setq outline-toc--active-buffer (current-buffer))
|
||||
|
||||
(with-selected-window win
|
||||
;; Now set up the outline-toc:
|
||||
(when (window-dedicated-p)
|
||||
(set-window-dedicated-p nil nil))
|
||||
(switch-to-buffer indbuf t t)
|
||||
(outline-toc-kill-buffer)
|
||||
(rename-buffer outline-toc-buffer-name)
|
||||
|
||||
;; Do not fold lines in the outline-toc.
|
||||
;; (setq truncate-lines t)
|
||||
|
||||
(when outline-toc-dedicated-window
|
||||
(set-window-dedicated-p nil t))
|
||||
|
||||
;; Set up the base overlay
|
||||
(setq outline-toc--base-overlay (make-overlay (point-min) (point-max) nil t t))
|
||||
(overlay-put outline-toc--base-overlay 'face 'outline-toc-font-face)
|
||||
(overlay-put outline-toc--base-overlay 'priority 1)
|
||||
|
||||
;; (outline-toc-sb-mode 1)
|
||||
|
||||
;; (when (and (boundp 'linum-mode)
|
||||
;; linum-mode)
|
||||
;; (linum-mode 0))
|
||||
|
||||
(funcall maj-mode)
|
||||
(outline-hide-body)
|
||||
(setq buffer-read-only t)
|
||||
|
||||
;; Calculate the actual number of lines displayable with the outline-toc face.
|
||||
(setq outline-toc--numlines
|
||||
(floor
|
||||
(/
|
||||
(- (nth 3 edges) (nth 1 edges))
|
||||
(car (progn (redisplay t) (window-line-height)))))))
|
||||
|
||||
;; (outline-toc-sync-overlays)
|
||||
))
|
||||
|
||||
(defun outline-toc-kill ()
|
||||
"Kill outline-toc."
|
||||
(interactive)
|
||||
(when (outline-toc--get-window)
|
||||
(delete-window (outline-toc--get-window)))
|
||||
(cancel-timer outline-toc--timer-object))
|
||||
|
||||
;;; Outline-Toc update
|
||||
|
||||
(defun outline-toc--update (&optional force)
|
||||
"Update outline-toc 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)
|
||||
(when (outline-toc-active-current-buffer-p)
|
||||
;; Recreate toc window if necessary
|
||||
(when (null (outline-toc--get-window))
|
||||
(outline-toc-create-window))
|
||||
|
||||
;; Update our position in the TOC window
|
||||
(let ((win (outline-toc--get-window))
|
||||
(pt (point)))
|
||||
(with-selected-window win
|
||||
(outline-show-all)
|
||||
(goto-char pt)
|
||||
(outline-previous-heading)
|
||||
(outline-hide-body)
|
||||
(recenter)
|
||||
|
||||
(unless outline-toc--line-overlay
|
||||
(setq outline-toc--line-overlay (make-overlay (point) (1+ (point)) nil t))
|
||||
(overlay-put outline-toc--line-overlay 'face 'outline-toc-current-section)
|
||||
(overlay-put outline-toc--line-overlay 'priority 6))
|
||||
(move-overlay outline-toc--line-overlay (point) (line-beginning-position 2)))))))
|
||||
|
||||
(defun outline-toc--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)))
|
||||
|
||||
;;; Outline-Toc minor mode
|
||||
|
||||
(defvar outline-toc-sb-mode-map (make-sparse-keymap)
|
||||
"Keymap used by function `outline-toc-sb-mode'.")
|
||||
|
||||
(define-minor-mode outline-toc-sb-mode
|
||||
"Minor mode for outline-toc sidebar."
|
||||
nil "outline-toc" outline-toc-sb-mode-map)
|
||||
|
||||
(provide 'outline-toc)
|
||||
|
||||
;;; outline-toc.el ends here
|
||||
@ -8,18 +8,34 @@
|
||||
(interactive)
|
||||
(scroll-next-window-internal "up"))
|
||||
|
||||
(defun scroll-previous-window-up ()
|
||||
(interactive)
|
||||
(scroll-previous-window-internal "up"))
|
||||
|
||||
(defun scroll-next-window-down ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "down"))
|
||||
|
||||
(defun scroll-previous-window-down ()
|
||||
(interactive)
|
||||
(scroll-previous-window-internal "down"))
|
||||
|
||||
(defun scroll-next-window-up-line ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "up" 1))
|
||||
|
||||
(defun scroll-previous-window-up-line ()
|
||||
(interactive)
|
||||
(scroll-previous-window-internal "up" 1))
|
||||
|
||||
(defun scroll-next-window-down-line ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "down" 1))
|
||||
|
||||
(defun scroll-previous-window-down-line ()
|
||||
(interactive)
|
||||
(scroll-previous-window-internal "down" 1))
|
||||
|
||||
(defun scroll-next-window-internal (direction &optional line)
|
||||
(save-excursion
|
||||
;; Switch to next window.
|
||||
@ -37,6 +53,23 @@
|
||||
(other-window -1)
|
||||
))
|
||||
|
||||
(provide 'scroll-next-window)
|
||||
(defun scroll-previous-window-internal (direction &optional line)
|
||||
(save-excursion
|
||||
;; Switch to next window.
|
||||
(other-window -1)
|
||||
;; Do scroll operation.
|
||||
(ignore-errors
|
||||
(if (string-equal direction "up")
|
||||
(if line
|
||||
(scroll-up line)
|
||||
(scroll-up))
|
||||
(if line
|
||||
(scroll-down line)
|
||||
(scroll-down))))
|
||||
;; Switch back to current window.
|
||||
(other-window 1)
|
||||
))
|
||||
|
||||
;;; scroll-next-window.el ends here
|
||||
(provide 'scroll-adjacent-window)
|
||||
|
||||
;;; scroll-adjacent-window.el ends here
|
||||
@ -759,7 +759,7 @@
|
||||
(require 'gv)
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Compatibility hacks for older Emacsen
|
||||
|
||||
@ -861,7 +861,7 @@
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Global variables and customization options
|
||||
|
||||
@ -1149,7 +1149,7 @@ in visualizer."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =================================================================
|
||||
;;; Default keymaps
|
||||
|
||||
@ -1283,7 +1283,7 @@ in visualizer."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Undo-tree data structure
|
||||
|
||||
@ -1562,7 +1562,7 @@ in visualizer."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Basic undo-tree data structure functions
|
||||
|
||||
@ -1691,7 +1691,7 @@ Comparison is done with `eq'."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Undo list and undo changeset utility functions
|
||||
|
||||
@ -1915,7 +1915,7 @@ Comparison is done with `eq'."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; History discarding utility functions
|
||||
|
||||
@ -2103,7 +2103,7 @@ which is defined in the `warnings' library.\n")
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Visualizer utility functions
|
||||
|
||||
@ -2226,7 +2226,7 @@ which is defined in the `warnings' library.\n")
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Undo-in-region utility functions
|
||||
|
||||
@ -2722,7 +2722,7 @@ of either NODE itself or some node above it in the tree."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Undo-tree commands
|
||||
|
||||
@ -3171,7 +3171,7 @@ Argument is a character, naming the register."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Undo-tree menu bar
|
||||
|
||||
@ -3213,7 +3213,7 @@ Argument is a character, naming the register."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Persistent storage commands
|
||||
|
||||
@ -3416,7 +3416,7 @@ Note this will overwrite any existing undo history."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Visualizer drawing functions
|
||||
|
||||
@ -4062,7 +4062,7 @@ Note this will overwrite any existing undo history."
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Visualizer modes
|
||||
|
||||
@ -4111,7 +4111,7 @@ Within the undo-tree visualizer, the following keys are available:
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Visualizer commands
|
||||
|
||||
@ -4442,7 +4442,7 @@ specifies `saved', and a negative prefix argument specifies
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Visualizer selection mode commands
|
||||
|
||||
@ -4565,7 +4565,7 @@ specifies `saved', and a negative prefix argument specifies
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;; =====================================================================
|
||||
;;; Visualizer diff display
|
||||
|
||||
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 77115afc1b0b9f633084cf7479c767988106c196
|
||||
@ -1 +1 @@
|
||||
Subproject commit be612110cb116a38b8603df367942e2bb3d9bdbe
|
||||
Subproject commit 933d1f36cca0f71e4acb5fac707e9ae26c536264
|
||||
@ -1 +1 @@
|
||||
Subproject commit c617acef3dc2a88aaffa42a515ce7dbaba98228a
|
||||
Subproject commit 3e3c6e539c41c880f9d10ef7424cd0d2adcf3151
|
||||
@ -1 +1 @@
|
||||
Subproject commit 9c12b02620ed8a7ae5369fc90217f1c730e48fa6
|
||||
Subproject commit 1924eabfa7438974da0500e85fff5fb32c27282c
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 6db80c711ce947f6c6fa11e5c2257fff2c79d139
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 4d20bc852545a2e602f59084a630f888542052b1
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 8dce1e3ba1cdc34a856ad53c8421413cfe33660e
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 22bd5e20a653595b901ccfdc8780a0038755984d
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit d074e4134b1beae9ed4c9b512af741ca0d852ba3
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 141f9a05d121f60fe5e411c0ad114e3d3216c9ad
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 642cc5f8358fd1f2911792a4bbed160d24e9b01b
|
||||
@ -1 +1 @@
|
||||
Subproject commit 234806c832994cadedb42596fe235e91bbd59e8c
|
||||
Subproject commit 89f1a8df9b1fc721b1672b4c7b6d3ab451e7e3ef
|
||||
@ -1 +0,0 @@
|
||||
Subproject commit 8c30f4cab5948aa8d942a3b2bbf5fb6a94d9441d
|
||||
@ -1 +1 @@
|
||||
Subproject commit df57cd0beea9c6bdc64259bd11bde0c076a64cc9
|
||||
Subproject commit f1f22bc9ce8cc80d7eb00e63d62b78140fae1e54
|
||||
@ -1 +1 @@
|
||||
Subproject commit 52a1c5031912243c791c55e0fe345d04f219b507
|
||||
Subproject commit c1e6ff23e9af16b856c88dfaab9d3ad7b746ad37
|
||||
@ -1,10 +0,0 @@
|
||||
;;; Require
|
||||
(require 'ace-window)
|
||||
|
||||
;;; Code:
|
||||
;; 0-9 by default
|
||||
(setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
|
||||
|
||||
(provide 'init-ace-window)
|
||||
|
||||
;;; init-ace-window.el ends here
|
||||
@ -8,6 +8,16 @@
|
||||
(with-eval-after-load 'company
|
||||
(company-ctags-auto-setup))
|
||||
|
||||
; remove company backend company-dabbrev-code
|
||||
(setq company-backends
|
||||
(mapcar (lambda (backend)
|
||||
(cond
|
||||
((eq backend 'company-dabbrev-code) nil)
|
||||
((listp backend)
|
||||
(remove 'company-dabbrev-code backend))
|
||||
(t backend)))
|
||||
company-backends))
|
||||
|
||||
(provide 'init-company-mode)
|
||||
|
||||
;;; init-company-mode.el ends here
|
||||
|
||||
@ -1,23 +1,9 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'dired-display-buffer)
|
||||
(require 'dired-narrow)
|
||||
(require 'dired-subtree)
|
||||
|
||||
;;; Code:
|
||||
(setq dired-listing-switches "-alh1v --group-directories-first")
|
||||
|
||||
;; dired-subtree
|
||||
(setq dired-subtree-line-prefix " ")
|
||||
(setq dired-subtree-cycle-depth 3) ;; default `3'
|
||||
(setq dired-subtree-use-backgrounds nil) ;; default `t'
|
||||
;; (set-face-attribute 'dired-subtree-depth-1-face nil :background "#ced9db")
|
||||
;; (set-face-attribute 'dired-subtree-depth-2-face nil :background "#bbc9cc")
|
||||
;; (set-face-attribute 'dired-subtree-depth-3-face nil :background "#a7babe")
|
||||
;; (set-face-attribute 'dired-subtree-depth-4-face nil :background "#94aaaf")
|
||||
;; (set-face-attribute 'dired-subtree-depth-5-face nil :background "#809ba2")
|
||||
;; (set-face-attribute 'dired-subtree-depth-6-face nil :background "#6c8b93")
|
||||
|
||||
(provide 'init-dired)
|
||||
|
||||
;;; init-dired.el ends here
|
||||
|
||||
16
site-lisp/init-config/init-font.el
Normal file
16
site-lisp/init-config/init-font.el
Normal file
@ -0,0 +1,16 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
;; font
|
||||
(when (and window-system *win64*)
|
||||
(let ((default-font (font-spec :name "LXGW WenKai Mono"))
|
||||
(cn-font (font-spec :name "LXGW WenKai Mono")))
|
||||
(set-face-attribute 'default nil :font default-font :height 120)
|
||||
(dolist (charset '(kana han symbol cjk-misc bopomofo))
|
||||
(set-fontset-font t charset cn-font)))
|
||||
(set-face-font 'fixed-pitch "LXGW WenKai Mono"))
|
||||
|
||||
(provide 'init-font)
|
||||
|
||||
;;; init-font.el ends here
|
||||
@ -1,7 +1,5 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'jsonian)
|
||||
(require 'lua-mode)
|
||||
|
||||
;;; Code:
|
||||
;; bind ext to a specific mode
|
||||
@ -20,48 +18,22 @@ The test for presence of the car of ELT-CONS is done with `equal'."
|
||||
|
||||
(dolist (elt-cons '(
|
||||
("\\.org\\'" . org-mode)
|
||||
("\\.stumpwmrc\\'" . lisp-mode)
|
||||
("\\.jl\\'" . lisp-mode)
|
||||
("\\.asdf\\'" . lisp-mode)
|
||||
|
||||
("\\.py\\'" . python-mode)
|
||||
|
||||
("\\.markdown" . markdown-mode)
|
||||
("\\.md" . markdown-mode)
|
||||
|
||||
("\\.inc\\'" . asm-mode)
|
||||
|
||||
("\\.py\\'" . python-mode)
|
||||
("SConstruct". python-mode)
|
||||
|
||||
("\\.lua\\'" . lua-mode)
|
||||
|
||||
("\\.json\\'" . jsonian-mode)
|
||||
|
||||
("\\.go\\'" . go-mode)
|
||||
|
||||
("\\.css\\'" . css-mode)
|
||||
("\\.wxss\\'" . css-mode)
|
||||
|
||||
("\\.pdf\\'" . pdf-view-mode)
|
||||
|
||||
("\\.ts\\'" . typescript-mode)
|
||||
("\\.tsx\\'" . typescript-mode)
|
||||
|
||||
("\\.js.erb\\'" . web-mode)
|
||||
("\\.css\\'" . web-mode)
|
||||
("\\.wxss\\'" . web-mode)
|
||||
("\\.js\\'" . web-mode)
|
||||
("\\.wxs\\'" . web-mode)
|
||||
|
||||
("\\.vue" . web-mode)
|
||||
("\\.wxml" . web-mode)
|
||||
("\\.blade\\.php\\'" . web-mode)
|
||||
("\\.phtml\\'" . web-mode)
|
||||
("\\.tpl\\.php\\'" . web-mode)
|
||||
("\\.jsp\\'" . web-mode)
|
||||
("\\.mustache\\'" . web-mode)
|
||||
("\\.djhtml\\'" . web-mode)
|
||||
("\\.html?\\'" . web-mode)
|
||||
("\\.jsx\\'" . web-mode)
|
||||
("\\.wxml" . web-mode)
|
||||
|
||||
;; ("\\.rs$" . rust-mode)
|
||||
("CMakeLists\\.txt\\'" . cmake-mode)
|
||||
("\\.cmake\\'" . cmake-mode)
|
||||
))
|
||||
@ -70,23 +42,13 @@ The test for presence of the car of ELT-CONS is done with `equal'."
|
||||
;;; Mode load.
|
||||
(autoload 'cmake-mode "cmake-mode")
|
||||
|
||||
(autoload 'css-mode "css-mode")
|
||||
|
||||
(autoload 'go-mode "go-mode")
|
||||
|
||||
(require 'jsonian)
|
||||
(autoload 'jsonian-mode "jsonian-mode")
|
||||
|
||||
(autoload 'lua-mode "lua-mode")
|
||||
(setq lua-indent-level 2)
|
||||
|
||||
(autoload 'markdown-mode "markdown-mode")
|
||||
|
||||
(autoload 'python-mode "init-python")
|
||||
|
||||
(autoload 'web-mode "web-mode")
|
||||
|
||||
;; (autoload 'rust-mode "rust-mode")
|
||||
|
||||
(provide 'init-mode)
|
||||
|
||||
;;; init-mode.el ends here
|
||||
|
||||
@ -1,12 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'neotree)
|
||||
|
||||
;;; Code:
|
||||
(setq neo-theme 'ascii)
|
||||
(setq neo-show-hidden-files t)
|
||||
(setq neo-window-width 40)
|
||||
|
||||
(provide 'init-neotree)
|
||||
|
||||
;;; init-neotree.el ends here
|
||||
@ -1,57 +1,49 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
|
||||
;;; There are 3 sections:
|
||||
;;; There are 4 sections:
|
||||
;;; - unset keys
|
||||
;;; - extensions
|
||||
;;; - extensions-local
|
||||
;;; - shortcut on built-in function
|
||||
;;; - shortcut for built-in function
|
||||
|
||||
;;; ------------ unset keys
|
||||
|
||||
; originally
|
||||
; 'C-i' is TAB
|
||||
; 'C-r' is isearch-backward
|
||||
(lazy-load-unset-keys
|
||||
'("C-z" "C-\\" "C-'" "C-i" "C-r"))
|
||||
'("C-z" "C-\\" "C-'"))
|
||||
|
||||
|
||||
|
||||
;;; ------------ extensions
|
||||
|
||||
;; ------ ace-window
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("M-o" . ace-window)
|
||||
)
|
||||
"init-ace-window")
|
||||
|
||||
;; ------ avy
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("M-g c" . avy-goto-char)
|
||||
("M-g w" . avy-goto-word-1)
|
||||
("M-g s" . avy-goto-word-0)
|
||||
("M-g l l" . avy-goto-line)
|
||||
("M-g j" . avy-next)
|
||||
("M-g k" . avy-prev)
|
||||
("C-; c" . avy-goto-char)
|
||||
("C-; w" . avy-goto-word-1)
|
||||
("C-; s" . avy-goto-word-0)
|
||||
("C-; h" . avy-goto-line)
|
||||
("C-; j" . avy-next)
|
||||
("C-; k" . avy-prev)
|
||||
)
|
||||
"init-avy")
|
||||
|
||||
;; ------ citre
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-x c c" . citre-mode)
|
||||
("C-x c j" . citre-jump)
|
||||
("C-x c J" . citre-jump-back)
|
||||
("C-x c p" . citre-ace-peek)
|
||||
("C-x c u" . citre-update-this-tags-file)
|
||||
("C-z c" . citre-mode)
|
||||
("C-' j" . citre-jump)
|
||||
("C-' J" . citre-jump-back)
|
||||
("C-' p" . citre-ace-peek)
|
||||
("C-' u" . citre-update-this-tags-file)
|
||||
)
|
||||
"init-citre")
|
||||
|
||||
;; ------ theme
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("<f5>" . ld-modus-themes-toggle)
|
||||
("C-x t s" . ld-modus-themes-toggle)
|
||||
)
|
||||
"init-theme")
|
||||
|
||||
@ -67,36 +59,14 @@
|
||||
)
|
||||
"multiple-cursors")
|
||||
|
||||
;; ------ swiper
|
||||
(lazy-load-set-keys
|
||||
'(
|
||||
("C-s" . swiper-isearch)
|
||||
("C-c s" . counsel-rg)
|
||||
))
|
||||
|
||||
|
||||
|
||||
;;; ------------ extensions-local
|
||||
|
||||
(lazy-load-set-keys
|
||||
'(
|
||||
;; dired-display-buffer
|
||||
("o" . dired-display-buffer)
|
||||
;; dired-narrow
|
||||
("/" . dired-narrow)
|
||||
;; dired-subtree
|
||||
("<tab>" . dired-subtree-cycle)
|
||||
("SPC" . dired-subtree-toggle)
|
||||
("C-p" . dired-subtree-previous-sibling)
|
||||
("C-n" . dired-subtree-next-sibling)
|
||||
("r" . dired-subtree-revert)
|
||||
)
|
||||
dired-mode-map)
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-c e e" . toggle-echo-keys)
|
||||
("C-c e c" . echo-keys-clean)
|
||||
("C-z e e" . toggle-echo-keys)
|
||||
("C-z e c" . echo-keys-clean)
|
||||
)
|
||||
"echo-keys") ;show every pressed keys
|
||||
|
||||
@ -108,67 +78,40 @@
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-<" . ld-un-indent)
|
||||
("C-<" . ld-unindent)
|
||||
("C->" . ld-indent)
|
||||
)
|
||||
"force-indent") ;control 4 spaces indent manually
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-c \\" . goto-last-change)
|
||||
)
|
||||
"goto-last-change")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("M-g l p" . goto-line-preview)
|
||||
("C-; l" . goto-line-preview)
|
||||
("C-; r" . goto-line-preview-relative)
|
||||
)
|
||||
"goto-line-preview")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-c m h a" . highlight-indentation-mode)
|
||||
("C-c m h c" . highlight-indentation-current-column-mode)
|
||||
("C-z h i a" . highlight-indentation-mode)
|
||||
("C-z h i c" . highlight-indentation-current-column-mode)
|
||||
)
|
||||
"highlight-indentation")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-r i" . ld-indent-buffer)
|
||||
("C-r r" . ld-rename-file-and-buffer)
|
||||
("C-r d" . ld-delete-file-and-buffer)
|
||||
("C-r e" . ld-revert-buffer-no-confirm)
|
||||
("C-i r" . ld-find-file-in-root) ; open file with root by sudo
|
||||
("C-c I" . ld-indent-buffer)
|
||||
("C-x R r" . ld-rename-file-and-buffer)
|
||||
("C-x D" . ld-delete-file-and-buffer)
|
||||
("C-x e" . ld-revert-buffer-no-confirm)
|
||||
("C-x R R" . ld-find-file-in-root)
|
||||
)
|
||||
"ld-buffer-operations")
|
||||
"ld-file-and-buffer-operations")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-;" . ld-cursor-position-1-store) ;store cursor position
|
||||
("C-'" . ld-cursor-position-1-jump) ;jump to cursor position
|
||||
("C-c ," . ld-cursor-position-stack-push) ;push cursor position to stack
|
||||
("C-c ." . ld-cursor-position-stack-pop) ;pop corsor position from stack
|
||||
)
|
||||
"ld-goto-cursor-stack")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("M-N" . ld-delete-one-block-backward)
|
||||
("M-M" . ld-delete-one-block-forward)
|
||||
)
|
||||
"ld-delete-block") ;delete a block (eg. a word) forward and backward
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-i r" . ld-find-file-in-root) ; open file with root by sudo
|
||||
)
|
||||
"ld-file-operations")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("M-g l p" . ld-goto-percent-line)
|
||||
("M-g t p" . ld-goto-percent-text)
|
||||
("M-g t c" . ld-goto-column)
|
||||
("C-; p n" . ld-goto-percent-line)
|
||||
("C-; p t" . ld-goto-percent-text)
|
||||
("C-; f" . ld-goto-column)
|
||||
)
|
||||
"ld-goto-simple")
|
||||
|
||||
@ -185,22 +128,16 @@
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("C-c w t" . ld-toggle-one-window)
|
||||
("C-M-J" . scroll-next-window-up-line)
|
||||
("C-M-H" . scroll-next-window-up)
|
||||
("C-M-K" . scroll-next-window-down-line)
|
||||
("C-M-L" . scroll-next-window-down)
|
||||
("C-M-U" . scroll-previous-window-up-line)
|
||||
("C-M-Y" . scroll-previous-window-up)
|
||||
("C-M-I" . scroll-previous-window-down-line)
|
||||
("C-M-O" . scroll-previous-window-down)
|
||||
)
|
||||
"ld-toggle-one-window") ;maxmize current window and size back
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(("C-x j" . neotree-toggle))
|
||||
"init-neotree")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
("M-j" . watch-next-window-up-line) ; 'up' to see previous content
|
||||
("M-k" . watch-next-window-down-line) ; 'down' to see further content
|
||||
("M-J" . watch-next-window-up)
|
||||
("M-K" . watch-next-window-down)
|
||||
)
|
||||
"scroll-next-window")
|
||||
"scroll-adjacent-window")
|
||||
|
||||
(lazy-load-global-keys
|
||||
'(
|
||||
@ -210,7 +147,7 @@
|
||||
|
||||
|
||||
|
||||
;;; ------------ shortcut on built-in function
|
||||
;;; ------------ shortcut for built-in function
|
||||
|
||||
;; ------ org related
|
||||
(lazy-load-set-keys
|
||||
@ -220,31 +157,28 @@
|
||||
("C-c o l r" . org-list-repair)
|
||||
))
|
||||
|
||||
;; ------ move cursors in current buffer
|
||||
;; ------ switch between windows
|
||||
(lazy-load-set-keys
|
||||
'(
|
||||
("M-g b k" . beginning-of-buffer)
|
||||
("M-g b j" . end-of-buffer)
|
||||
("M-g h j" . forward-paragraph)
|
||||
("M-g h k" . backward-paragraph)
|
||||
("M-g l y" . backward-up-list) ;向左跳出 LIST
|
||||
("M-g l o" . up-list) ;向右跳出 LIST
|
||||
("M-g l u" . backward-down-list) ;向左跳进 LIST
|
||||
("M-g l i" . down-list) ;向右跳进 LIST
|
||||
("M-g f a" . beginning-of-defun) ;函数开头
|
||||
("M-g f e" . end-of-defun) ;函数末尾
|
||||
("M-k" . windmove-up)
|
||||
("M-j" . windmove-down)
|
||||
("M-i" . windmove-left)
|
||||
("M-o" . windmove-right)
|
||||
("M-K" . shrink-window)
|
||||
("M-J" . enlarge-window)
|
||||
("M-O" . shrink-window-horizontally)
|
||||
("M-I" . enlarge-window-horizontally)
|
||||
))
|
||||
|
||||
;; ------ other
|
||||
(lazy-load-set-keys
|
||||
'(
|
||||
("C-z r" . global-hl-line-mode)
|
||||
("C-z l" . display-line-numbers-mode)
|
||||
("C-z h l" . global-hl-line-mode)
|
||||
("C-z n m" . display-line-numbers-mode)
|
||||
("M--" . text-scale-decrease)
|
||||
("M-=" . text-scale-increase)
|
||||
("M-," . bury-buffer)
|
||||
("M-." . unbury-buffer)
|
||||
("C-c m m" . set-mark-command) ; replace C-Space for Chinese input method
|
||||
("M-N" . bury-buffer)
|
||||
("M-P" . unbury-buffer)
|
||||
("M-;" . comment-dwim)
|
||||
("C-c r" . recentf-open-files)
|
||||
))
|
||||
|
||||
@ -1,34 +0,0 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'ivy)
|
||||
(require 'counsel)
|
||||
(require 'swiper)
|
||||
|
||||
;;; Code:
|
||||
(setq ivy-use-virtual-buffers t)
|
||||
(setq ivy-initial-inputs-alist nil)
|
||||
(setq ivy-count-format "(%d/%d) ")
|
||||
|
||||
;; Map commands to their minimum required input length.
|
||||
;; That is the number of characters prompted for before fetching
|
||||
;; candidates. The special key t is used as a fallback.
|
||||
(setq ivy-more-chars-alist '((t . 2)))
|
||||
|
||||
(ivy-mode 1)
|
||||
|
||||
(setq counsel-rg-base-command
|
||||
`("rg"
|
||||
"--max-columns" "0"
|
||||
"--with-filename"
|
||||
"--no-heading"
|
||||
"--line-number"
|
||||
"--color" "never"
|
||||
"%s"
|
||||
,@(and (memq system-type '(ms-dos windows-nt))
|
||||
(list "--path-separator" "/" "."))))
|
||||
|
||||
(counsel-mode 1)
|
||||
|
||||
(provide 'init-swiper)
|
||||
|
||||
;; init-swiper.el ends here
|
||||
@ -1,18 +1,7 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'modus-themes)
|
||||
|
||||
;;; Code:
|
||||
;; font
|
||||
(when (and window-system *win64*)
|
||||
(let ((default-font (font-spec :name "Sarasa Fixed SC"))
|
||||
(cn-font (font-spec :name "Sarasa Fixed SC")))
|
||||
(set-face-attribute 'default nil :font default-font :height 116)
|
||||
(dolist (charset '(kana han symbol cjk-misc bopomofo))
|
||||
(set-fontset-font t charset cn-font)))
|
||||
(set-face-font 'fixed-pitch "Sarasa Fixed SC"))
|
||||
|
||||
;; theme
|
||||
;; In all of the following, WEIGHT is a symbol such as `semibold',
|
||||
;; `light', `bold', or anything mentioned in `modus-themes-weights'.
|
||||
(setq modus-themes-italic-constructs t
|
||||
|
||||
@ -1,6 +1,5 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'which-key)
|
||||
|
||||
;;; Code:
|
||||
(setq which-key-show-early-on-C-h t)
|
||||
|
||||
@ -12,7 +12,7 @@
|
||||
|
||||
;; from local extensions
|
||||
;; firstly loaded part
|
||||
(require 'init-theme)
|
||||
(require 'init-font)
|
||||
(require 'lazy-load)
|
||||
(require 'init-generic)
|
||||
(require 'ld-tools)
|
||||
@ -27,12 +27,15 @@
|
||||
(require 'init-org-todo)
|
||||
(require 'init-org)
|
||||
(require 'init-proxy)
|
||||
(require 'init-swiper)
|
||||
(require 'init-time)
|
||||
(require 'init-undo-tree)
|
||||
(require 'init-which-key)
|
||||
(require 'init-yasnippet)
|
||||
|
||||
|
||||
(when *emacs30*
|
||||
(require 'init-theme)
|
||||
(require 'init-which-key))
|
||||
|
||||
;; restore session
|
||||
(require 'init-session)
|
||||
(emacs-session-restore)
|
||||
|
||||
@ -13,25 +13,29 @@
|
||||
;; 父目录、 语言相关和版本控制目录都移除
|
||||
(member subdir '("." ".."
|
||||
"dist" "node_modules" "__pycache__"
|
||||
"RCS" "CVS" "rcs" "cvs" ".git" ".github"))))
|
||||
"RCS" "CVS" "rcs" "cvs"
|
||||
".git" ".github"))))
|
||||
(directory-files dir)))
|
||||
(let ((subdir-path (concat dir (file-name-as-directory subdir))))
|
||||
;; 目录下有 .el .so .dll 文件的路径才添加到 `load-path' 中，提升Emacs启动速度
|
||||
;; 提升启动速度：内有 .el .so .dll 文件的目录才被添加到 `load-path' 中
|
||||
(when (cl-some #'(lambda (subdir-file)
|
||||
(and (file-regular-p (concat subdir-path subdir-file))
|
||||
;; .so .dll 文件指非Elisp语言编写的Emacs动态库
|
||||
(member (file-name-extension subdir-file) '("el" "so" "dll"))))
|
||||
(and (file-regular-p (concat subdir-path
|
||||
subdir-file))
|
||||
;; .so .dll 文件指非 Elisp 编写的 Emacs 动态库
|
||||
(member (file-name-extension subdir-file)
|
||||
'("el" "so" "dll"))))
|
||||
(directory-files subdir-path))
|
||||
|
||||
;; 注意：add-to-list 函数的第三个参数必须为 t ，表示加到列表末尾
|
||||
;; 这样Emacs会从父目录到子目录的顺序搜索Elisp插件，顺序反过来会导致Emacs无法正常启动
|
||||
;; 这样 Emacs 会按从父目录到子目录的顺序搜索 Elisp 插件
|
||||
;; 顺序反过来会导致 Emacs 无法正常启动
|
||||
(add-to-list 'load-path subdir-path t))
|
||||
|
||||
;; 继续递归搜索子目录
|
||||
(add-subdirs-to-load-path subdir-path)))))
|
||||
|
||||
;; get emacs version and operating system type
|
||||
(defvar *emacs27* (>= emacs-major-version 27))
|
||||
(defvar *emacs30* (>= emacs-major-version 30))
|
||||
(defvar *is-a-mac* (eq system-type 'darwin))
|
||||
(defvar *win64* (eq system-type 'windows-nt))
|
||||
(defvar *cygwin* (eq system-type 'cygwin))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user