mirror of
https://github.com/lliding/ld-emacs.git
synced 2026-02-04 06:42:26 +00:00
First release.
This commit is contained in:
liding
126
site-lisp/extensions-local/auto-save.el
Normal file
126
site-lisp/extensions-local/auto-save.el
Normal file
@@ -0,0 +1,126 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defgroup auto-save nil
|
||||
"Auto save file when emacs idle."
|
||||
:group 'auto-save)
|
||||
|
||||
(defcustom auto-save-idle 1
|
||||
"The idle seconds to auto save file."
|
||||
:type 'integer
|
||||
:group 'auto-save)
|
||||
|
||||
(defcustom auto-save-silent nil
|
||||
"Nothing to dirty minibuffer if this option is non-nil."
|
||||
:type 'boolean
|
||||
:group 'auto-save)
|
||||
|
||||
(defcustom auto-save-delete-trailing-whitespace nil
|
||||
"Delete trailing whitespace when save if this option is non-nil.
|
||||
Note, this option is non-nil, will delete all training whitespace execpet current line,
|
||||
avoid delete current indent space when you programming."
|
||||
:type 'boolean
|
||||
:group 'auto-save)
|
||||
|
||||
(defvar auto-save-disable-predicates
|
||||
nil "disable auto save in these case.")
|
||||
|
||||
;; Emacs' default auto-save is stupid to generate #foo# files!
|
||||
(setq make-backup-files nil)
|
||||
(setq auto-save-default nil)
|
||||
(setq create-lockfiles nil)
|
||||
|
||||
(defun auto-save-buffers ()
|
||||
(interactive)
|
||||
(let ((autosave-buffer-list))
|
||||
(ignore-errors
|
||||
(save-current-buffer
|
||||
(dolist (buf (buffer-list))
|
||||
(set-buffer buf)
|
||||
(when (and
|
||||
;; Buffer associate with a filename?
|
||||
(buffer-file-name)
|
||||
;; Buffer is modifiable?
|
||||
(buffer-modified-p)
|
||||
;; Yassnippet is not active?
|
||||
(or (not (boundp 'yas--active-snippets))
|
||||
(not yas--active-snippets))
|
||||
;; Company is not active?
|
||||
(or (not (boundp 'company-candidates))
|
||||
(not company-candidates))
|
||||
;; Corfu is not active?
|
||||
(or (not (boundp 'corfu--total))
|
||||
(zerop corfu--total))
|
||||
;; Org-capture is not active?
|
||||
(not (eq (buffer-base-buffer (get-buffer (concat "CAPTURE-" (buffer-name))))
|
||||
buf))
|
||||
;; tell auto-save don't save
|
||||
(not (seq-some (lambda (predicate)
|
||||
(funcall predicate))
|
||||
auto-save-disable-predicates)))
|
||||
(push (buffer-name) autosave-buffer-list)
|
||||
(if auto-save-silent
|
||||
;; `inhibit-message' can shut up Emacs, but we want
|
||||
;; it doesn't clean up echo area during saving
|
||||
(with-temp-message ""
|
||||
(let ((inhibit-message t))
|
||||
(basic-save-buffer)))
|
||||
(basic-save-buffer))
|
||||
))
|
||||
;; Tell user when auto save files.
|
||||
(unless auto-save-silent
|
||||
(cond
|
||||
;; It's stupid tell user if nothing to save.
|
||||
((= (length autosave-buffer-list) 1)
|
||||
(message "# Saved %s" (car autosave-buffer-list)))
|
||||
((> (length autosave-buffer-list) 1)
|
||||
(message "# Saved %d files: %s"
|
||||
(length autosave-buffer-list)
|
||||
(mapconcat 'identity autosave-buffer-list ", ")))))
|
||||
))))
|
||||
|
||||
(defun auto-save-delete-trailing-whitespace-except-current-line ()
|
||||
(interactive)
|
||||
(when auto-save-delete-trailing-whitespace
|
||||
(let ((begin (line-beginning-position))
|
||||
(end (point)))
|
||||
(save-excursion
|
||||
(when (< (point-min) begin)
|
||||
(save-restriction
|
||||
(narrow-to-region (point-min) (1- begin))
|
||||
(delete-trailing-whitespace)))
|
||||
(when (> (point-max) end)
|
||||
(save-restriction
|
||||
(narrow-to-region end (point-max))
|
||||
(delete-trailing-whitespace)))))))
|
||||
|
||||
(defvar auto-save-timer nil)
|
||||
|
||||
(defun auto-save-set-timer ()
|
||||
"Set the auto-save timer.
|
||||
Cancel any previous timer."
|
||||
(auto-save-cancel-timer)
|
||||
(setq auto-save-timer
|
||||
(run-with-idle-timer auto-save-idle t 'auto-save-buffers)))
|
||||
|
||||
(defun auto-save-cancel-timer ()
|
||||
(when auto-save-timer
|
||||
(cancel-timer auto-save-timer)
|
||||
(setq auto-save-timer nil)))
|
||||
|
||||
(defun auto-save-enable ()
|
||||
(interactive)
|
||||
(auto-save-set-timer)
|
||||
(add-hook 'before-save-hook 'auto-save-delete-trailing-whitespace-except-current-line)
|
||||
)
|
||||
|
||||
(defun auto-save-disable ()
|
||||
(interactive)
|
||||
(auto-save-cancel-timer)
|
||||
(remove-hook 'before-save-hook 'auto-save-delete-trailing-whitespace-except-current-line)
|
||||
)
|
||||
|
||||
(provide 'auto-save)
|
||||
|
||||
;;; auto-save.el ends here
|
||||
533
site-lisp/extensions-local/cmake-mode.el
Normal file
533
site-lisp/extensions-local/cmake-mode.el
Normal file
@@ -0,0 +1,533 @@
|
||||
;;; cmake-mode.el --- major-mode for editing CMake sources
|
||||
|
||||
;; Package-Requires: ((emacs "24.1"))
|
||||
;; Package-Version: 20220823.1201
|
||||
;; Package-Commit: 5936d4f2adeec64e0ff748b2c6c34f0436b19a97
|
||||
|
||||
; Distributed under the OSI-approved BSD 3-Clause License. See accompanying
|
||||
; file Copyright.txt or https://cmake.org/licensing for details.
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Provides syntax highlighting and indentation for CMakeLists.txt and
|
||||
;; *.cmake source files.
|
||||
;;
|
||||
;; Add this code to your .emacs file to use the mode:
|
||||
;;
|
||||
;; (setq load-path (cons (expand-file-name "/dir/with/cmake-mode") load-path))
|
||||
;; (require 'cmake-mode)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;;; Code:
|
||||
;;
|
||||
;; cmake executable variable used to run cmake --help-command
|
||||
;; on commands in cmake-mode
|
||||
;;
|
||||
;; cmake-command-help Written by James Bigler
|
||||
;;
|
||||
|
||||
(require 'rst)
|
||||
(require 'rx)
|
||||
|
||||
(defcustom cmake-mode-cmake-executable "cmake"
|
||||
"*The name of the cmake executable.
|
||||
|
||||
This can be either absolute or looked up in $PATH. You can also
|
||||
set the path with these commands:
|
||||
(setenv \"PATH\" (concat (getenv \"PATH\") \";C:\\\\Program Files\\\\CMake 2.8\\\\bin\"))
|
||||
(setenv \"PATH\" (concat (getenv \"PATH\") \":/usr/local/cmake/bin\"))"
|
||||
:type 'file
|
||||
:group 'cmake)
|
||||
|
||||
;; Keywords
|
||||
(defconst cmake-keywords-block-open '("BLOCK" "IF" "MACRO" "FOREACH" "ELSE" "ELSEIF" "WHILE" "FUNCTION"))
|
||||
(defconst cmake-keywords-block-close '("ENDBLOCK" "ENDIF" "ENDFOREACH" "ENDMACRO" "ELSE" "ELSEIF" "ENDWHILE" "ENDFUNCTION"))
|
||||
(defconst cmake-keywords
|
||||
(let ((kwds (append cmake-keywords-block-open cmake-keywords-block-close nil)))
|
||||
(delete-dups kwds)))
|
||||
|
||||
;; Regular expressions used by line indentation function.
|
||||
;;
|
||||
(defconst cmake-regex-blank "^[ \t]*$")
|
||||
(defconst cmake-regex-comment "#.*")
|
||||
(defconst cmake-regex-paren-left "(")
|
||||
(defconst cmake-regex-paren-right ")")
|
||||
(defconst cmake-regex-closing-parens-line (concat "^[[:space:]]*\\("
|
||||
cmake-regex-paren-right
|
||||
"+\\)[[:space:]]*$"))
|
||||
(defconst cmake-regex-argument-quoted
|
||||
(rx ?\" (* (or (not (any ?\" ?\\)) (and ?\\ anything))) ?\"))
|
||||
(defconst cmake-regex-argument-unquoted
|
||||
(rx (or (not (any space "()#\"\\\n")) (and ?\\ nonl))
|
||||
(* (or (not (any space "()#\\\n")) (and ?\\ nonl)))))
|
||||
(defconst cmake-regex-token
|
||||
(rx-to-string `(group (or (regexp ,cmake-regex-comment)
|
||||
?\( ?\)
|
||||
(regexp ,cmake-regex-argument-unquoted)
|
||||
(regexp ,cmake-regex-argument-quoted)))))
|
||||
(defconst cmake-regex-indented
|
||||
(rx-to-string `(and bol (* (group (or (regexp ,cmake-regex-token) (any space ?\n)))))))
|
||||
(defconst cmake-regex-block-open
|
||||
(rx-to-string `(and symbol-start (or ,@(append cmake-keywords-block-open
|
||||
(mapcar 'downcase cmake-keywords-block-open))) symbol-end)))
|
||||
(defconst cmake-regex-block-close
|
||||
(rx-to-string `(and symbol-start (or ,@(append cmake-keywords-block-close
|
||||
(mapcar 'downcase cmake-keywords-block-close))) symbol-end)))
|
||||
(defconst cmake-regex-close
|
||||
(rx-to-string `(and bol (* space) (regexp ,cmake-regex-block-close)
|
||||
(* space) (regexp ,cmake-regex-paren-left))))
|
||||
(defconst cmake-regex-token-paren-left (concat "^" cmake-regex-paren-left "$"))
|
||||
(defconst cmake-regex-token-paren-right (concat "^" cmake-regex-paren-right "$"))
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;; Line indentation helper functions
|
||||
|
||||
(defun cmake-line-starts-inside-string ()
|
||||
"Determine whether the beginning of the current line is in a string."
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((parse-end (point)))
|
||||
(goto-char (point-min))
|
||||
(nth 3 (parse-partial-sexp (point) parse-end))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun cmake-find-last-indented-line ()
|
||||
"Move to the beginning of the last line that has meaningful indentation."
|
||||
(let ((point-start (point))
|
||||
region)
|
||||
(forward-line -1)
|
||||
(setq region (buffer-substring-no-properties (point) point-start))
|
||||
(while (and (not (bobp))
|
||||
(or (looking-at cmake-regex-blank)
|
||||
(cmake-line-starts-inside-string)
|
||||
(not (and (string-match cmake-regex-indented region)
|
||||
(= (length region) (match-end 0))))))
|
||||
(forward-line -1)
|
||||
(setq region (buffer-substring-no-properties (point) point-start))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;;
|
||||
;; Indentation increment.
|
||||
;;
|
||||
(defcustom cmake-tab-width 2
|
||||
"Number of columns to indent cmake blocks"
|
||||
:type 'integer
|
||||
:group 'cmake)
|
||||
|
||||
;;
|
||||
;; Line indentation function.
|
||||
;;
|
||||
(defun cmake-indent ()
|
||||
"Indent current line as CMake code."
|
||||
(interactive)
|
||||
(unless (cmake-line-starts-inside-string)
|
||||
(if (bobp)
|
||||
(cmake-indent-line-to 0)
|
||||
(let (cur-indent)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((point-start (point))
|
||||
(closing-parens-only (looking-at cmake-regex-closing-parens-line))
|
||||
(case-fold-search t) ;; case-insensitive
|
||||
token)
|
||||
;; Search back for the last indented line.
|
||||
(cmake-find-last-indented-line)
|
||||
;; Start with the indentation on this line.
|
||||
(setq cur-indent (current-indentation))
|
||||
(if closing-parens-only
|
||||
(let ((open-parens 0))
|
||||
(while (re-search-forward cmake-regex-token point-start t)
|
||||
(setq token (match-string 0))
|
||||
(cond
|
||||
((string-match cmake-regex-token-paren-left token)
|
||||
(setq open-parens (+ open-parens 1)))
|
||||
((string-match cmake-regex-token-paren-right token)
|
||||
(setq open-parens (- open-parens 1)))))
|
||||
;; Don't outdent if last indented line has open parens
|
||||
(unless (> open-parens 0)
|
||||
(setq cur-indent (- cur-indent cmake-tab-width))))
|
||||
;; Skip detailed analysis if last indented line is a 'closing
|
||||
;; parens only line'
|
||||
(unless (looking-at cmake-regex-closing-parens-line)
|
||||
;; Search forward counting tokens that adjust indentation.
|
||||
(while (re-search-forward cmake-regex-token point-start t)
|
||||
(setq token (match-string 0))
|
||||
(when (or (string-match cmake-regex-token-paren-left token)
|
||||
(and (string-match cmake-regex-block-open token)
|
||||
(looking-at (concat "[ \t]*" cmake-regex-paren-left))))
|
||||
(setq cur-indent (+ cur-indent cmake-tab-width)))
|
||||
(when (string-match cmake-regex-token-paren-right token)
|
||||
(setq cur-indent (- cur-indent cmake-tab-width)))
|
||||
))
|
||||
(goto-char point-start)
|
||||
;; If next token closes the block, decrease indentation
|
||||
(when (looking-at cmake-regex-close)
|
||||
(setq cur-indent (- cur-indent cmake-tab-width))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
;; Indent this line by the amount selected.
|
||||
(cmake-indent-line-to (max cur-indent 0))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(defun cmake-point-in-indendation ()
|
||||
(string-match "^[ \\t]*$" (buffer-substring (point-at-bol) (point))))
|
||||
|
||||
(defun cmake-indent-line-to (column)
|
||||
"Indent the current line to COLUMN.
|
||||
If point is within the existing indentation it is moved to the end of
|
||||
the indentation. Otherwise it retains the same position on the line"
|
||||
(if (cmake-point-in-indendation)
|
||||
(indent-line-to column)
|
||||
(save-excursion (indent-line-to column))))
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;;
|
||||
;; Helper functions for buffer
|
||||
;;
|
||||
(defun cmake-unscreamify-buffer ()
|
||||
"Convert all CMake commands to lowercase in buffer."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^\\([ \t]*\\)\\_<\\(\\(?:\\w\\|\\s_\\)+\\)\\_>\\([ \t]*(\\)" nil t)
|
||||
(replace-match
|
||||
(concat
|
||||
(match-string 1)
|
||||
(downcase (match-string 2))
|
||||
(match-string 3))
|
||||
t))
|
||||
)
|
||||
)
|
||||
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;;
|
||||
;; Navigation / marking by function or macro
|
||||
;;
|
||||
|
||||
(defconst cmake--regex-defun-start
|
||||
(rx line-start
|
||||
(zero-or-more space)
|
||||
(or "function" "macro")
|
||||
(zero-or-more space)
|
||||
"("))
|
||||
|
||||
(defconst cmake--regex-defun-end
|
||||
(rx line-start
|
||||
(zero-or-more space)
|
||||
"end"
|
||||
(or "function" "macro")
|
||||
(zero-or-more space)
|
||||
"(" (zero-or-more (not-char ")")) ")"))
|
||||
|
||||
(defun cmake-beginning-of-defun ()
|
||||
"Move backward to the beginning of a CMake function or macro.
|
||||
|
||||
Return t unless search stops due to beginning of buffer."
|
||||
(interactive)
|
||||
(when (not (region-active-p))
|
||||
(push-mark))
|
||||
(let ((case-fold-search t))
|
||||
(when (re-search-backward cmake--regex-defun-start nil 'move)
|
||||
t)))
|
||||
|
||||
(defun cmake-end-of-defun ()
|
||||
"Move forward to the end of a CMake function or macro.
|
||||
|
||||
Return t unless search stops due to end of buffer."
|
||||
(interactive)
|
||||
(when (not (region-active-p))
|
||||
(push-mark))
|
||||
(let ((case-fold-search t))
|
||||
(when (re-search-forward cmake--regex-defun-end nil 'move)
|
||||
(forward-line)
|
||||
t)))
|
||||
|
||||
(defun cmake-mark-defun ()
|
||||
"Mark the current CMake function or macro.
|
||||
|
||||
This puts the mark at the end, and point at the beginning."
|
||||
(interactive)
|
||||
(cmake-end-of-defun)
|
||||
(push-mark nil :nomsg :activate)
|
||||
(cmake-beginning-of-defun))
|
||||
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
;;
|
||||
;; Keyword highlighting regex-to-face map.
|
||||
;;
|
||||
(defconst cmake-font-lock-keywords
|
||||
`((,(rx-to-string `(and symbol-start
|
||||
(or ,@cmake-keywords
|
||||
,@(mapcar #'downcase cmake-keywords))
|
||||
symbol-end))
|
||||
. font-lock-keyword-face)
|
||||
(,(rx symbol-start (group (+ (or word (syntax symbol)))) (* blank) ?\()
|
||||
1 font-lock-function-name-face)
|
||||
(,(rx "${" (group (+(any alnum "-_+/."))) "}")
|
||||
1 font-lock-variable-name-face t)
|
||||
)
|
||||
"Highlighting expressions for CMake mode.")
|
||||
|
||||
;------------------------------------------------------------------------------
|
||||
|
||||
(defun cmake--syntax-propertize-until-bracket-close (syntax)
|
||||
;; This function assumes that a previous search has matched the
|
||||
;; beginning of a bracket_comment or bracket_argument and that the
|
||||
;; second capture group has matched the equal signs between the two
|
||||
;; opening brackets
|
||||
(let* ((mb (match-beginning 2))
|
||||
(me (match-end 2))
|
||||
(cb (format "]%s]" (buffer-substring mb me))))
|
||||
(save-match-data
|
||||
(if (search-forward cb end 'move)
|
||||
(progn
|
||||
(setq me (match-end 0))
|
||||
(put-text-property
|
||||
(1- me)
|
||||
me
|
||||
'syntax-table
|
||||
(string-to-syntax syntax)))
|
||||
(setq me end)))
|
||||
(put-text-property
|
||||
(match-beginning 1)
|
||||
me
|
||||
'syntax-multiline
|
||||
t)))
|
||||
|
||||
(defconst cmake--syntax-propertize-function
|
||||
(syntax-propertize-rules
|
||||
("\\(#\\)\\[\\(=*\\)\\["
|
||||
(1
|
||||
(prog1 "!" (cmake--syntax-propertize-until-bracket-close "!"))))
|
||||
("\\(\\[\\)\\(=*\\)\\["
|
||||
(1
|
||||
(prog1 "|" (cmake--syntax-propertize-until-bracket-close "|"))))))
|
||||
|
||||
;; Syntax table for this mode.
|
||||
(defvar cmake-mode-syntax-table nil
|
||||
"Syntax table for CMake mode.")
|
||||
(or cmake-mode-syntax-table
|
||||
(setq cmake-mode-syntax-table
|
||||
(let ((table (make-syntax-table)))
|
||||
(modify-syntax-entry ?\( "()" table)
|
||||
(modify-syntax-entry ?\) ")(" table)
|
||||
(modify-syntax-entry ?# "<" table)
|
||||
(modify-syntax-entry ?\n ">" table)
|
||||
(modify-syntax-entry ?$ "'" table)
|
||||
table)))
|
||||
|
||||
;;
|
||||
;; User hook entry point.
|
||||
;;
|
||||
(defvar cmake-mode-hook nil)
|
||||
|
||||
;;------------------------------------------------------------------------------
|
||||
;; Mode definition.
|
||||
;;
|
||||
;;;###autoload
|
||||
(define-derived-mode cmake-mode prog-mode "CMake"
|
||||
"Major mode for editing CMake source files."
|
||||
|
||||
; Setup font-lock mode.
|
||||
(set (make-local-variable 'font-lock-defaults) '(cmake-font-lock-keywords))
|
||||
; Setup indentation function.
|
||||
(set (make-local-variable 'indent-line-function) 'cmake-indent)
|
||||
; Setup comment syntax.
|
||||
(set (make-local-variable 'comment-start) "#")
|
||||
;; Setup syntax propertization
|
||||
(set (make-local-variable 'syntax-propertize-function) cmake--syntax-propertize-function)
|
||||
(add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline nil t))
|
||||
|
||||
;; Default cmake-mode key bindings
|
||||
(define-key cmake-mode-map "\e\C-a" #'cmake-beginning-of-defun)
|
||||
(define-key cmake-mode-map "\e\C-e" #'cmake-end-of-defun)
|
||||
(define-key cmake-mode-map "\e\C-h" #'cmake-mark-defun)
|
||||
|
||||
|
||||
; Help mode starts here
|
||||
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-command-run (type &optional topic buffer)
|
||||
"Runs the command cmake with the arguments specified. The
|
||||
optional argument topic will be appended to the argument list."
|
||||
(interactive "s")
|
||||
(let* ((bufname (if buffer buffer (concat "*CMake" type (if topic "-") topic "*")))
|
||||
(buffer (if (get-buffer bufname) (get-buffer bufname) (generate-new-buffer bufname)))
|
||||
(command (concat cmake-mode-cmake-executable " " type " " topic))
|
||||
;; Turn of resizing of mini-windows for shell-command.
|
||||
(resize-mini-windows nil)
|
||||
)
|
||||
(shell-command command buffer)
|
||||
(save-selected-window
|
||||
(select-window (display-buffer buffer 'not-this-window))
|
||||
(cmake-mode)
|
||||
(read-only-mode 1)
|
||||
(view-mode 1))
|
||||
)
|
||||
)
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-command-run-help (type &optional topic buffer)
|
||||
"`cmake-command-run' but rendered in `rst-mode'."
|
||||
(interactive "s")
|
||||
(let* ((bufname (if buffer buffer (concat "*CMake" type (if topic "-") topic "*")))
|
||||
(buffer (if (get-buffer bufname) (get-buffer bufname) (generate-new-buffer bufname)))
|
||||
(command (concat cmake-mode-cmake-executable " " type " " topic))
|
||||
;; Turn of resizing of mini-windows for shell-command.
|
||||
(resize-mini-windows nil)
|
||||
)
|
||||
(shell-command command buffer)
|
||||
(save-selected-window
|
||||
(select-window (display-buffer buffer 'not-this-window))
|
||||
(rst-mode)
|
||||
(read-only-mode 1)
|
||||
(view-mode 1))
|
||||
)
|
||||
)
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-help-list-commands ()
|
||||
"Prints out a list of the cmake commands."
|
||||
(interactive)
|
||||
(cmake-command-run-help "--help-command-list")
|
||||
)
|
||||
|
||||
(defvar cmake-commands '() "List of available topics for --help-command.")
|
||||
(defvar cmake-help-command-history nil "Command read history.")
|
||||
(defvar cmake-modules '() "List of available topics for --help-module.")
|
||||
(defvar cmake-help-module-history nil "Module read history.")
|
||||
(defvar cmake-variables '() "List of available topics for --help-variable.")
|
||||
(defvar cmake-help-variable-history nil "Variable read history.")
|
||||
(defvar cmake-properties '() "List of available topics for --help-property.")
|
||||
(defvar cmake-help-property-history nil "Property read history.")
|
||||
(defvar cmake-help-complete-history nil "Complete help read history.")
|
||||
(defvar cmake-string-to-list-symbol
|
||||
'(("command" cmake-commands cmake-help-command-history)
|
||||
("module" cmake-modules cmake-help-module-history)
|
||||
("variable" cmake-variables cmake-help-variable-history)
|
||||
("property" cmake-properties cmake-help-property-history)
|
||||
))
|
||||
|
||||
(defun cmake-get-list (listname)
|
||||
"If the value of LISTVAR is nil, run cmake --help-LISTNAME-list
|
||||
and store the result as a list in LISTVAR."
|
||||
(let ((listvar (car (cdr (assoc listname cmake-string-to-list-symbol)))))
|
||||
(if (not (symbol-value listvar))
|
||||
(let ((temp-buffer-name "*CMake Temporary*"))
|
||||
(save-window-excursion
|
||||
(cmake-command-run-help (concat "--help-" listname "-list") nil temp-buffer-name)
|
||||
(with-current-buffer temp-buffer-name
|
||||
; FIXME: Ignore first line if it is "cmake version ..." from CMake < 3.0.
|
||||
(set listvar (split-string (buffer-substring-no-properties (point-min) (point-max)) "\n" t)))))
|
||||
(symbol-value listvar)
|
||||
))
|
||||
)
|
||||
|
||||
(require 'thingatpt)
|
||||
(defun cmake-symbol-at-point ()
|
||||
(let ((symbol (symbol-at-point)))
|
||||
(and (not (null symbol))
|
||||
(symbol-name symbol))))
|
||||
|
||||
(defun cmake-help-type (type)
|
||||
(let* ((default-entry (cmake-symbol-at-point))
|
||||
(history (car (cdr (cdr (assoc type cmake-string-to-list-symbol)))))
|
||||
(input (completing-read
|
||||
(format "CMake %s: " type) ; prompt
|
||||
(cmake-get-list type) ; completions
|
||||
nil ; predicate
|
||||
t ; require-match
|
||||
default-entry ; initial-input
|
||||
history
|
||||
)))
|
||||
(if (string= input "")
|
||||
(error "No argument given")
|
||||
input))
|
||||
)
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-help-command ()
|
||||
"Prints out the help message for the command the cursor is on."
|
||||
(interactive)
|
||||
(cmake-command-run-help "--help-command" (cmake-help-type "command") "*CMake Help*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-help-module ()
|
||||
"Prints out the help message for the module the cursor is on."
|
||||
(interactive)
|
||||
(cmake-command-run-help "--help-module" (cmake-help-type "module") "*CMake Help*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-help-variable ()
|
||||
"Prints out the help message for the variable the cursor is on."
|
||||
(interactive)
|
||||
(cmake-command-run-help "--help-variable" (cmake-help-type "variable") "*CMake Help*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-help-property ()
|
||||
"Prints out the help message for the property the cursor is on."
|
||||
(interactive)
|
||||
(cmake-command-run-help "--help-property" (cmake-help-type "property") "*CMake Help*"))
|
||||
|
||||
;;;###autoload
|
||||
(defun cmake-help ()
|
||||
"Queries for any of the four available help topics and prints out the appropriate page."
|
||||
(interactive)
|
||||
(let* ((default-entry (cmake-symbol-at-point))
|
||||
(command-list (cmake-get-list "command"))
|
||||
(variable-list (cmake-get-list "variable"))
|
||||
(module-list (cmake-get-list "module"))
|
||||
(property-list (cmake-get-list "property"))
|
||||
(all-words (append command-list variable-list module-list property-list))
|
||||
(input (completing-read
|
||||
"CMake command/module/variable/property: " ; prompt
|
||||
all-words ; completions
|
||||
nil ; predicate
|
||||
t ; require-match
|
||||
default-entry ; initial-input
|
||||
'cmake-help-complete-history
|
||||
)))
|
||||
(if (string= input "")
|
||||
(error "No argument given")
|
||||
(if (member input command-list)
|
||||
(cmake-command-run-help "--help-command" input "*CMake Help*")
|
||||
(if (member input variable-list)
|
||||
(cmake-command-run-help "--help-variable" input "*CMake Help*")
|
||||
(if (member input module-list)
|
||||
(cmake-command-run-help "--help-module" input "*CMake Help*")
|
||||
(if (member input property-list)
|
||||
(cmake-command-run-help "--help-property" input "*CMake Help*")
|
||||
(error "Not a know help topic.") ; this really should not happen
|
||||
))))))
|
||||
)
|
||||
|
||||
;;;###autoload
|
||||
(progn
|
||||
(add-to-list 'auto-mode-alist '("CMakeLists\\.txt\\'" . cmake-mode))
|
||||
(add-to-list 'auto-mode-alist '("\\.cmake\\'" . cmake-mode)))
|
||||
|
||||
; This file provides cmake-mode.
|
||||
(provide 'cmake-mode)
|
||||
|
||||
;;; cmake-mode.el ends here
|
||||
528
site-lisp/extensions-local/company-ctags.el
Normal file
528
site-lisp/extensions-local/company-ctags.el
Normal file
@@ -0,0 +1,528 @@
|
||||
;;; company-ctags.el --- Fastest company-mode completion backend for ctags -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2019,2020 Chen Bin
|
||||
|
||||
;; Author: Chen Bin <chenbin.sh@gmail.com>
|
||||
;; URL: https://github.com/redguardtoo/company-ctags
|
||||
;; Version: 0.0.7
|
||||
;; Keywords: convenience
|
||||
;; Package-Requires: ((emacs "25.1") (company "0.9.0"))
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; This library completes code using tags file created by Ctags.
|
||||
;; It uses a much faster algorithm optimized for ctags.
|
||||
;; It takes only 9 seconds to load 300M tags file which is created by
|
||||
;; scanning the Linux Kernel code v5.3.1.
|
||||
;; After initial loading, this library will respond immediately
|
||||
;; when new tags file is created.
|
||||
;;
|
||||
;; Usage:
|
||||
;;
|
||||
;; Step 0, Make sure `company-mode' is already set up
|
||||
;; See http://company-mode.github.io/ for details.
|
||||
;;
|
||||
;; Step 1, insert below code into your configuration,
|
||||
;;
|
||||
;; (with-eval-after-load 'company
|
||||
;; (company-ctags-auto-setup))
|
||||
;;
|
||||
;; Step 2, Use Ctags to create tags file and enjoy.
|
||||
;;
|
||||
;; Tips:
|
||||
;;
|
||||
;; - Turn on `company-ctags-support-etags' to support tags
|
||||
;; file created by etags. But it will increase initial loading time.
|
||||
;;
|
||||
;; - Set `company-ctags-extra-tags-files' to load extra tags files,
|
||||
;;
|
||||
;; (setq company-ctags-extra-tags-files '("$HOME/TAGS" "/usr/include/TAGS"))
|
||||
;;
|
||||
;; - Set `company-ctags-fuzzy-match-p' to fuzzy match the candidates.
|
||||
;; The input could match any part of the candidate instead of the beginning of
|
||||
;; the candidate.
|
||||
;;
|
||||
;; - Set `company-ctags-ignore-case' to ignore case when fetching candidates
|
||||
;;
|
||||
;; - Use rusty-tags to generate tags file for Rust programming language.
|
||||
;; Add below code into ~/.emacs,
|
||||
;; (setq company-ctags-tags-file-name "rusty-tags.emacs")
|
||||
;;
|
||||
;; - Make sure CLI program diff is executable on Windows.
|
||||
;; It's optional but highly recommended. It can speed up tags file updating.
|
||||
;; This package uses diff through variable `diff-command'.
|
||||
;;
|
||||
;; - `company-ctags-debug-info' for debugging.
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'find-file)
|
||||
(require 'company nil t)
|
||||
(require 'cl-lib)
|
||||
(require 'subr-x)
|
||||
|
||||
(defgroup company-ctags nil
|
||||
"Completion backend for ctags."
|
||||
:group 'company)
|
||||
|
||||
(defcustom company-ctags-use-main-table-list t
|
||||
"Always search `tags-table-list' if set.
|
||||
If this is disabled, `company-ctags' will try to find the one table for each
|
||||
buffer automatically."
|
||||
:type '(choice (const :tag "off" nil)
|
||||
(const :tag "on" t)))
|
||||
|
||||
(defcustom company-ctags-ignore-case nil
|
||||
"Non-nil to ignore case in completion candidates."
|
||||
:type 'boolean
|
||||
:package-version '(company . "0.7.3"))
|
||||
|
||||
(defcustom company-ctags-extra-tags-files nil
|
||||
"List of extra tags files which are loaded only once.
|
||||
|
||||
A typical format is,
|
||||
|
||||
(\"./TAGS\" \"/usr/include/TAGS\" \"$PROJECT/*/include/TAGS\")
|
||||
|
||||
Environment variables can be inserted between slashes (`/').
|
||||
They will be replaced by their definitions. If a variable does
|
||||
not exist, it is replaced (silently) with an empty string."
|
||||
:type '(repeat 'string))
|
||||
|
||||
(defcustom company-ctags-quiet nil
|
||||
"Be quiet and do not notify user tags file status."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom company-ctags-support-etags nil
|
||||
"Support tags file created by etags.
|
||||
If t, it increases the loading time."
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom company-ctags-everywhere nil
|
||||
"Non-nil to offer completions in comments and strings.
|
||||
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"))
|
||||
|
||||
(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."
|
||||
:type 'string)
|
||||
|
||||
(defcustom company-ctags-tag-name-valid-characters
|
||||
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ$#@%_!*&1234567890"
|
||||
"The characters of tag name. It's used for partition algorithm."
|
||||
:type 'string)
|
||||
|
||||
(defcustom company-ctags-fuzzy-match-p nil
|
||||
"If t, fuzzy match the candidates.
|
||||
The input could match any part of the candidate instead of the beginning of
|
||||
the candidate."
|
||||
:type 'boolean)
|
||||
|
||||
(defvar company-ctags-modes
|
||||
'(prog-mode
|
||||
c-mode
|
||||
objc-mode
|
||||
c++-mode
|
||||
java-mode
|
||||
jde-mode
|
||||
pascal-mode
|
||||
perl-mode
|
||||
python-mode
|
||||
lua-mode
|
||||
web-mode))
|
||||
|
||||
(defvar company-backends) ; avoid compiling warning
|
||||
|
||||
(defvar-local company-ctags-buffer-table-internal nil)
|
||||
|
||||
(defvar company-ctags-tags-file-caches nil
|
||||
"The cached tags files.")
|
||||
|
||||
(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))
|
||||
(list file))))
|
||||
|
||||
(defun company-ctags-buffer-table ()
|
||||
"Find buffer table."
|
||||
(or (and company-ctags-use-main-table-list tags-table-list)
|
||||
(or company-ctags-buffer-table-internal
|
||||
(setq company-ctags-buffer-table-internal
|
||||
(company-ctags-find-table)))))
|
||||
|
||||
(defun company-ctags-char-in-string-p (character string)
|
||||
"Test if CHARACTER is in STRING."
|
||||
(let (rlt (i 0) (len (length string)))
|
||||
(while (and (not rlt) (< i len))
|
||||
(setq rlt (eq (elt string i) character))
|
||||
(setq i (1+ i)))
|
||||
rlt))
|
||||
|
||||
(defun company-ctags-tag-name-character-p (character)
|
||||
"Test if CHARACTER is in `company-ctags-tag-name-valid-characters'."
|
||||
(company-ctags-char-in-string-p character
|
||||
company-ctags-tag-name-valid-characters))
|
||||
|
||||
(defmacro company-ctags-push-tagname (tagname tagname-dict)
|
||||
"Push TAGNAME into TAGNAME-DICT."
|
||||
`(let ((c (elt ,tagname 0)))
|
||||
(when (company-ctags-tag-name-character-p c)
|
||||
(push ,tagname (gethash c ,tagname-dict)))))
|
||||
|
||||
(defun company-ctags-n-items (n tagnames)
|
||||
"Return first N items of TAGNAMES."
|
||||
(cond
|
||||
((<= (length tagnames) n)
|
||||
tagnames)
|
||||
(t
|
||||
(let (rlt (i 0))
|
||||
(while (< i n)
|
||||
(push (nth i tagnames) rlt)
|
||||
(setq i (1+ i)))
|
||||
(push " ..." rlt)
|
||||
(nreverse rlt)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-ctags-debug-info ()
|
||||
"Print all debug information."
|
||||
(interactive)
|
||||
(let* ((caches company-ctags-tags-file-caches)
|
||||
(keys (hash-table-keys caches)))
|
||||
(message "* cache contents")
|
||||
(dolist (k keys)
|
||||
(let* ((h (gethash k caches))
|
||||
(timestamp (plist-get h :timestamp))
|
||||
(filesize (plist-get h :filesize))
|
||||
(dict (plist-get h :tagname-dict))
|
||||
(dict-keys (hash-table-keys dict)))
|
||||
(message "** key=%s timestamp=%s filesize=%s\n" k timestamp filesize)
|
||||
(dolist (dk dict-keys)
|
||||
(let* ((items (company-ctags-n-items 4 (gethash dk dict))))
|
||||
(when (> (length items) 0)
|
||||
(message " %s: %s" (string dk) items))))))))
|
||||
|
||||
(defun company-ctags-init-tagname-dict ()
|
||||
"Initialize tagname dict."
|
||||
(let* ((i 0)
|
||||
(dict (make-hash-table))
|
||||
(len (length company-ctags-tag-name-valid-characters)))
|
||||
(while (< i len)
|
||||
(puthash (elt company-ctags-tag-name-valid-characters i) '() dict)
|
||||
(setq i (1+ i)))
|
||||
dict))
|
||||
|
||||
(defun company-ctags-parse-tags (text &optional dict)
|
||||
"Extract tag names from TEXT.
|
||||
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)
|
||||
(case-fold-search company-ctags-ignore-case))
|
||||
(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
|
||||
;; slow algorithm, need support both explicit and implicit tags name
|
||||
(while (string-match company-ctags-slow-pattern text start)
|
||||
(cond
|
||||
((match-beginning 2)
|
||||
;; There is an explicit tag name.
|
||||
(company-ctags-push-tagname (substring text (match-beginning 2) (match-end 2))
|
||||
dict))
|
||||
(t
|
||||
;; No explicit tag name. Backtrack a little,
|
||||
;; and look for the implicit one.
|
||||
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
|
||||
dict)))
|
||||
(setq start (+ 4 (match-end 0)))))
|
||||
(t
|
||||
;; fast algorithm, support explicit tags name only
|
||||
(while (string-match company-ctags-fast-pattern text start)
|
||||
(company-ctags-push-tagname (substring text (match-beginning 1) (match-end 1))
|
||||
dict)
|
||||
(setq start (+ 4 (match-end 0))))))
|
||||
|
||||
dict))
|
||||
|
||||
(defun company-ctags-all-completions (string collection)
|
||||
"Search match to STRING in COLLECTION to see if it begins with STRING.
|
||||
If `company-ctags-fuzzy-match-p' is t, check if the match contains STRING."
|
||||
(let ((case-fold-search company-ctags-ignore-case))
|
||||
(cond
|
||||
(company-ctags-fuzzy-match-p
|
||||
(let* (rlt)
|
||||
;; code should be efficient in side the this loop
|
||||
(dolist (c collection)
|
||||
(if (string-match string c) (push c rlt)))
|
||||
rlt))
|
||||
(t
|
||||
(all-completions string collection)))))
|
||||
|
||||
(defun company-ctags-fetch-by-first-char (c prefix tagname-dict)
|
||||
"Fetch candidates by first character C of PREFIX from TAGNAME-DICT."
|
||||
(let* ((rlt (company-ctags-all-completions prefix (gethash c tagname-dict))))
|
||||
(when company-ctags-ignore-case
|
||||
(let (c2 (offset (- ?a ?A)))
|
||||
(cond
|
||||
((company-ctags-char-in-string-p c "abcdefghijklmnopqrstuvwxyz")
|
||||
(setq c2 (- c offset)))
|
||||
|
||||
((company-ctags-char-in-string-p c "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||||
(setq c2 (+ c offset))))
|
||||
|
||||
(when c2
|
||||
(setq rlt (nconc rlt (company-ctags-all-completions prefix (gethash c2 tagname-dict)))))))
|
||||
rlt))
|
||||
|
||||
(defun company-ctags-all-candidates (prefix tagname-dict)
|
||||
"Search for partial match to PREFIX in TAGNAME-DICT."
|
||||
(cond
|
||||
(company-ctags-fuzzy-match-p
|
||||
(let* ((keys (hash-table-keys tagname-dict))
|
||||
rlt)
|
||||
;; search all hash tables
|
||||
;; don't care the first character of prefix
|
||||
(dolist (c keys)
|
||||
(setq rlt (nconc rlt (company-ctags-fetch-by-first-char c prefix tagname-dict))))
|
||||
rlt))
|
||||
(t
|
||||
(company-ctags-fetch-by-first-char (elt prefix 0) prefix tagname-dict))))
|
||||
|
||||
(defun company-ctags-load-tags-file (file static-p &optional force no-diff-prog)
|
||||
"Load tags from FILE.
|
||||
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.
|
||||
This function return t if any tag file is reloaded."
|
||||
(let* (raw-content
|
||||
(file-info (and company-ctags-tags-file-caches
|
||||
(gethash file company-ctags-tags-file-caches)))
|
||||
(use-diff (and (not no-diff-prog)
|
||||
file-info
|
||||
(plist-get file-info :raw-content)
|
||||
(executable-find diff-command)))
|
||||
tagname-dict
|
||||
reloaded)
|
||||
|
||||
(when (or force
|
||||
(not file-info)
|
||||
(and
|
||||
;; the tags file is static and is already read into cache
|
||||
;; so don't read it again
|
||||
;; (not (plist-get file-info :static-p))
|
||||
;; time to expire cache from tags file
|
||||
(> (- (float-time (current-time))
|
||||
(plist-get file-info :timestamp))
|
||||
company-ctags-check-tags-file-interval)
|
||||
;; When generating new tags file, file size could be
|
||||
;; temporarily smaller than cached file size.
|
||||
;; Don't reload tags file until new tags file is bigger.
|
||||
(> (nth 7 (file-attributes file))
|
||||
(plist-get file-info :filesize))))
|
||||
|
||||
;; Read file content
|
||||
(setq reloaded t)
|
||||
(cond
|
||||
(use-diff
|
||||
;; actually don't change raw-content attached to file-info
|
||||
(setq raw-content (plist-get file-info :raw-content))
|
||||
|
||||
;; use diff to find the new tags
|
||||
(let (diff-output)
|
||||
(with-temp-buffer
|
||||
(insert (plist-get file-info :raw-content))
|
||||
;; when process finished, replace temp buffer with program output
|
||||
(call-process-region (point-min) (point-max) diff-command t t nil "-ab" file "-")
|
||||
(setq diff-output (buffer-string)))
|
||||
|
||||
;; compare old and new tags file, extract tag names from diff output which
|
||||
;; should be merged with old tag names
|
||||
(setq tagname-dict
|
||||
(company-ctags-parse-tags diff-output
|
||||
(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)))
|
||||
;; collect all tag names
|
||||
(setq tagname-dict (company-ctags-parse-tags raw-content))
|
||||
(unless company-ctags-quiet (message "%s is loaded." file))))
|
||||
|
||||
;; initialize hash table if needed
|
||||
(unless company-ctags-tags-file-caches
|
||||
(set 'company-ctags-tags-file-caches (make-hash-table :test #'equal)))
|
||||
|
||||
;; finalize tags file info
|
||||
(puthash file
|
||||
;; if the tags file is read only once, it will never be updated
|
||||
;; by `diff-command', so don't need store original raw content
|
||||
;; of tags file in order to save memory.
|
||||
(list :raw-content (unless static-p raw-content)
|
||||
:tagname-dict tagname-dict
|
||||
:static-p static-p
|
||||
:timestamp (float-time (current-time))
|
||||
:filesize (nth 7 (file-attributes file)))
|
||||
company-ctags-tags-file-caches))
|
||||
reloaded))
|
||||
|
||||
(defun company-ctags--test-cached-candidates (prefix)
|
||||
"Test PREFIX in `company-ctags-cached-candidates'."
|
||||
(let* ((cands company-ctags-cached-candidates)
|
||||
(key (plist-get cands :key))
|
||||
(keylen (length key))
|
||||
(case-fold-search company-ctags-ignore-case))
|
||||
;; prefix is "hello" and cache's prefix "ell"
|
||||
(and (>= (length prefix) keylen)
|
||||
(if company-ctags-fuzzy-match-p (string-match key prefix)
|
||||
;; key is the beginning of prefix
|
||||
(string= (substring prefix 0 keylen) key)))))
|
||||
|
||||
(defun company-ctags--candidates (prefix)
|
||||
"Get candidate with 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)
|
||||
(all-tags-files (mapcar (lambda (f)
|
||||
(file-truename f))
|
||||
(delete-dups (append (if file (list file))
|
||||
(company-ctags-buffer-table)))))
|
||||
(extra-tags-files (ff-list-replace-env-vars company-ctags-extra-tags-files))
|
||||
rlt)
|
||||
|
||||
;; load tags files, maybe
|
||||
(dolist (f all-tags-files)
|
||||
(when (and f (file-exists-p f))
|
||||
(when (company-ctags-load-tags-file f
|
||||
nil ; primary tags file, not static
|
||||
nil
|
||||
nil)
|
||||
;; invalidate cached candidates if any tags file is reloaded
|
||||
(setq company-ctags-cached-candidates nil))))
|
||||
|
||||
(when extra-tags-files
|
||||
(dolist (f extra-tags-files)
|
||||
(when (and f (file-exists-p f))
|
||||
;; tags file in `company-ctags-extra-tags-files' is read only once.
|
||||
(company-ctags-load-tags-file f
|
||||
t ; static tags file, read only once
|
||||
nil
|
||||
nil))))
|
||||
|
||||
(cond
|
||||
;; re-use cached candidates
|
||||
((and (not company-ctags-fuzzy-match-p)
|
||||
company-ctags-cached-candidates
|
||||
(company-ctags--test-cached-candidates prefix))
|
||||
|
||||
(let* ((cands (plist-get company-ctags-cached-candidates :cands)))
|
||||
(setq rlt (company-ctags-all-completions prefix cands))))
|
||||
|
||||
;; search candidates through tags files
|
||||
(t
|
||||
(dolist (f (nconc all-tags-files extra-tags-files))
|
||||
(let* ((cache (gethash f company-ctags-tags-file-caches))
|
||||
(tagname-dict (plist-get cache :tagname-dict)))
|
||||
(when tagname-dict
|
||||
(setq rlt (append rlt (company-ctags-all-candidates prefix tagname-dict))))))
|
||||
|
||||
;; fuzzy algorithm don't use caching algorithm
|
||||
(unless company-ctags-fuzzy-match-p
|
||||
(setq company-ctags-cached-candidates
|
||||
;; clone the rlt into cache
|
||||
(list :key prefix :cands (mapcar 'identity rlt))))))
|
||||
|
||||
;; cleanup
|
||||
(if rlt (delete-dups rlt)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-ctags (command &optional arg &rest ignored)
|
||||
"Completion backend of for ctags. Execute COMMAND with ARG and IGNORED."
|
||||
(interactive (list 'interactive))
|
||||
(cl-case command
|
||||
(interactive (company-begin-backend 'company-ctags))
|
||||
(prefix (and (apply #'derived-mode-p company-ctags-modes)
|
||||
(or (eq t company-ctags-everywhere)
|
||||
(apply #'derived-mode-p company-ctags-everywhere)
|
||||
(not (company-in-string-or-comment)))
|
||||
(company-ctags-buffer-table)
|
||||
(or (company-grab-symbol) 'stop)))
|
||||
(candidates (company-ctags--candidates arg))
|
||||
(location (let ((tags-table-list (company-ctags-buffer-table)))
|
||||
(when (fboundp 'find-tag-noselect)
|
||||
(save-excursion
|
||||
(let ((buffer (find-tag-noselect arg)))
|
||||
(cons buffer (with-current-buffer buffer (point))))))))
|
||||
(ignore-case company-ctags-ignore-case)))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-ctags-replace-backend (backends)
|
||||
"Replace `company-etags' with `company-ctags' in BACKENDS."
|
||||
(let* (rlt)
|
||||
(dolist (b backends)
|
||||
(cond
|
||||
((eq b 'company-etags)
|
||||
(push 'company-ctags rlt))
|
||||
((listp b)
|
||||
(let* (children)
|
||||
(dolist (c b)
|
||||
(cond
|
||||
((eq c 'company-etags)
|
||||
(push 'company-ctags children))
|
||||
(t
|
||||
(push c children))))
|
||||
(push (nreverse children) rlt)))
|
||||
(t
|
||||
(push b rlt))))
|
||||
(nreverse rlt)))
|
||||
|
||||
;;;###autoload
|
||||
(defun company-ctags-auto-setup ()
|
||||
"Set up `company-backends'."
|
||||
(setq company-backends
|
||||
(company-ctags-replace-backend company-backends)))
|
||||
|
||||
(provide 'company-ctags)
|
||||
;;; company-ctags.el ends here
|
||||
87
site-lisp/extensions-local/dired-display-buffer.el
Normal file
87
site-lisp/extensions-local/dired-display-buffer.el
Normal file
@@ -0,0 +1,87 @@
|
||||
;; -*- 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
|
||||
273
site-lisp/extensions-local/dired-hacks-utils.el
Normal file
273
site-lisp/extensions-local/dired-hacks-utils.el
Normal file
@@ -0,0 +1,273 @@
|
||||
;;; 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
|
||||
356
site-lisp/extensions-local/dired-narrow.el
Normal file
356
site-lisp/extensions-local/dired-narrow.el
Normal file
@@ -0,0 +1,356 @@
|
||||
;;; 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
|
||||
784
site-lisp/extensions-local/dired-subtree.el
Normal file
784
site-lisp/extensions-local/dired-subtree.el
Normal file
@@ -0,0 +1,784 @@
|
||||
;;; 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
|
||||
126
site-lisp/extensions-local/echo-keys.el
Normal file
126
site-lisp/extensions-local/echo-keys.el
Normal file
@@ -0,0 +1,126 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
(require 'cl-lib)
|
||||
|
||||
;;; Code:
|
||||
(defcustom echo-keys-last-record nil
|
||||
"Last command processed by 'echo-keys'."
|
||||
:type 'string
|
||||
:group 'echo-keys)
|
||||
|
||||
(defcustom echo-keys-last-record-count 0
|
||||
"Number of times the `echo-keys-last-record` command was repeated."
|
||||
:type 'integer
|
||||
:group 'echo-keys)
|
||||
|
||||
(defcustom echo-key-window-width 40
|
||||
"Default width of the *echo-keys* window."
|
||||
:type 'integer
|
||||
:group 'echo-keys)
|
||||
|
||||
(defcustom echo-key-password-protection nil
|
||||
"Temporarily disable echo key for password input."
|
||||
:type 'boolean
|
||||
:group 'echo-keys)
|
||||
|
||||
(defcustom echo-key-coallesce-repeats t
|
||||
"If 't', show <key> <command> [<echo-keys-last-record-count> times].
|
||||
If 'nil', show <key> <commands> n lines."
|
||||
:type 'boolean
|
||||
:group 'echo-keys)
|
||||
|
||||
(defun echo-keys ()
|
||||
(let ((deactivate-mark deactivate-mark)
|
||||
(keys (this-command-keys)))
|
||||
(when (and keys
|
||||
(not (eq (current-buffer) (get-buffer "*echo-keys*")))
|
||||
(not echo-key-password-protection))
|
||||
(save-excursion
|
||||
(with-current-buffer (get-buffer-create "*echo-keys*")
|
||||
(goto-char (point-max))
|
||||
(if (eql this-command 'self-insert-command)
|
||||
(let ((desc (key-description keys)))
|
||||
(if (= 1 (length desc))
|
||||
(insert desc)
|
||||
(insert " " desc " "))
|
||||
(setf echo-keys-last-record this-command
|
||||
echo-keys-last-record-count 1))
|
||||
(if (and echo-key-coallesce-repeats
|
||||
(eql echo-keys-last-record this-command))
|
||||
(progn
|
||||
(incf echo-keys-last-record-count)
|
||||
;; update the last line
|
||||
(forward-line -1)
|
||||
(if (= 2 echo-keys-last-record-count)
|
||||
(progn
|
||||
(end-of-line)
|
||||
(insert (format " [%d times]" echo-keys-last-record-count)))
|
||||
(save-match-data
|
||||
(when (re-search-forward " \\[\\([0-9]+\\) times\\]" nil t)
|
||||
(delete-region (match-beginning 1) (match-end 1))
|
||||
(goto-char (match-beginning 1))
|
||||
(insert (format "%d" echo-keys-last-record-count)))))
|
||||
(forward-line 1))
|
||||
(progn
|
||||
(insert (if (eq 'self-insert-command echo-keys-last-record)
|
||||
"\n"
|
||||
"")
|
||||
(format "%-12s %s\n"
|
||||
(key-description keys)
|
||||
this-command))
|
||||
(setf echo-keys-last-record this-command
|
||||
echo-keys-last-record-count 1))))
|
||||
(dolist (window (window-list))
|
||||
(when (eq (window-buffer window) (current-buffer))
|
||||
(with-selected-window window
|
||||
;; We need to use both to get the effect.
|
||||
(set-window-point window (point))
|
||||
(end-of-buffer)))))))))
|
||||
|
||||
(defun toggle-echo-keys ()
|
||||
"Toggle displaying the *echo-key* buffer."
|
||||
(interactive)
|
||||
(if (member 'echo-keys (default-value 'pre-command-hook))
|
||||
(let ((echo-buffer (get-buffer "*echo-keys*")))
|
||||
(remove-hook 'pre-command-hook 'echo-keys)
|
||||
(dolist (window (window-list))
|
||||
(when (eq (window-buffer window) echo-buffer)
|
||||
(delete-window window))))
|
||||
(progn
|
||||
(delete-other-windows)
|
||||
(split-window nil (- (window-width) echo-key-window-width) t)
|
||||
(other-window 1)
|
||||
(switch-to-buffer (get-buffer-create "*echo-keys*"))
|
||||
(unless (eq major-mode 'echo-keys-mode)
|
||||
(echo-keys-mode))
|
||||
(toggle-truncate-lines +1)
|
||||
(set-window-dedicated-p (selected-window) t)
|
||||
(other-window 1)
|
||||
(add-hook 'pre-command-hook 'echo-keys))))
|
||||
|
||||
(defadvice echo-key--read-passwd--disable (before read-passwd)
|
||||
(message "echo-key--read-passwd--disable")
|
||||
(setf echo-key-password-protection t))
|
||||
|
||||
(defadvice echo-key--read-passwd--enable (after read-passwd)
|
||||
(message "echo-key--read-passwd--enable")
|
||||
(setf echo-key-password-protection nil))
|
||||
|
||||
(defun echo-keys-clean ()
|
||||
"Erase the `*echo-keys*' buffer."
|
||||
(interactive)
|
||||
(with-current-buffer "*echo-keys*"
|
||||
(erase-buffer)))
|
||||
|
||||
(defvar echo-keys-mode-map
|
||||
(let ((ek-mode-map (make-sparse-keymap)))
|
||||
(define-key ek-mode-map (kbd "C-c e e") #'toggle-echo-keys)
|
||||
(define-key ek-mode-map (kbd "C-c e c") #'echo-keys-clean)
|
||||
ek-mode-map))
|
||||
|
||||
(define-derived-mode echo-keys-mode fundamental-mode "Echo-keys"
|
||||
"Major mode for echo-keys.")
|
||||
|
||||
(provide 'echo-keys)
|
||||
|
||||
;;; echo-keys.el ends here.
|
||||
21
site-lisp/extensions-local/evals.el
Normal file
21
site-lisp/extensions-local/evals.el
Normal file
@@ -0,0 +1,21 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defun ld-eval-elisp-to-next-line ()
|
||||
"Replace the preceding sexp with its value."
|
||||
(interactive)
|
||||
(let ((value (eval (elisp--preceding-sexp))))
|
||||
(newline-and-indent)
|
||||
(insert (format "%S" value))))
|
||||
|
||||
(defun ld-eval-elisp-and-replace ()
|
||||
"Replace the preceding sexp with its value."
|
||||
(interactive)
|
||||
(let ((value (eval (elisp--preceding-sexp))))
|
||||
(backward-kill-sexp)
|
||||
(insert (format "%S" value))))
|
||||
|
||||
(provide 'evals)
|
||||
|
||||
;;; evals.el ends here
|
||||
81
site-lisp/extensions-local/force-indent.el
Normal file
81
site-lisp/extensions-local/force-indent.el
Normal file
@@ -0,0 +1,81 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; use variable 'tab-width' value as indent size
|
||||
|
||||
(defun force-indent-line ()
|
||||
(let (col)
|
||||
(save-excursion
|
||||
(back-to-indentation)
|
||||
(setq col (+ (current-column) tab-width))
|
||||
(indent-line-to col))
|
||||
(when (< (current-column) col)
|
||||
(back-to-indentation))))
|
||||
|
||||
(defun indent-line ()
|
||||
(interactive)
|
||||
(let ((bt (save-excursion
|
||||
(back-to-indentation)
|
||||
(current-column))))
|
||||
(cond
|
||||
((< (current-column) bt)
|
||||
(back-to-indentation))
|
||||
((looking-at "\\s-*\n")
|
||||
(let ((col (save-excursion
|
||||
(forward-line -1)
|
||||
(back-to-indentation)
|
||||
(current-column))))
|
||||
(if (< (current-column) col)
|
||||
(indent-line-to col)
|
||||
(force-indent-line))))
|
||||
(t
|
||||
(force-indent-line)))))
|
||||
|
||||
(defun un-indent-line ()
|
||||
(interactive)
|
||||
(let (col)
|
||||
(save-excursion
|
||||
(back-to-indentation)
|
||||
(setq col (- (current-column) tab-width))
|
||||
(when (>= col 0)
|
||||
(indent-line-to col)))))
|
||||
|
||||
(defun indent-region (start stop)
|
||||
(interactive "r")
|
||||
(setq stop (copy-marker stop))
|
||||
(goto-char start)
|
||||
(while (< (point) stop)
|
||||
(unless (and (bolp) (eolp))
|
||||
(force-indent-line))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun un-indent-region (start stop)
|
||||
(interactive "r")
|
||||
(setq stop (copy-marker stop))
|
||||
(goto-char start)
|
||||
(while (< (point) stop)
|
||||
(unless (and (bolp) (eolp))
|
||||
(un-indent-line))
|
||||
(forward-line 1)))
|
||||
|
||||
(defun ld-indent ()
|
||||
(interactive)
|
||||
(if (use-region-p)
|
||||
(save-excursion
|
||||
(indent-region (region-beginning) (region-end))
|
||||
(setq deactivate-mark nil))
|
||||
(indent-line)))
|
||||
|
||||
(defun ld-un-indent ()
|
||||
(interactive)
|
||||
(if (use-region-p)
|
||||
(save-excursion
|
||||
(un-indent-region (region-beginning) (region-end))
|
||||
(setq deactivate-mark nil))
|
||||
(un-indent-line)))
|
||||
|
||||
(provide 'force-indent)
|
||||
|
||||
;;; force-indent.el ends here
|
||||
93
site-lisp/extensions-local/frame-restore.el
Normal file
93
site-lisp/extensions-local/frame-restore.el
Normal file
@@ -0,0 +1,93 @@
|
||||
;;; frame-restore.el --- save/restore frame size&position at shutdown/startup
|
||||
|
||||
;; Copyright (C) 2002 by Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Patrick Anderson
|
||||
;; Version: 1.3
|
||||
|
||||
;; This file is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 2, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; This file is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; ChangeLog
|
||||
;; 1.3: simplified install (now just copy one line to .emacs, and eval the next)
|
||||
;; 1.3: added checks for running in terminal
|
||||
;; 1.3: added checks for running on non-w32
|
||||
;; 1.2: added font save/restore
|
||||
;; 1.1: added more descriptive, correct installation docs
|
||||
|
||||
;;;installation:
|
||||
;;1. put this file in your load path and add to your .emacs file (as the last thing) (without the semicolon):
|
||||
;;(require 'frame-restore)
|
||||
;;2. now evaluate the next line (don't uncomment it) [by putting the cursor at the end and pressing C-xC-e]
|
||||
;;(progn (require 'desktop) (customize-set-variable 'desktop-enable t) (desktop-save "~/") (require 'frame-restore))
|
||||
;;3. now change your font using S-down-mouse-1, adjust your frame size, then shutdown/restart emacs to test.
|
||||
;;once installed, i never have problems, but before that, it seems possible to get into strange states. if that happens try:
|
||||
;;1. shutdown emacs
|
||||
;;2. delete .emacs.desktop
|
||||
;;3. restart
|
||||
;;4. follow normal install
|
||||
;;since the font is stored here, don't also store it through a customization of the 'default' face. you may customize that face, just make sure the "Font Family" attribute box is unchecked.
|
||||
|
||||
;;;Code:
|
||||
(require 'cl-lib)
|
||||
|
||||
;this must be global - as that is how desktop-globals-to-save works
|
||||
;(defvar final-frame-params '((frame-parameter (selected-frame) 'font) 50 50 150 50 nil)) ;font, left, top, width, height, maximized
|
||||
(defvar final-frame-params '("-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1" 50 50 150 50 nil)) ;font, left, top, width, height, maximized
|
||||
|
||||
(if window-system
|
||||
(add-hook 'after-init-hook
|
||||
'(lambda()
|
||||
"this is executed as emacs is coming up - _after_ final-frame-params have been read from `.emacs.desktop'."
|
||||
(when desktop-enable
|
||||
(desktop-load-default)
|
||||
(desktop-read)
|
||||
;;now size and position frame according to the values read from disk
|
||||
(set-default-font (first final-frame-params)) ;do font first - as it will goof with the frame size
|
||||
(set-frame-size (selected-frame) (fourth final-frame-params) (fifth final-frame-params))
|
||||
(set-frame-position (selected-frame) (max (eval (second final-frame-params)) 0) (max (eval (third final-frame-params)) 0))
|
||||
(if (sixth final-frame-params)
|
||||
(if (eq window-system 'w32)
|
||||
(w32-send-sys-command ?\xf030)
|
||||
;else, do X something
|
||||
))))))
|
||||
|
||||
(if window-system
|
||||
(add-hook 'desktop-save-hook
|
||||
'(lambda()
|
||||
(let ((maximized (listp (frame-parameter (selected-frame) 'left))))
|
||||
"this hook sets the fram size/pos vars before `desktop.el' writes them out to disk"
|
||||
(if (eq window-system 'w32)
|
||||
(w32-send-sys-command ?\xf120) ;restore the frame (so we can save the 'restored' size/pos)
|
||||
;else, do X something
|
||||
)
|
||||
;;prepend our vars to the save list so `desktop.el' will save them out to disk
|
||||
(setq desktop-globals-to-save (cons 'final-frame-params
|
||||
desktop-globals-to-save))
|
||||
|
||||
(setq final-frame-params
|
||||
(list
|
||||
(frame-parameter (selected-frame) 'font)
|
||||
(frame-parameter (selected-frame) 'left) ;x
|
||||
(frame-parameter (selected-frame) 'top) ;y
|
||||
(frame-width) ;width
|
||||
(frame-height) ;height
|
||||
maximized))))) ;if this frame param is a list, we're probably maximized (not guaranteed)
|
||||
)
|
||||
|
||||
(provide 'frame-restore)
|
||||
;;; frame-restore.el ends here
|
||||
141
site-lisp/extensions-local/goto-last-change.el
Normal file
141
site-lisp/extensions-local/goto-last-change.el
Normal file
@@ -0,0 +1,141 @@
|
||||
;;; 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
|
||||
124
site-lisp/extensions-local/goto-line-preview.el
Normal file
124
site-lisp/extensions-local/goto-line-preview.el
Normal file
@@ -0,0 +1,124 @@
|
||||
;;; goto-line-preview.el --- Preview line when executing `goto-line` command -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2019-2023 Shen, Jen-Chieh
|
||||
;; Created date 2019-03-01 14:53:00
|
||||
|
||||
;; Author: Shen, Jen-Chieh <jcs090218@gmail.com>
|
||||
;; URL: https://github.com/emacs-vs/goto-line-preview
|
||||
;; Version: 0.1.1
|
||||
;; Package-Requires: ((emacs "25"))
|
||||
;; Keywords: convenience line navigation
|
||||
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 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:
|
||||
;;
|
||||
;; Preview line when executing `goto-line` command.
|
||||
;;
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup goto-line-preview nil
|
||||
"Preview line when executing `goto-line` command."
|
||||
:prefix "goto-line-preview-"
|
||||
:group 'convenience
|
||||
:group 'tools
|
||||
:link '(url-link :tag "Repository" "https://github.com/emacs-vs/goto-line-preview"))
|
||||
|
||||
(defcustom goto-line-preview-before-hook nil
|
||||
"Hooks run before `goto-line-preview' is run."
|
||||
:group 'goto-line-preview
|
||||
:type 'hook)
|
||||
|
||||
(defcustom goto-line-preview-after-hook nil
|
||||
"Hooks run after `goto-line-preview' is run."
|
||||
:group 'goto-line-preview
|
||||
:type 'hook)
|
||||
|
||||
(defvar goto-line-preview--prev-window nil
|
||||
"Record down the previous window before we do preivew display.")
|
||||
|
||||
(defvar goto-line-preview--prev-line-num nil
|
||||
"Record down the previous line number before we do preivew display.")
|
||||
|
||||
(defvar goto-line-preview--relative-p nil
|
||||
"Flag to see if this command relative.")
|
||||
|
||||
(defun goto-line-preview--do (line-num)
|
||||
"Do goto LINE-NUM."
|
||||
(save-selected-window
|
||||
(select-window goto-line-preview--prev-window)
|
||||
(goto-char (point-min))
|
||||
(forward-line (1- line-num))))
|
||||
|
||||
(defun goto-line-preview--do-preview ()
|
||||
"Do the goto line preview action."
|
||||
(save-selected-window
|
||||
(when goto-line-preview--prev-window
|
||||
(let ((line-num-str (thing-at-point 'line)))
|
||||
(select-window goto-line-preview--prev-window)
|
||||
(if line-num-str
|
||||
(let ((line-num (string-to-number line-num-str)))
|
||||
(when goto-line-preview--relative-p
|
||||
(setq line-num (+ goto-line-preview--prev-line-num line-num)))
|
||||
(unless (zerop line-num) (goto-line-preview--do line-num)))
|
||||
(goto-line-preview--do goto-line-preview--prev-line-num))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun goto-line-preview ()
|
||||
"Preview goto line."
|
||||
(interactive)
|
||||
(let ((goto-line-preview--prev-window (selected-window))
|
||||
(window-point (window-point))
|
||||
(goto-line-preview--prev-line-num (line-number-at-pos))
|
||||
jumped)
|
||||
(run-hooks 'goto-line-preview-before-hook)
|
||||
(unwind-protect
|
||||
(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) ")
|
||||
goto-line-preview--prev-line-num
|
||||
(max 0 (min 1 lines))
|
||||
lines))))
|
||||
(if jumped
|
||||
(with-current-buffer (window-buffer goto-line-preview--prev-window)
|
||||
(unless (region-active-p) (push-mark window-point)))
|
||||
(set-window-point goto-line-preview--prev-window window-point))
|
||||
(run-hooks 'goto-line-preview-after-hook))))
|
||||
|
||||
;;;###autoload
|
||||
(defun goto-line-preview-relative ()
|
||||
"Preview goto line relative."
|
||||
(interactive)
|
||||
(let ((goto-line-preview--relative-p t))
|
||||
(goto-line-preview)))
|
||||
|
||||
;;;###autoload
|
||||
(define-obsolete-function-alias 'goto-line-preview-goto-line 'goto-line-preview "0.1.1")
|
||||
|
||||
(defun goto-line-preview--minibuffer-setup ()
|
||||
"Locally set up preview hooks for this minibuffer command."
|
||||
(when (memq this-command '(goto-line-preview
|
||||
goto-line-preview-goto-line
|
||||
goto-line-preview-relative))
|
||||
(add-hook 'post-command-hook #'goto-line-preview--do-preview nil t)))
|
||||
|
||||
(add-hook 'minibuffer-setup-hook 'goto-line-preview--minibuffer-setup)
|
||||
|
||||
(provide 'goto-line-preview)
|
||||
;;; goto-line-preview.el ends here
|
||||
312
site-lisp/extensions-local/highlight-indentation.el
Normal file
312
site-lisp/extensions-local/highlight-indentation.el
Normal file
@@ -0,0 +1,312 @@
|
||||
;;; highlight-indentation.el --- Minor modes for highlighting indentation
|
||||
;; Author: Anton Johansson <anton.johansson@gmail.com> - http://antonj.se
|
||||
;; Created: Dec 15 23:42:04 2010
|
||||
;; Version: 0.7.0
|
||||
;; URL: https://github.com/antonj/Highlight-Indentation-for-Emacs
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License as
|
||||
;; published by the Free Software Foundation; either version 2 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be
|
||||
;; useful, but WITHOUT ANY WARRANTY; without even the implied
|
||||
;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
|
||||
;; PURPOSE. See the GNU General Public License for more details.
|
||||
;;
|
||||
;;; Commentary:
|
||||
;; Customize `highlight-indentation-face', and
|
||||
;; `highlight-indentation-current-column-face' to suit your theme.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(defgroup highlight-indentation nil
|
||||
"Highlight Indentation"
|
||||
:prefix "highlight-indentation-"
|
||||
:group 'basic-faces)
|
||||
|
||||
(defface highlight-indentation-face
|
||||
;; Fringe has non intrusive color in most color-themes
|
||||
'((t :inherit fringe))
|
||||
"Basic face for highlighting indentation guides."
|
||||
:group 'highlight-indentation)
|
||||
|
||||
(defcustom highlight-indentation-offset
|
||||
(if (and (boundp 'standard-indent) standard-indent) standard-indent 2)
|
||||
"Default indentation offset, used if no other can be found from
|
||||
major mode. This value is always used by
|
||||
`highlight-indentation-mode' if set buffer local. Set buffer
|
||||
local with `highlight-indentation-set-offset'"
|
||||
:type 'integer
|
||||
:group 'highlight-indentation)
|
||||
|
||||
(defcustom highlight-indentation-blank-lines nil
|
||||
"Show indentation guides on blank lines. Experimental.
|
||||
Known issues:
|
||||
- Doesn't work well with completion popups that use overlays
|
||||
- Overlays on blank lines sometimes aren't cleaned up or updated perfectly
|
||||
Can be refreshed by scrolling
|
||||
- Not yet implemented for highlight-indentation-current-column-mode
|
||||
- May not work perfectly near the bottom of the screen
|
||||
- Point appears after indent guides on blank lines"
|
||||
:type 'boolean
|
||||
:group 'highlight-indentation)
|
||||
|
||||
(defvar highlight-indentation-overlay-priority 1)
|
||||
(defvar highlight-indentation-current-column-overlay-priority 2)
|
||||
|
||||
(defconst highlight-indentation-hooks
|
||||
'((after-change-functions (lambda (start end length)
|
||||
(highlight-indentation-redraw-region
|
||||
start end
|
||||
'highlight-indentation-overlay
|
||||
'highlight-indentation-put-overlays-region))
|
||||
t t)
|
||||
(window-scroll-functions (lambda (win start)
|
||||
(highlight-indentation-redraw-window
|
||||
win
|
||||
'highlight-indentation-overlay
|
||||
'highlight-indentation-put-overlays-region
|
||||
start))
|
||||
nil t)))
|
||||
|
||||
(defun highlight-indentation-get-buffer-windows (&optional all-frames)
|
||||
"Return a list of windows displaying the current buffer."
|
||||
(get-buffer-window-list (current-buffer) 'no-minibuf all-frames))
|
||||
|
||||
(defun highlight-indentation-delete-overlays-buffer (overlay)
|
||||
"Delete all overlays in the current buffer."
|
||||
(save-restriction
|
||||
(widen)
|
||||
(highlight-indentation-delete-overlays-region (point-min) (point-max) overlay)))
|
||||
|
||||
(defun highlight-indentation-delete-overlays-region (start end overlay)
|
||||
"Delete overlays between START and END."
|
||||
(mapc #'(lambda (o)
|
||||
(if (overlay-get o overlay) (delete-overlay o)))
|
||||
(overlays-in start end)))
|
||||
|
||||
(defun highlight-indentation-redraw-window (win overlay func &optional start)
|
||||
"Redraw win starting from START."
|
||||
(highlight-indentation-redraw-region (or start (window-start win)) (window-end win t) overlay func))
|
||||
|
||||
(defun highlight-indentation-redraw-region (start end overlay func)
|
||||
"Erase and read overlays between START and END."
|
||||
(save-match-data
|
||||
(save-excursion
|
||||
(let ((inhibit-point-motion-hooks t)
|
||||
(start (save-excursion (goto-char start) (beginning-of-line) (point)))
|
||||
|
||||
(end (save-excursion (goto-char end) (line-beginning-position 2))))
|
||||
(highlight-indentation-delete-overlays-region start end overlay)
|
||||
(funcall func start end overlay)))))
|
||||
|
||||
(defun highlight-indentation-redraw-all-windows (overlay func &optional all-frames)
|
||||
"Redraw the all windows showing the current buffer."
|
||||
(dolist (win (highlight-indentation-get-buffer-windows all-frames))
|
||||
(highlight-indentation-redraw-window win overlay func)))
|
||||
|
||||
(defun highlight-indentation-put-overlays-region (start end overlay)
|
||||
"Place overlays between START and END."
|
||||
(goto-char end)
|
||||
(let (o ;; overlay
|
||||
(last-indent 0)
|
||||
(last-char 0)
|
||||
(pos (point))
|
||||
(loop t))
|
||||
(while (and loop
|
||||
(>= pos start))
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(let ((c 0)
|
||||
(cur-column (current-column)))
|
||||
(while (and (setq c (char-after))
|
||||
(integerp c)
|
||||
(not (= 10 c)) ;; newline
|
||||
(= 32 c)) ;; space
|
||||
(when (= 0 (% cur-column highlight-indentation-offset))
|
||||
(let ((p (point)))
|
||||
(setq o (make-overlay p (+ p 1))))
|
||||
(overlay-put o overlay t)
|
||||
(overlay-put o 'priority highlight-indentation-overlay-priority)
|
||||
(overlay-put o 'face 'highlight-indentation-face))
|
||||
(forward-char)
|
||||
(setq cur-column (current-column)))
|
||||
(when (and highlight-indentation-blank-lines
|
||||
(integerp c)
|
||||
(or (= 10 c)
|
||||
(= 13 c)))
|
||||
(when (< cur-column last-indent)
|
||||
(let ((column cur-column)
|
||||
(s nil)
|
||||
(show t)
|
||||
num-spaces)
|
||||
(while (< column last-indent)
|
||||
(if (>= 0
|
||||
(setq num-spaces
|
||||
(%
|
||||
(- last-indent column)
|
||||
highlight-indentation-offset)))
|
||||
(progn
|
||||
(setq num-spaces (1- highlight-indentation-offset))
|
||||
(setq show t))
|
||||
(setq show nil))
|
||||
(setq s (cons (concat
|
||||
(if show
|
||||
(propertize " "
|
||||
'face
|
||||
'highlight-indentation-face)
|
||||
"")
|
||||
(make-string num-spaces 32))
|
||||
s))
|
||||
(setq column (+ column num-spaces (if show 1 0))))
|
||||
(setq s (apply 'concat (reverse s)))
|
||||
(let ((p (point)))
|
||||
(setq o (make-overlay p p)))
|
||||
(overlay-put o overlay t)
|
||||
(overlay-put o 'priority highlight-indentation-overlay-priority)
|
||||
(overlay-put o 'after-string s))
|
||||
(setq cur-column last-indent)))
|
||||
(setq last-indent (* highlight-indentation-offset
|
||||
(ceiling (/ (float cur-column)
|
||||
highlight-indentation-offset))))))
|
||||
(when (= pos start)
|
||||
(setq loop nil))
|
||||
(forward-line -1) ;; previous line
|
||||
(setq pos (point)))))
|
||||
|
||||
(defun highlight-indentation-guess-offset ()
|
||||
"Get indentation offset of current buffer."
|
||||
(cond ((and (eq major-mode 'python-mode) (boundp 'python-indent))
|
||||
python-indent)
|
||||
((and (eq major-mode 'python-mode) (boundp 'py-indent-offset))
|
||||
py-indent-offset)
|
||||
((and (eq major-mode 'python-mode) (boundp 'python-indent-offset))
|
||||
python-indent-offset)
|
||||
((and (eq major-mode 'ruby-mode) (boundp 'ruby-indent-level))
|
||||
ruby-indent-level)
|
||||
((and (eq major-mode 'scala-mode) (boundp 'scala-indent:step))
|
||||
scala-indent:step)
|
||||
((and (eq major-mode 'scala-mode) (boundp 'scala-mode-indent:step))
|
||||
scala-mode-indent:step)
|
||||
((and (or (eq major-mode 'scss-mode) (eq major-mode 'css-mode)) (boundp 'css-indent-offset))
|
||||
css-indent-offset)
|
||||
((and (eq major-mode 'nxml-mode) (boundp 'nxml-child-indent))
|
||||
nxml-child-indent)
|
||||
((and (eq major-mode 'coffee-mode) (boundp 'coffee-tab-width))
|
||||
coffee-tab-width)
|
||||
((and (eq major-mode 'js-mode) (boundp 'js-indent-level))
|
||||
js-indent-level)
|
||||
((and (eq major-mode 'js2-mode) (boundp 'js2-basic-offset))
|
||||
js2-basic-offset)
|
||||
((and (fboundp 'derived-mode-class) (eq (derived-mode-class major-mode) 'sws-mode) (boundp 'sws-tab-width))
|
||||
sws-tab-width)
|
||||
((and (eq major-mode 'web-mode) (boundp 'web-mode-markup-indent-offset))
|
||||
web-mode-markup-indent-offset) ; other similar vars: web-mode-{css-indent,scripts}-offset
|
||||
((and (eq major-mode 'web-mode) (boundp 'web-mode-html-offset)) ; old var
|
||||
web-mode-html-offset)
|
||||
((and (local-variable-p 'c-basic-offset) (boundp 'c-basic-offset))
|
||||
c-basic-offset)
|
||||
((and (eq major-mode 'yaml-mode) (boundp 'yaml-indent-offset))
|
||||
yaml-indent-offset)
|
||||
((and (eq major-mode 'elixir-mode) (boundp 'elixir-smie-indent-basic))
|
||||
elixir-smie-indent-basic)
|
||||
(t
|
||||
(default-value 'highlight-indentation-offset))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode highlight-indentation-mode
|
||||
"Highlight indentation minor mode highlights indentation based on spaces"
|
||||
:lighter " ||"
|
||||
(when (not highlight-indentation-mode) ;; OFF
|
||||
(highlight-indentation-delete-overlays-buffer 'highlight-indentation-overlay)
|
||||
(dolist (hook highlight-indentation-hooks)
|
||||
(remove-hook (car hook) (nth 1 hook) (nth 3 hook))))
|
||||
|
||||
(when highlight-indentation-mode ;; ON
|
||||
(when (not (local-variable-p 'highlight-indentation-offset))
|
||||
(set (make-local-variable 'highlight-indentation-offset)
|
||||
(highlight-indentation-guess-offset)))
|
||||
|
||||
;; Setup hooks
|
||||
(dolist (hook highlight-indentation-hooks)
|
||||
(apply 'add-hook hook))
|
||||
(highlight-indentation-redraw-all-windows 'highlight-indentation-overlay
|
||||
'highlight-indentation-put-overlays-region)))
|
||||
|
||||
;;;###autoload
|
||||
(defun highlight-indentation-set-offset (offset)
|
||||
"Set indentation offset locally in buffer, will prevent
|
||||
highlight-indentation from trying to guess indentation offset
|
||||
from major mode"
|
||||
(interactive
|
||||
(if (and current-prefix-arg (not (consp current-prefix-arg)))
|
||||
(list (prefix-numeric-value current-prefix-arg))
|
||||
(list (read-number "Indentation offset: "))))
|
||||
(set (make-local-variable 'highlight-indentation-offset) offset)
|
||||
(when highlight-indentation-mode
|
||||
(highlight-indentation-mode)))
|
||||
|
||||
;;; This minor mode will highlight the indentation of the current line
|
||||
;;; as a vertical bar (grey background color) aligned with the column of the
|
||||
;;; first character of the current line.
|
||||
(defface highlight-indentation-current-column-face
|
||||
;; Fringe has non intrusive color in most color-themes
|
||||
'((t (:background "black")))
|
||||
"Basic face for highlighting indentation guides."
|
||||
:group 'highlight-indentation)
|
||||
|
||||
(defconst highlight-indentation-current-column-hooks
|
||||
'((post-command-hook (lambda ()
|
||||
(highlight-indentation-redraw-all-windows 'highlight-indentation-current-column-overlay
|
||||
'highlight-indentation-current-column-put-overlays-region)) nil t)))
|
||||
|
||||
(defun highlight-indentation-current-column-put-overlays-region (start end overlay)
|
||||
"Place overlays between START and END."
|
||||
(let (o ;; overlay
|
||||
(last-indent 0)
|
||||
(indent (save-excursion (back-to-indentation) (current-column)))
|
||||
(pos start))
|
||||
(goto-char start)
|
||||
;; (message "doing it %d" indent)
|
||||
(while (< pos end)
|
||||
(beginning-of-line)
|
||||
(while (and (integerp (char-after))
|
||||
(not (= 10 (char-after))) ;; newline
|
||||
(= 32 (char-after))) ;; space
|
||||
(when (= (current-column) indent)
|
||||
(setq pos (point)
|
||||
last-indent pos
|
||||
o (make-overlay pos (+ pos 1)))
|
||||
(overlay-put o overlay t)
|
||||
(overlay-put o 'priority highlight-indentation-current-column-overlay-priority)
|
||||
(overlay-put o 'face 'highlight-indentation-current-column-face))
|
||||
(forward-char))
|
||||
(forward-line) ;; Next line
|
||||
(setq pos (point)))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode highlight-indentation-current-column-mode
|
||||
"Highlight Indentation minor mode displays a vertical bar
|
||||
corresponding to the indentation of the current line"
|
||||
:lighter " |"
|
||||
|
||||
(when (not highlight-indentation-current-column-mode) ;; OFF
|
||||
(highlight-indentation-delete-overlays-buffer 'highlight-indentation-current-column-overlay)
|
||||
(dolist (hook highlight-indentation-current-column-hooks)
|
||||
(remove-hook (car hook) (nth 1 hook) (nth 3 hook))))
|
||||
|
||||
(when highlight-indentation-current-column-mode ;; ON
|
||||
(when (not (local-variable-p 'highlight-indentation-offset))
|
||||
(set (make-local-variable 'highlight-indentation-offset)
|
||||
(highlight-indentation-guess-offset)))
|
||||
|
||||
;; Setup hooks
|
||||
(dolist (hook highlight-indentation-current-column-hooks)
|
||||
(apply 'add-hook hook))
|
||||
(highlight-indentation-redraw-all-windows 'highlight-indentation-current-column-overlay
|
||||
'highlight-indentation-current-column-put-overlays-region)))
|
||||
|
||||
(provide 'highlight-indentation)
|
||||
|
||||
;;; highlight-indentation.el ends here
|
||||
157
site-lisp/extensions-local/highlight-parentheses.el
Normal file
157
site-lisp/extensions-local/highlight-parentheses.el
Normal file
@@ -0,0 +1,157 @@
|
||||
;;; highlight-parentheses.el --- highlight surrounding parentheses
|
||||
;;
|
||||
;; Copyright (C) 2007 Nikolaj Schumacher
|
||||
;;
|
||||
;; Author: Nikolaj Schumacher <bugs * nschum de>
|
||||
;; Version: 1.0
|
||||
;; Keywords: faces, matching
|
||||
;; URL: http://nschum.de/src/emacs/highlight-parentheses/
|
||||
;; Compatibility: GNU Emacs 22.x
|
||||
;;
|
||||
;; This file is NOT part of GNU Emacs.
|
||||
;;
|
||||
;; This program is free software; you can redistribute it and/or
|
||||
;; modify it under the terms of the GNU General Public License
|
||||
;; as published by the Free Software Foundation; either version 2
|
||||
;; of the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; 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:
|
||||
;;
|
||||
;; Add the following to your .emacs file:
|
||||
;; (require 'highlight-parentheses)
|
||||
;;
|
||||
;; Enable `highlight-symbol-mode'.
|
||||
;;
|
||||
;;; Changes Log:
|
||||
;;
|
||||
;; 2007-07-30 (1.0)
|
||||
;; Added background highlighting and faces.
|
||||
;;
|
||||
;; 2007-05-15 (0.9.1)
|
||||
;; Support for defcustom. Changed from vector to list.
|
||||
;;
|
||||
;; 2007-04-26 (0.9)
|
||||
;; Initial Release.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(defgroup highlight-parentheses nil
|
||||
"Highlight surrounding parentheses"
|
||||
:group 'faces
|
||||
:group 'matching)
|
||||
|
||||
(defvar hl-paren-overlays nil
|
||||
"This buffers currently active overlays.")
|
||||
(make-variable-buffer-local 'hl-paren-overlays)
|
||||
|
||||
(defcustom hl-paren-colors
|
||||
'("firebrick1" "IndianRed4" "IndianRed")
|
||||
"*List of colors for the highlighted parentheses.
|
||||
The list starts with the the inside parentheses and moves outwards."
|
||||
:type '(repeat color)
|
||||
:group 'highlight-parentheses)
|
||||
|
||||
(defcustom hl-paren-background-colors nil
|
||||
"*List of colors for the background highlighted parentheses.
|
||||
The list starts with the the inside parentheses and moves outwards."
|
||||
:type '(repeat color)
|
||||
:group 'highlight-parentheses)
|
||||
|
||||
(defface hl-paren-face nil
|
||||
"*Face used for highlighting parentheses.
|
||||
Color attributes might be overriden by `hl-paren-colors' and
|
||||
`hl-paren-background-colors'."
|
||||
:group 'highlight-parentheses)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defvar hl-paren-last-point 0
|
||||
"The last point for which parentheses were highlighted.
|
||||
This is used to prevent analyzing the same context over and over.")
|
||||
(make-variable-buffer-local 'hl-paren-last-point)
|
||||
|
||||
(defun hl-paren-highlight ()
|
||||
"Highlight the parentheses around point."
|
||||
(unless (= (point) hl-paren-last-point)
|
||||
(save-excursion
|
||||
(let ((pos (point))
|
||||
(match-pos (point))
|
||||
(level -1)
|
||||
(max (1- (length hl-paren-overlays))))
|
||||
(while (and match-pos (< level max))
|
||||
(setq match-pos
|
||||
(when (setq pos (cadr (syntax-ppss pos)))
|
||||
(ignore-errors (scan-sexps pos 1))))
|
||||
(when match-pos
|
||||
(hl-paren-put-overlay (cl-incf level) pos 'hl-paren-face)
|
||||
(hl-paren-put-overlay (cl-incf level) (1- match-pos) 'hl-paren-face)))
|
||||
(while (< level max)
|
||||
(hl-paren-put-overlay (cl-incf level) nil nil))))
|
||||
(setq hl-paren-last-point (point))))
|
||||
|
||||
(defun hl-paren-put-overlay (n pos face)
|
||||
"Move or create the N'th overlay so its shown at POS."
|
||||
(let ((ov (elt hl-paren-overlays n)) end)
|
||||
(if (null pos)
|
||||
(when ov
|
||||
(delete-overlay ov)
|
||||
(aset hl-paren-overlays n nil))
|
||||
(if (atom pos)
|
||||
(setq end (1+ pos))
|
||||
(setq end (cdr pos))
|
||||
(setq pos (car pos)))
|
||||
(if ov
|
||||
(move-overlay ov pos end)
|
||||
(let ((face-attributes (face-attr-construct face))
|
||||
(color-value (nth (/ n 2) hl-paren-colors))
|
||||
(background-value (nth (/ n 2) hl-paren-background-colors)))
|
||||
(when color-value
|
||||
(let ((attribute (memq :foreground face-attributes)))
|
||||
(if attribute
|
||||
(setcar (cdr attribute) color-value)
|
||||
(push color-value face-attributes)
|
||||
(push :foreground face-attributes))))
|
||||
(when background-value
|
||||
(let ((attribute (memq :background face-attributes)))
|
||||
(if attribute
|
||||
(setcar (cdr attribute) background-value)
|
||||
(push background-value face-attributes)
|
||||
(push :background face-attributes))))
|
||||
(setq ov (make-overlay pos end))
|
||||
(aset hl-paren-overlays n ov)
|
||||
(overlay-put ov 'face face-attributes))))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode highlight-parentheses-mode
|
||||
"Minor mode to highlight the surrounding parentheses."
|
||||
:init-value nil
|
||||
:lighter " hl-p"
|
||||
:keymap nil
|
||||
(if highlight-parentheses-mode
|
||||
(progn
|
||||
(setq hl-paren-overlays
|
||||
(make-vector (* 2 (max (length hl-paren-colors)
|
||||
(length hl-paren-background-colors))) nil))
|
||||
(add-hook 'post-command-hook 'hl-paren-highlight nil t))
|
||||
(let (ov)
|
||||
(dotimes (i (length hl-paren-overlays))
|
||||
(when (setq ov (elt hl-paren-overlays i))
|
||||
(delete-overlay ov))))
|
||||
(kill-local-variable 'hl-paren-overlays)
|
||||
(kill-local-variable 'hl-paren-point)
|
||||
(remove-hook 'post-command-hook 'hl-paren-highlight t)))
|
||||
|
||||
(provide 'highlight-parentheses)
|
||||
|
||||
;;; highlight-parentheses.el ends here
|
||||
49
site-lisp/extensions-local/lazy-load.el
Normal file
49
site-lisp/extensions-local/lazy-load.el
Normal file
@@ -0,0 +1,49 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defun lazy-load-global-keys (key-alist filename &optional key-prefix)
|
||||
(lazy-load-set-keys key-alist nil key-prefix)
|
||||
(dolist (element key-alist)
|
||||
(setq fun (cdr element))
|
||||
(autoload fun filename nil t)))
|
||||
|
||||
(defun lazy-load-local-keys (key-alist keymap filename &optional key-prefix)
|
||||
(lazy-load-set-keys key-alist keymap key-prefix)
|
||||
(dolist (element key-alist)
|
||||
(setq fun (cdr element))
|
||||
(autoload fun filename nil t)))
|
||||
|
||||
(defun lazy-load-set-keys (key-alist &optional keymap key-prefix)
|
||||
"This function is to little type when define key binding.
|
||||
`KEYMAP' is a add keymap for some binding, default is `current-global-map'.
|
||||
`KEY-ALIST' is a alist contain main-key and command.
|
||||
`KEY-PREFIX' is a add prefix for some binding, default is nil."
|
||||
(let (key def)
|
||||
(or keymap (setq keymap (current-global-map)))
|
||||
(if key-prefix
|
||||
(setq key-prefix (concat key-prefix " "))
|
||||
(setq key-prefix ""))
|
||||
(dolist (element key-alist)
|
||||
(setq key (car element))
|
||||
(setq def (cdr element))
|
||||
(cond ((stringp key) (setq key (read-kbd-macro (concat key-prefix key))))
|
||||
((vectorp key) nil)
|
||||
(t (signal 'wrong-type-argument (list 'array key))))
|
||||
(define-key keymap key def))))
|
||||
|
||||
(defun lazy-load-unset-keys (key-list &optional keymap)
|
||||
"This function is to little type when unset key binding.
|
||||
`KEYMAP' is add keymap for some binding, default is `current-global-map'
|
||||
`KEY-LIST' is list contain key."
|
||||
(let (key)
|
||||
(or keymap (setq keymap (current-global-map)))
|
||||
(dolist (key key-list)
|
||||
(cond ((stringp key) (setq key (read-kbd-macro (concat key))))
|
||||
((vectorp key) nil)
|
||||
(t (signal 'wrong-type-argument (list 'array key))))
|
||||
(define-key keymap key nil))))
|
||||
|
||||
(provide 'lazy-load)
|
||||
|
||||
;;; lazy-load.el ends here
|
||||
72
site-lisp/extensions-local/ld-buffer-operations.el
Normal file
72
site-lisp/extensions-local/ld-buffer-operations.el
Normal file
@@ -0,0 +1,72 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defun ld-indent-buffer ()
|
||||
"Automatic format current buffer."
|
||||
(interactive)
|
||||
(cond
|
||||
((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."))
|
||||
(t
|
||||
(save-excursion
|
||||
(indent-region (point-min) (point-max) nil)
|
||||
(delete-trailing-whitespace)
|
||||
(untabify (point-min) (point-max))))))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-rename-file-and-buffer ()
|
||||
"Rename current buffer and if the buffer is visiting a file, rename it too."
|
||||
(interactive)
|
||||
(let ((filename (buffer-file-name)))
|
||||
(if (not (and filename (file-exists-p filename)))
|
||||
(rename-buffer (read-from-minibuffer "New name: " (buffer-name)))
|
||||
(let* ((new-name (read-file-name "New name: " (file-name-directory filename)))
|
||||
(containing-dir (file-name-directory new-name)))
|
||||
(make-directory containing-dir t)
|
||||
(cond
|
||||
((vc-backend filename) (vc-rename-file filename new-name))
|
||||
(t
|
||||
(rename-file filename new-name t)
|
||||
(set-visited-file-name new-name t t)))))))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-delete-file-and-buffer ()
|
||||
"Kill the current buffer and deletes the file it is visiting."
|
||||
(interactive)
|
||||
(let ((filename (buffer-file-name)))
|
||||
(when filename
|
||||
(if (vc-backend filename)
|
||||
(vc-delete-file filename)
|
||||
(when (y-or-n-p (format "Sure to delete %s? " filename))
|
||||
(delete-file filename delete-by-moving-to-trash)
|
||||
(message "Deleted file %s" filename)
|
||||
(kill-buffer))))))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-revert-buffer-no-confirm ()
|
||||
"Revert buffer without confirmation."
|
||||
(interactive)
|
||||
(revert-buffer :ignore-auto :noconfirm))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-unmark-all-buffers ()
|
||||
"Unmark all have marked buffers."
|
||||
(interactive)
|
||||
(let ((current-element (current-buffer)))
|
||||
(save-excursion
|
||||
(dolist (element (buffer-list))
|
||||
(set-buffer element)
|
||||
(deactivate-mark)))
|
||||
(switch-to-buffer current-element)
|
||||
(deactivate-mark)))
|
||||
|
||||
(provide 'ld-buffer-operations)
|
||||
|
||||
;;; ld-buffer-operations.el ends here
|
||||
38
site-lisp/extensions-local/ld-delete-block.el
Normal file
38
site-lisp/extensions-local/ld-delete-block.el
Normal file
@@ -0,0 +1,38 @@
|
||||
;; -*- 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
|
||||
14
site-lisp/extensions-local/ld-file-operations.el
Normal file
14
site-lisp/extensions-local/ld-file-operations.el
Normal file
@@ -0,0 +1,14 @@
|
||||
;; -*- 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
|
||||
39
site-lisp/extensions-local/ld-goto-cursor-stack.el
Normal file
39
site-lisp/extensions-local/ld-goto-cursor-stack.el
Normal file
@@ -0,0 +1,39 @@
|
||||
;; -*- 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
|
||||
30
site-lisp/extensions-local/ld-goto-simple.el
Normal file
30
site-lisp/extensions-local/ld-goto-simple.el
Normal file
@@ -0,0 +1,30 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defun ld-goto-column (number)
|
||||
"Untabify, and go to a column NUMBER within the current line (0 is beginning of the line)."
|
||||
(interactive "nColumn number: ")
|
||||
(move-to-column number t))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-goto-percent-text (percent)
|
||||
"Move the cursor to the character,
|
||||
which is <percent>% far from the top character."
|
||||
(interactive "n(text) Goto percent: ")
|
||||
(goto-char (/ (* percent (point-max)) 100)))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-goto-percent-line (percent)
|
||||
"Move the cursor to the line,
|
||||
which is <percent>% far from the top line."
|
||||
(interactive "n(line) Goto percent: ")
|
||||
(goto-line (/ (* percent (count-lines (point-min) (point-max)))
|
||||
100)))
|
||||
|
||||
(provide 'ld-goto-simple)
|
||||
|
||||
;;; ld-goto-simple.el ends here
|
||||
|
||||
106
site-lisp/extensions-local/ld-org-publish-project-desc.el
Normal file
106
site-lisp/extensions-local/ld-org-publish-project-desc.el
Normal file
@@ -0,0 +1,106 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(setq
|
||||
org-publish-project-alist
|
||||
(let* ((ld-site-path "~/Documents/ld_org_article/")
|
||||
(ld-site-pub-path "~/Public/ld_org_article_publish/")
|
||||
(get-content (lambda (x)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (concat ld-site-path x))
|
||||
(buffer-string))))
|
||||
(ld-site-postamble (funcall get-content "template/postamble.html"))
|
||||
(ld-site-preamble (funcall get-content "template/preamble.html"))
|
||||
(ld-site-head (funcall get-content "template/head.html")))
|
||||
`(
|
||||
("blog"
|
||||
:base-directory ,(concat ld-site-path "article/blog/")
|
||||
:base-extension "org"
|
||||
:publishing-directory ,(concat ld-site-pub-path "article/blog/")
|
||||
:publishing-function org-html-publish-to-html
|
||||
:recursive t
|
||||
:headline-levels 4
|
||||
|
||||
:auto-sitemap t
|
||||
:sitemap-filename "sitemap-index.org"
|
||||
:sitemap-title "blog"
|
||||
|
||||
:html-doctype "html5"
|
||||
:html-head ,ld-site-head
|
||||
:html-preamble ,ld-site-preamble
|
||||
:html-postamble ,ld-site-postamble
|
||||
;; :htmlized-source t
|
||||
|
||||
:with-toc t
|
||||
)
|
||||
("wiki"
|
||||
:base-directory ,(concat ld-site-path "article/wiki/")
|
||||
:base-extension "org"
|
||||
:publishing-directory ,(concat ld-site-pub-path "article/wiki/")
|
||||
:publishing-function org-html-publish-to-html
|
||||
:recursive t
|
||||
:headline-levels 4
|
||||
|
||||
:auto-sitemap t
|
||||
:sitemap-filename "sitemap-index.org"
|
||||
:sitemap-title "wiki"
|
||||
|
||||
:html-doctype "html5"
|
||||
:html-head ,ld-site-head
|
||||
:html-preamble ,ld-site-preamble
|
||||
:html-postamble ,ld-site-postamble
|
||||
;; :htmlized-source t
|
||||
|
||||
:with-toc t
|
||||
)
|
||||
("translation"
|
||||
:base-directory ,(concat ld-site-path "article/translation/")
|
||||
:base-extension "org"
|
||||
:publishing-directory ,(concat ld-site-pub-path "article/translation/")
|
||||
:publishing-function org-html-publish-to-html
|
||||
:recursive t
|
||||
:headline-levels 4
|
||||
|
||||
:auto-sitemap t
|
||||
:sitemap-filename "sitemap-index.org"
|
||||
:sitemap-title "translation"
|
||||
|
||||
:html-doctype "html5"
|
||||
:html-head ,ld-site-head
|
||||
:html-preamble ,ld-site-preamble
|
||||
:html-postamble ,ld-site-postamble
|
||||
;; :htmlized-source t
|
||||
|
||||
:with-toc t
|
||||
)
|
||||
("site"
|
||||
:base-directory ,(concat ld-site-path "article/site/")
|
||||
:base-extension "org"
|
||||
:publishing-directory ,(concat ld-site-pub-path "article/site/")
|
||||
:publishing-function org-html-publish-to-html
|
||||
:recursive t
|
||||
:headline-levels 4
|
||||
|
||||
:html-doctype "html5"
|
||||
:html-head ,ld-site-head
|
||||
:html-preamble ,ld-site-preamble
|
||||
:html-postamble ,ld-site-postamble
|
||||
;; :htmlized-source t
|
||||
|
||||
:with-toc nil
|
||||
)
|
||||
("static"
|
||||
:base-directory ,(concat ld-site-path "article_static/")
|
||||
;; :base-extension "css\\|js\\|ico\\|png\\|jpg\\|gif\\|zip\\|7z\\|rar\\|pdf"
|
||||
:base-extension ".*"
|
||||
:publishing-directory ,(concat ld-site-pub-path "/article_static")
|
||||
:publishing-function org-publish-attachment
|
||||
:recursive t
|
||||
)
|
||||
("all" :components ("blog" "wiki" "site" "translation" "static"))
|
||||
)))
|
||||
|
||||
(provide 'ld-org-publish-project-desc)
|
||||
|
||||
;;; ld-org-publish-project-desc.el ends here
|
||||
109
site-lisp/extensions-local/ld-text-operations.el
Normal file
109
site-lisp/extensions-local/ld-text-operations.el
Normal file
@@ -0,0 +1,109 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
; --- move lines
|
||||
(defun ld-move-text-internal (arg)
|
||||
(cond
|
||||
((and mark-active transient-mark-mode)
|
||||
(if (> (point) (mark))
|
||||
(exchange-point-and-mark))
|
||||
(let ((column (current-column))
|
||||
(text (delete-and-extract-region (point) (mark))))
|
||||
(forward-line arg)
|
||||
(move-to-column column t)
|
||||
(set-mark (point))
|
||||
(insert text)
|
||||
(exchange-point-and-mark)
|
||||
(setq deactivate-mark nil)))
|
||||
(t
|
||||
(beginning-of-line)
|
||||
(when (or (> arg 0) (not (bobp)))
|
||||
(forward-line)
|
||||
(when (or (< arg 0) (not (eobp)))
|
||||
(transpose-lines arg))
|
||||
(forward-line -1)))))
|
||||
|
||||
(defun ld-move-text-down (arg)
|
||||
"Move region (transient-mark-mode active) or current line
|
||||
arg lines down."
|
||||
(interactive "*p")
|
||||
(ld-move-text-internal arg))
|
||||
|
||||
(defun ld-move-text-up (arg)
|
||||
"Move region (transient-mark-mode active) or current line
|
||||
arg lines up."
|
||||
(interactive "*p")
|
||||
(ld-move-text-internal (- arg)))
|
||||
|
||||
; --- duplicate line
|
||||
(defun ld-get-positions-of-line-or-region ()
|
||||
"Return positions (beg . end) of the current line or region."
|
||||
(let (beg end)
|
||||
(if (and mark-active (> (point) (mark)))
|
||||
(exchange-point-and-mark))
|
||||
(setq beg (line-beginning-position))
|
||||
(if mark-active
|
||||
(exchange-point-and-mark))
|
||||
(setq end (line-end-position))
|
||||
(cons beg end)))
|
||||
|
||||
(defun ld-duplicate-current-line-or-region (arg)
|
||||
"Duplicates the current line or region ARG times.
|
||||
If there's no region, the current line will be duplicated. However, if
|
||||
there's a region, all lines that region covers will be duplicated."
|
||||
(interactive "p")
|
||||
(pcase-let* ((origin (point))
|
||||
(`(,beg . ,end) (ld-get-positions-of-line-or-region))
|
||||
(region (buffer-substring-no-properties beg end)))
|
||||
(dotimes (_i arg)
|
||||
(goto-char end)
|
||||
(unless (use-region-p)
|
||||
(newline))
|
||||
(insert region)
|
||||
(setq end (point)))
|
||||
(goto-char (+ origin (* (length region) arg) arg))))
|
||||
|
||||
(defun ld-duplicate-and-comment-current-line-or-region (arg)
|
||||
"Duplicates and comments the current line or region ARG times.
|
||||
If there's no region, the current line will be duplicated. However, if
|
||||
there's a region, all lines that region covers will be duplicated."
|
||||
(interactive "p")
|
||||
(pcase-let* ((origin (point))
|
||||
(`(,beg . ,end) (ld-get-positions-of-line-or-region))
|
||||
(region (buffer-substring-no-properties beg end)))
|
||||
(comment-or-uncomment-region beg end)
|
||||
(setq end (line-end-position))
|
||||
(dotimes (_ arg)
|
||||
(goto-char end)
|
||||
(unless (use-region-p)
|
||||
(newline))
|
||||
(insert region)
|
||||
(setq end (point)))
|
||||
(goto-char (+ origin (* (length region) arg) arg))))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-delete-current-line ()
|
||||
"Delete (not kill) the current line."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(delete-region
|
||||
(progn (forward-visible-line 0) (point))
|
||||
(progn (forward-visible-line 1) (point)))))
|
||||
|
||||
; ---
|
||||
|
||||
(defun ld-mark-line ()
|
||||
"Mark one whole line, similar to `mark-paragraph'."
|
||||
(interactive)
|
||||
(beginning-of-line)
|
||||
(if mark-active
|
||||
(exchange-point-and-mark)
|
||||
(push-mark nil nil t))
|
||||
(forward-line)
|
||||
(exchange-point-and-mark))
|
||||
|
||||
(provide 'ld-text-operations)
|
||||
|
||||
;;; ld-text-operations.el ends here
|
||||
22
site-lisp/extensions-local/ld-toggle-one-window.el
Normal file
22
site-lisp/extensions-local/ld-toggle-one-window.el
Normal file
@@ -0,0 +1,22 @@
|
||||
;; -*- 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
|
||||
167
site-lisp/extensions-local/ld-tools.el
Normal file
167
site-lisp/extensions-local/ld-tools.el
Normal file
@@ -0,0 +1,167 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
(defun insert-line-number (beg end &optional start-line)
|
||||
"Insert line numbers into buffer."
|
||||
(interactive "r")
|
||||
(save-excursion
|
||||
(let ((max (count-lines beg end))
|
||||
(line (or start-line 1))
|
||||
(counter 1))
|
||||
(goto-char beg)
|
||||
(while (<= counter max)
|
||||
(insert (format "%0d " line))
|
||||
(beginning-of-line 2)
|
||||
(cl-incf line)
|
||||
(cl-incf counter)))))
|
||||
|
||||
(defun insert-line-number+ ()
|
||||
"Insert line number into buffer."
|
||||
(interactive)
|
||||
(if mark-active
|
||||
(insert-line-number (region-beginning) (region-end) (read-number "Start line: "))
|
||||
(insert-line-number (point-min) (point-max))))
|
||||
|
||||
(defun strip-blank-lines()
|
||||
"Strip all blank lines in select area of buffer,
|
||||
if not select any area, then strip all blank lines of buffer."
|
||||
(interactive)
|
||||
(strip-regular-expression-string "^[ \t]*\n")
|
||||
(message "Blanks line striped. ^_^"))
|
||||
|
||||
(defun strip-line-number()
|
||||
"Strip all line number in select area of buffer,
|
||||
if not select any area, then strip all line number of buffer."
|
||||
(interactive)
|
||||
(strip-regular-expression-string "^[0-9]+ ")
|
||||
(message "Line number striped. ^_^"))
|
||||
|
||||
(defun strip-regular-expression-string (regular-expression)
|
||||
"Strip all string that match REGULAR-EXPRESSION in select area of buffer.
|
||||
If not select any area, then strip current buffer"
|
||||
(interactive)
|
||||
(let ((begin (point-min))
|
||||
(end (point-max)))
|
||||
(if mark-active
|
||||
(setq begin (region-beginning)
|
||||
end (region-end)))
|
||||
(save-excursion
|
||||
(goto-char end)
|
||||
(while (and (> (point) begin)
|
||||
(re-search-backward regular-expression nil t))
|
||||
(replace-match "" t t)))))
|
||||
|
||||
(defun indent-comment-buffer ()
|
||||
"Indent comment of buffer."
|
||||
(interactive)
|
||||
(indent-comment-region (point-min) (point-max)))
|
||||
|
||||
(defun indent-comment-region (start end)
|
||||
"Indent region."
|
||||
(interactive "r")
|
||||
(save-excursion
|
||||
(setq end (copy-marker end))
|
||||
(goto-char start)
|
||||
(while (< (point) end)
|
||||
(if (comment-search-forward end t)
|
||||
(comment-indent)
|
||||
(goto-char end)))))
|
||||
|
||||
(defun capitalize-one-char (arg)
|
||||
"Change the letter pointed by the cursor to uppercase."
|
||||
(interactive "P")
|
||||
(upcase-region (point) (+ (point) (or arg 1)))
|
||||
(forward-char (or arg 1)))
|
||||
|
||||
(defun lowercase-one-char (arg)
|
||||
"Change the letter pointed by the cursor to lowercase."
|
||||
(interactive "P")
|
||||
(downcase-region (point) (+ (point) (or arg 1)))
|
||||
(forward-char (or arg 1)))
|
||||
|
||||
(defun delete-chars-hungry-forward (&optional reverse)
|
||||
"Delete chars forward use `hungry' style.
|
||||
Optional argument REVERSE default is delete forward, if reverse is non-nil delete backward."
|
||||
(delete-region
|
||||
(point)
|
||||
(progn
|
||||
(if reverse
|
||||
(skip-chars-backward " \t\n\r")
|
||||
(skip-chars-forward " \t\n\r"))
|
||||
(point))))
|
||||
|
||||
(defun delete-chars-hungry-backward ()
|
||||
"Delete chars backward use `hungry' style."
|
||||
(delete-chars-hungry-forward t))
|
||||
|
||||
(defun reverse-chars-in-region (start end)
|
||||
"Reverse the region character by character without reversing lines."
|
||||
(interactive "r")
|
||||
(let ((str (buffer-substring start end)))
|
||||
(delete-region start end)
|
||||
(dolist (line (split-string str "\n"))
|
||||
(let ((chars (mapcar (lambda (c)
|
||||
(or (matching-paren c)
|
||||
c))
|
||||
(reverse (append line nil)))))
|
||||
(when chars
|
||||
(apply 'insert chars))
|
||||
(newline)))))
|
||||
|
||||
(defun underline-line-with (char)
|
||||
"Insert some char below at current line."
|
||||
(interactive "cType one char: ")
|
||||
(save-excursion
|
||||
(let ((length (- (point-at-eol) (point-at-bol))))
|
||||
(end-of-line)
|
||||
(insert "\n")
|
||||
(insert (make-string length char)))))
|
||||
|
||||
(defun prettyfy-string (string &optional after)
|
||||
"Strip starting and ending whitespace and pretty `STRING'.
|
||||
Replace any chars after AFTER with '...'.
|
||||
Argument STRING the string that need pretty."
|
||||
(let ((replace-map (list
|
||||
(cons "^[ \t]*" "")
|
||||
(cons "[ \t]*$" "")
|
||||
(cons (concat "^\\(.\\{"
|
||||
(or (number-to-string after) "10")
|
||||
"\\}\\).*")
|
||||
"\\1..."))))
|
||||
(dolist (replace replace-map)
|
||||
(when (string-match (car replace) string)
|
||||
(setq string (replace-match (cdr replace) nil nil string))))
|
||||
string))
|
||||
|
||||
(defun forward-button-with-line-begin ()
|
||||
"Move to next button with line begin."
|
||||
(interactive)
|
||||
(call-interactively 'forward-button)
|
||||
(while (not (bolp))
|
||||
(call-interactively 'forward-button)))
|
||||
|
||||
(defun backward-button-with-line-begin ()
|
||||
"Move to previous button with line begin."
|
||||
(interactive)
|
||||
(call-interactively 'backward-button)
|
||||
(while (not (bolp))
|
||||
(call-interactively 'backward-button)))
|
||||
|
||||
(defun only-comment-p ()
|
||||
"Return t if current line only contains comment. Otherwise return nil."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (search-forward comment-start (line-end-position) t)
|
||||
(progn
|
||||
(backward-char (length comment-start))
|
||||
(equal (point)
|
||||
(progn
|
||||
(back-to-indentation)
|
||||
(point))))
|
||||
nil)))
|
||||
|
||||
(provide 'ld-tools)
|
||||
|
||||
;;; ld-tools.el ends here
|
||||
2228
site-lisp/extensions-local/neotree.el
Normal file
2228
site-lisp/extensions-local/neotree.el
Normal file
File diff suppressed because it is too large
Load Diff
42
site-lisp/extensions-local/scroll-next-window.el
Normal file
42
site-lisp/extensions-local/scroll-next-window.el
Normal file
@@ -0,0 +1,42 @@
|
||||
;; -*- coding: utf-8; -*-
|
||||
;;; Require:
|
||||
|
||||
;;; Code:
|
||||
;'up' to see previous content
|
||||
;'down' to see further content
|
||||
(defun scroll-next-window-up ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "up"))
|
||||
|
||||
(defun scroll-next-window-down ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "down"))
|
||||
|
||||
(defun scroll-next-window-up-line ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "up" 1))
|
||||
|
||||
(defun scroll-next-window-down-line ()
|
||||
(interactive)
|
||||
(scroll-next-window-internal "down" 1))
|
||||
|
||||
(defun scroll-next-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)
|
||||
))
|
||||
|
||||
(provide 'scroll-next-window)
|
||||
|
||||
;;; scroll-next-window.el ends here
|
||||
4653
site-lisp/extensions-local/undo-tree.el
Normal file
4653
site-lisp/extensions-local/undo-tree.el
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user