385 lines
13 KiB
EmacsLisp
Executable file
385 lines
13 KiB
EmacsLisp
Executable file
;-*- coding: utf-8 -*-
|
||
|
||
(require 'redo "redo.elc" t) ; for redo shortcut
|
||
|
||
(delete-selection-mode 1) ; turn on text selection highlighting and make typing override selected text (Note: when delete-selection-mode is on, then transient-mark-mode is automatically on too.)
|
||
|
||
(defun call-keyword-completion ()
|
||
"Call the command that has keyboard shortcut M-TAB."
|
||
(interactive)
|
||
(call-interactively (key-binding (kbd "M-TAB")))
|
||
)
|
||
|
||
(defun describe-major-mode ()
|
||
"Show inline doc for current major-mode."
|
||
;; code by Kevin Rodgers. 2009-02-25
|
||
(interactive)
|
||
(describe-function major-mode))
|
||
|
||
(defun copy-all ()
|
||
"Put the whole buffer content into the kill-ring.
|
||
If narrow-to-region is in effect, then copy that region only."
|
||
(interactive)
|
||
(kill-ring-save (point-min) (point-max))
|
||
(message "Buffer content copied")
|
||
)
|
||
|
||
(defun cut-all ()
|
||
"Cut the whole buffer content into the kill-ring.
|
||
If narrow-to-region is in effect, then cut that region only."
|
||
(interactive)
|
||
(kill-region (point-min) (point-max))
|
||
(message "Buffer content cut")
|
||
)
|
||
|
||
;;; TEXT SELECTION RELATED
|
||
|
||
(defun select-text-in-quote ()
|
||
"Select text between the nearest left and right delimiters.
|
||
Delimiters are paired characters: ()[]<>«»“”‘’「」【】, including \"\"."
|
||
(interactive)
|
||
(let (b1 b2)
|
||
(skip-chars-backward "^<>(“{[「«【\"‘")
|
||
(setq b1 (point))
|
||
(skip-chars-forward "^<>)”}]」】»\"’")
|
||
(setq b2 (point))
|
||
(set-mark b1)
|
||
)
|
||
)
|
||
|
||
;; by Nikolaj Schumacher, 2008-10-20. Released under GPL.
|
||
(defun semnav-up (arg)
|
||
(interactive "p")
|
||
(when (nth 3 (syntax-ppss))
|
||
(if (> arg 0)
|
||
(progn
|
||
(skip-syntax-forward "^\"")
|
||
(goto-char (1+ (point)))
|
||
(decf arg))
|
||
(skip-syntax-backward "^\"")
|
||
(goto-char (1- (point)))
|
||
(incf arg)))
|
||
(up-list arg))
|
||
|
||
;; by Nikolaj Schumacher, 2008-10-20. Released under GPL.
|
||
(defun extend-selection (arg &optional incremental)
|
||
"Select the current word.
|
||
Subsequent calls expands the selection to larger semantic unit."
|
||
(interactive (list (prefix-numeric-value current-prefix-arg)
|
||
(or (and transient-mark-mode mark-active)
|
||
(eq last-command this-command))))
|
||
(if incremental
|
||
(progn
|
||
(semnav-up (- arg))
|
||
(forward-sexp)
|
||
(mark-sexp -1))
|
||
(if (> arg 1)
|
||
(extend-selection (1- arg) t)
|
||
(if (looking-at "\\=\\(\\s_\\|\\sw\\)*\\_>")
|
||
(goto-char (match-end 0))
|
||
(unless (memq (char-before) '(?\) ?\"))
|
||
(forward-sexp)))
|
||
(mark-sexp -1))))
|
||
|
||
;;; TEXT TRANSFORMATION RELATED
|
||
|
||
(defun kill-line-backward ()
|
||
"Kill text between the beginning of the line to the cursor position.
|
||
If there's no text, delete the previous line ending."
|
||
(interactive)
|
||
(if (looking-back "\n")
|
||
(delete-char -1)
|
||
(kill-line 0)
|
||
)
|
||
)
|
||
|
||
(defun move-cursor-next-pane ()
|
||
"Move cursor to the next pane."
|
||
(interactive)
|
||
(other-window 1)
|
||
)
|
||
|
||
(defun move-cursor-previous-pane ()
|
||
"Move cursor to the previous pane."
|
||
(interactive)
|
||
(other-window -1)
|
||
)
|
||
|
||
(defun compact-uncompact-block ()
|
||
"Remove or add line endings on the current block of text.
|
||
This is similar to a toggle for fill-paragraph and unfill-paragraph
|
||
When there is a text selection, act on the region.
|
||
|
||
When in text mode, a paragraph is considerd a block. When in programing
|
||
language mode, the block is defined by between empty lines.
|
||
|
||
Todo: The programing language behavior is currently not done.
|
||
Right now, the code uses fill* functions, so does not work or work well
|
||
in programing lang modes. A proper implementation to compact is replacing
|
||
EOL chars by space when the EOL char is not inside string."
|
||
(interactive)
|
||
|
||
;; This command symbol has a property “'stateIsCompact-p”, the
|
||
;; possible values are t and nil. This property is used to easily
|
||
;; determine whether to compact or uncompact, when this command is
|
||
;; called again
|
||
|
||
(let (bds currentLineCharCount currentStateIsCompact
|
||
(bigFillColumnVal 4333999) (deactivate-mark nil))
|
||
|
||
(save-excursion
|
||
;; currentLineCharCount is used to determine whether current state
|
||
;; is compact or not, when the command is run for the first time
|
||
(setq currentLineCharCount
|
||
(progn
|
||
(setq bds (bounds-of-thing-at-point 'line))
|
||
(length (buffer-substring-no-properties (car bds) (cdr bds)))
|
||
;; Note: 'line includes eol if it is not buffer's last line
|
||
)
|
||
)
|
||
|
||
;; Determine whether the text is currently compact. when the last
|
||
;; command is this, then symbol property easily tells, but when
|
||
;; this command is used fresh, right now we use num of chars of
|
||
;; the cursor line as a way to define current compatness state
|
||
(setq currentStateIsCompact
|
||
(if (eq last-command this-command)
|
||
(get this-command 'stateIsCompact-p)
|
||
(if (> currentLineCharCount fill-column) t nil)
|
||
)
|
||
)
|
||
|
||
(if (and transient-mark-mode mark-active)
|
||
(if currentStateIsCompact
|
||
(fill-region (region-beginning) (region-end))
|
||
(let ((fill-column bigFillColumnVal))
|
||
(fill-region (region-beginning) (region-end)))
|
||
)
|
||
(if currentStateIsCompact
|
||
(fill-paragraph nil)
|
||
(let ((fill-column bigFillColumnVal))
|
||
(fill-paragraph nil))
|
||
)
|
||
)
|
||
|
||
(put this-command 'stateIsCompact-p (if currentStateIsCompact
|
||
nil t)) ) ) )
|
||
|
||
(defun shrink-whitespaces ()
|
||
"Remove white spaces around cursor to just one or none.
|
||
If current line does not contain non-white space chars, then remove blank lines to just one.
|
||
If current line contains non-white space chars, then shrink any whitespace char surrounding cursor to just one space.
|
||
If current line is a single space, remove that space.
|
||
|
||
Calling this command 3 times will always result in no whitespaces around cursor."
|
||
(interactive)
|
||
(let (
|
||
cursor-point
|
||
line-has-meat-p ; current line contains non-white space chars
|
||
spaceTabNeighbor-p
|
||
whitespace-begin whitespace-end
|
||
space-or-tab-begin space-or-tab-end
|
||
line-begin-pos line-end-pos
|
||
)
|
||
(save-excursion
|
||
;; todo: might consider whitespace as defined by syntax table, and also consider whitespace chars in unicode if syntax table doesn't already considered it.
|
||
(setq cursor-point (point))
|
||
|
||
(setq spaceTabNeighbor-p (if (or (looking-at " \\|\t") (looking-back " \\|\t")) t nil) )
|
||
(move-beginning-of-line 1) (setq line-begin-pos (point) )
|
||
(move-end-of-line 1) (setq line-end-pos (point) )
|
||
;; (re-search-backward "\n$") (setq line-begin-pos (point) )
|
||
;; (re-search-forward "\n$") (setq line-end-pos (point) )
|
||
(setq line-has-meat-p (if (< 0 (count-matches "[[:graph:]]" line-begin-pos line-end-pos)) t nil) )
|
||
(goto-char cursor-point)
|
||
|
||
(skip-chars-backward "\t ")
|
||
(setq space-or-tab-begin (point))
|
||
|
||
(skip-chars-backward "\t \n")
|
||
(setq whitespace-begin (point))
|
||
|
||
(goto-char cursor-point) (skip-chars-forward "\t ")
|
||
(setq space-or-tab-end (point))
|
||
(skip-chars-forward "\t \n")
|
||
(setq whitespace-end (point))
|
||
)
|
||
|
||
(if line-has-meat-p
|
||
(let (deleted-text)
|
||
(when spaceTabNeighbor-p
|
||
;; remove all whitespaces in the range
|
||
(setq deleted-text (delete-and-extract-region space-or-tab-begin space-or-tab-end))
|
||
;; insert a whitespace only if we have removed something
|
||
;; different that a simple whitespace
|
||
(if (not (string= deleted-text " "))
|
||
(insert " ") ) ) )
|
||
|
||
(progn
|
||
;; (delete-region whitespace-begin whitespace-end)
|
||
;; (insert "\n")
|
||
(delete-blank-lines)
|
||
)
|
||
;; todo: possibly code my own delete-blank-lines here for better efficiency, because delete-blank-lines seems complex.
|
||
)
|
||
)
|
||
)
|
||
|
||
(defun toggle-letter-case ()
|
||
"Toggle the letter case of current word or text selection.
|
||
Toggles from 3 cases: UPPER CASE, lower case, Title Case,
|
||
in that cyclic order."
|
||
(interactive)
|
||
(let (pos1 pos2 (deactivate-mark nil) (case-fold-search nil))
|
||
(if (and transient-mark-mode mark-active)
|
||
(setq pos1 (region-beginning)
|
||
pos2 (region-end))
|
||
(setq pos1 (car (bounds-of-thing-at-point 'word))
|
||
pos2 (cdr (bounds-of-thing-at-point 'word))))
|
||
|
||
(when (not (eq last-command this-command))
|
||
(save-excursion
|
||
(goto-char pos1)
|
||
(cond
|
||
((looking-at "[[:lower:]][[:lower:]]") (put this-command 'state "all lower"))
|
||
((looking-at "[[:upper:]][[:upper:]]") (put this-command 'state "all caps") )
|
||
((looking-at "[[:upper:]][[:lower:]]") (put this-command 'state "init caps") )
|
||
(t (put this-command 'state "all lower") )
|
||
)
|
||
)
|
||
)
|
||
|
||
(cond
|
||
((string= "all lower" (get this-command 'state))
|
||
(upcase-initials-region pos1 pos2) (put this-command 'state "init caps"))
|
||
((string= "init caps" (get this-command 'state))
|
||
(upcase-region pos1 pos2) (put this-command 'state "all caps"))
|
||
((string= "all caps" (get this-command 'state))
|
||
(downcase-region pos1 pos2) (put this-command 'state "all lower"))
|
||
)
|
||
)
|
||
)
|
||
|
||
;;; FRAME
|
||
|
||
(defun switch-to-next-frame ()
|
||
"Select the next frame on current display, and raise it."
|
||
(interactive)
|
||
(other-frame 1)
|
||
)
|
||
|
||
(defun switch-to-previous-frame ()
|
||
"Select the previous frame on current display, and raise it."
|
||
(interactive)
|
||
(other-frame -1)
|
||
)
|
||
|
||
;;; BUFFER RELATED
|
||
|
||
(defun next-user-buffer ()
|
||
"Switch to the next user buffer.
|
||
User buffers are those whose name does not start with *."
|
||
(interactive)
|
||
(next-buffer)
|
||
(let ((i 0))
|
||
(while (and (string-match "^*" (buffer-name)) (< i 50))
|
||
(setq i (1+ i)) (next-buffer) )))
|
||
|
||
(defun previous-user-buffer ()
|
||
"Switch to the previous user buffer.
|
||
User buffers are those whose name does not start with *."
|
||
(interactive)
|
||
(previous-buffer)
|
||
(let ((i 0))
|
||
(while (and (string-match "^*" (buffer-name)) (< i 50))
|
||
(setq i (1+ i)) (previous-buffer) )))
|
||
|
||
(defun next-emacs-buffer ()
|
||
"Switch to the next emacs buffer.
|
||
Emacs buffers are those whose name starts with *."
|
||
(interactive)
|
||
(next-buffer)
|
||
(let ((i 0))
|
||
(while (and (not (string-match "^*" (buffer-name))) (< i 50))
|
||
(setq i (1+ i)) (next-buffer) )))
|
||
|
||
(defun previous-emacs-buffer ()
|
||
"Switch to the previous emacs buffer.
|
||
Emacs buffers are those whose name starts with *."
|
||
(interactive)
|
||
(previous-buffer)
|
||
(let ((i 0))
|
||
(while (and (not (string-match "^*" (buffer-name))) (< i 50))
|
||
(setq i (1+ i)) (previous-buffer) )))
|
||
|
||
(defun new-empty-buffer ()
|
||
"Opens a new empty buffer."
|
||
(interactive)
|
||
(let ((buf (generate-new-buffer "untitled")))
|
||
(switch-to-buffer buf)
|
||
(funcall (and initial-major-mode))
|
||
(setq buffer-offer-save t)))
|
||
;; note: emacs won't offer to save a buffer that's
|
||
;; not associated with a file,
|
||
;; even if buffer-modified-p is true.
|
||
;; One work around is to define your own my-kill-buffer function
|
||
;; that wraps around kill-buffer, and check on the buffer modification
|
||
;; status to offer save
|
||
;; This custome kill buffer is close-current-buffer.
|
||
|
||
|
||
(defvar recently-closed-buffers (cons nil nil) "A list of recently closed buffers. The max number to track is controlled by the variable recently-closed-buffers-max.")
|
||
(defvar recently-closed-buffers-max 10 "The maximum length for recently-closed-buffers.")
|
||
|
||
(defun close-current-buffer ()
|
||
"Close the current buffer.
|
||
|
||
Similar to (kill-buffer (current-buffer)) with the following addition:
|
||
|
||
• prompt user to save if the buffer has been modified even if the buffer is not associated with a file.
|
||
• make sure the buffer shown after closing is a user buffer.
|
||
• if the buffer is a file, add the path to the list recently-closed-buffers.
|
||
|
||
A emacs buffer is one who's name starts with *.
|
||
Else it is a user buffer."
|
||
(interactive)
|
||
(let (emacsBuff-p isEmacsBufferAfter)
|
||
(if (string-match "^*" (buffer-name))
|
||
(setq emacsBuff-p t)
|
||
(setq emacsBuff-p nil))
|
||
|
||
;; offer to save buffers that are non-empty and modified, even for non-file visiting buffer. (because kill-buffer does not offer to save buffers that are not associated with files)
|
||
(when (and (buffer-modified-p)
|
||
(not emacsBuff-p)
|
||
(not (string-equal major-mode "dired-mode"))
|
||
(if (equal (buffer-file-name) nil)
|
||
(if (string-equal "" (save-restriction (widen) (buffer-string))) nil t)
|
||
t
|
||
)
|
||
)
|
||
(if (y-or-n-p
|
||
(concat "Buffer " (buffer-name) " modified; Do you want to save?"))
|
||
(save-buffer)
|
||
(set-buffer-modified-p nil)))
|
||
|
||
;; save to a list of closed buffer
|
||
(when (not (equal buffer-file-name nil))
|
||
(setq recently-closed-buffers
|
||
(cons (cons (buffer-name) (buffer-file-name)) recently-closed-buffers))
|
||
(when (> (length recently-closed-buffers) recently-closed-buffers-max)
|
||
(setq recently-closed-buffers (butlast recently-closed-buffers 1))
|
||
)
|
||
)
|
||
|
||
;; close
|
||
(kill-buffer (current-buffer))
|
||
|
||
;; if emacs buffer, switch to a user buffer
|
||
(if (string-match "^*" (buffer-name))
|
||
(setq isEmacsBufferAfter t)
|
||
(setq isEmacsBufferAfter nil))
|
||
(when isEmacsBufferAfter
|
||
(previous-user-buffer)
|
||
)
|
||
)
|
||
)
|