Files
dot-emacs/conf-lisp/functions.el

621 lines
22 KiB
EmacsLisp

;; * Productivity Functions
;; --------------------------------------------------------------------------------
;; ** goto line with tmp line numbers
;; I stole this somewhere, as far as I remember, emacswiki, however, I
;; always had F7 for goto-line
(defun goto-line-with-feedback ()
"Show line numbers temporarily, while prompting for the line number input"
(interactive)
(unwind-protect
(progn
(linum-mode 1)
(call-interactively 'goto-line))
(linum-mode -1)))
(global-set-key (kbd "<f7>") 'goto-line-with-feedback)
;; --------------------------------------------------------------------------------
;; ** invert fore- and background
;; Sometimes when sitting in a very dark enviroment, my usual light
;; emacs frame is a too stark contrast to the environment. With this
;; function I can just invert my current color settings to dark
;; background and light foreground.
;; remember last inverse
(defvar tvd-invert-state t)
;; invert everything, reverse it when called again
(defun tvd-invert()
"invert fg-bg"
(interactive)
(invert-face 'default)
(invert-face 'mode-line)
(set-face-attribute 'fringe nil :inverse-video tvd-invert-state)
(setq tvd-invert-state (not tvd-invert-state)) ;; cycle variable tvd-invert-state
)
;; fast
(global-set-key (kbd "C-c C-i") 'tvd-invert)
;; --------------------------------------------------------------------------------
;; ** Some useful bindings for Home and End keys Hit the key once to
;; Go to the beginning/end of a line, hit it twice in a row to go to
;; the beginning/end of the window, three times in a row goes to the
;; beginning/end of the buffer. NB that there is no timeout involved.
;; Uses a function of viking-mode to establish key repeats, see below.
(defun pc-keys-home ()
"Go to beginning of line/window/buffer. First hitting key goes
to beginning of line, second in a row goes to beginning of
window, third in a row goes to beginning of buffer."
(interactive)
(let* ((key-times (viking-last-key-repeats)))
(cond
((eq key-times 3)
(if mark-active
(goto-char (point-min))
(beginning-of-buffer)))
((eq key-times 2)
(if mark-active () (push-mark))
(move-to-window-line 0))
((eq key-times 1)
(beginning-of-line)))))
(defun pc-keys-end ()
"Go to end of line/window/buffer. First hitting key goes
to end of line, second in a row goes to end of
window, third in a row goes to end of buffer."
(interactive)
(let* ((key-times (viking-last-key-repeats)))
(cond
((eq key-times 3)
(if mark-active
(goto-char (point-max))
(end-of-buffer)))
((eq key-times 2)
(if mark-active () (push-mark))
(move-to-window-line -1)
(end-of-line))
((eq key-times 1)
(end-of-line)))))
;; This is the most natural use for those keys
(global-set-key (kbd "<home>") 'pc-keys-home)
(global-set-key (kbd "<end>") 'pc-keys-end)
;; --------------------------------------------------------------------------------
;; ** percent function
;; by Jens Heunemann: jump to percent position into current buffer
(defun goto-percent (p) ;goto Prozentwert (0-100): F8
(interactive "nProzent: ")
(if (> (point-max) 80000)
(goto-char (* (/ (point-max) 100) p)) ;Ueberlauf vermeiden: (max/100)*p
(goto-char (/ (* p (point-max)) 100))) ;Rundungsfehler verm.: (max*p)/100
(beginning-of-line))
(global-set-key (kbd "<f8>") 'goto-percent) ;F8 goto percent
;; --------------------------------------------------------------------------------
;; ** Simulate vi's % (percent) function
;; There's not a lot about vi[m] I like, but jumping with % to a
;; matching paren is one of THOSE features, I also need in emacs.
;; with ideas from [[https://www.emacswiki.org/emacs/NavigatingParentheses#toc2][emacswiki]]
;; If (point) is on a paren, jump to the matching paren, otherwise,
;; just insert a literal ?%. Only make sense if bound to %.
;; Does not jump in inside () though
(defun jump-paren-match-or-insert-percent (arg)
"Go to the matching parenthesis if on parenthesis. Otherwise
insert %. Mimics vi stle of % jumping to matching brace."
(interactive "p")
(cond ((looking-at "\\s\(\\|\{\\|\\[") (forward-list 1) (backward-char 1))
((and (looking-at "\\s\)\\|\}\\|\\]")
(not (looking-back "\\s\(\\|\{\\|\\[")))
(forward-char 1) (backward-list 1))
(t (insert "%"))))
;; only useful in programming modes
(define-key prog-mode-map (kbd "%") 'jump-paren-match-or-insert-percent)
;; --------------------------------------------------------------------------------
;; ** Move region
;; Mark a region, then use M-up|down to move it around
;; via [[https://www.emacswiki.org/emacs/MoveRegion][emacswiki]]
;; code from [[https://github.com/targzeta/move-lines/blob/master/move-lines.el][move-lines]]
(defun move-lines--internal (n)
(let* ((start (point)) ;; The position of beginning of line of the first line
(end start) ;; The position of eol+\n of the end line
col-init ;; The current column for the first line
(col-end (current-column)) ;; The current column for the end line
exchange_pm ;; If I had exchanged point and mark
delete-latest-newline) ;; If I had inserted a newline at the end
;; STEP 1: Identifying the line(s) to cut.
;; ---
;; If region is actives, I ensure that point always is at the end of the
;; region and mark at the beginning.
(when (region-active-p)
(when (< (point) (mark))
(setq exchange_pm t)
(exchange-point-and-mark))
(setq start (mark)
end (point)
col-end (current-column)))
(goto-char start) (setq col-init (current-column))
(beginning-of-line) (setq start (point))
(goto-char end) (end-of-line)
;; If point == point-max, this buffers doesn't have the trailing newline.
;; In this case I have to insert a newline otherwise the following
;; `forward-char' (to keep the "\n") will fail.
(when (= (point) (point-max))
(setq delete-latest-newline t)
(insert-char ?\n) (forward-char -1))
(forward-char 1) (setq end (point))
;; STEP 2: Moving the lines.
;; ---
;; The region I'm cutting span from the beginning of line of the current
;; line (or current region) to the end of line + 1 (newline) of the current
;; line (or current region).
(let ((line-text (delete-and-extract-region start end)))
(forward-line n)
;; If the current-column != 0, I have moved the region at the bottom of a
;; buffer doesn't have the trailing newline.
(when (not (= (current-column) 0))
(insert-char ?\n)
(setq delete-latest-newline t))
(setq start (+ (point) col-init)) ;; Now, start is the start of new region
(insert line-text))
;; STEP 3: Restoring
;; ---
;; I'm at the end of new region (or line) and start has setted at the
;; beginning of new region (if a region is active).
;; Restoring the end column.
(forward-line -1)
(forward-char col-end)
(when delete-latest-newline
(save-excursion
(goto-char (point-max))
(delete-char -1)))
(when (region-active-p)
(setq deactivate-mark nil)
(set-mark start)
(if exchange_pm
(exchange-point-and-mark)))))
(defun move-lines-up (n)
"Moves the current line or, if region is actives, the lines surrounding
region, up by N lines, or 1 line if N is nil."
(interactive "p")
(if (eq n nil)
(setq n 1))
(move-lines--internal (- n)))
(defun move-lines-down (n)
"Moves the current line or, if region is actives, the lines surrounding
region, down by N lines, or 1 line if N is nil."
(interactive "p")
(if (eq n nil)
(setq n 1))
(move-lines--internal n))
(global-set-key (kbd "M-<up>") 'move-lines-up)
(global-set-key (kbd "M-<down>") 'move-lines-down)
;; --------------------------------------------------------------------------------
;; ** comment-uncomment region with one key binding
;; via [[http://stackoverflow.com/a/9697222/3350881][stackoverflow]]
(defun comment-or-uncomment-region-or-line ()
"Comments or uncomments the region or the current line if there's no active region."
(interactive)
(let (beg end)
(if (region-active-p)
(setq beg (region-beginning) end (region-end))
(setq beg (line-beginning-position) end (line-end-position)))
(comment-or-uncomment-region beg end)))
(global-set-key (kbd "C-c C-c") 'comment-or-uncomment-region-or-line)
;; --------------------------------------------------------------------------------
;; ** search for symbol at point
;; Simulate the # function of vi, marks the symbol at point, C-s then
;; searches for it. I use this a lot.
;; via [[http://ergoemacs.org/emacs/modernization_isearch.html][ergomacs]]
(defun xah-search-current-word ()
"Call `isearch' on current word or text selection.
'word' here is A to Z, a to z, and hyphen and underline, independent of syntax table.
URL `[[http://ergoemacs.org/emacs/modernization_isearch.html'][ergomacs]]
Version 2015-04-09"
(interactive)
(let ( xahp1 xahp2 )
(if (use-region-p)
(progn
(setq xahp1 (region-beginning))
(setq xahp2 (region-end)))
(save-excursion
(skip-chars-backward "-_A-Za-z0-9")
(setq xahp1 (point))
(right-char)
(skip-chars-forward "-_A-Za-z0-9")
(setq xahp2 (point))))
(setq mark-active nil)
(when (< xahp1 (point))
(goto-char xahp1))
(isearch-mode t)
(isearch-yank-string (buffer-substring-no-properties xahp1 xahp2))
(message "Now use C-s to search for it ...")
))
(global-set-key (kbd "C-#") 'xah-search-current-word)
;; --------------------------------------------------------------------------------
;; ** Window Margin
;; Kinda screen reader for the poor. I use this sometimes with info
;; or woman mode. I also use a full featured screen reader: nove-mode,
;; see below.
;; left+right margin on demand (but nothing else)
(defun margin(m)
"set left and right margins for better readability"
(interactive "nEnter Margin (0 to disable) [0-9]+: ")
(set-window-margins (car (get-buffer-window-list (current-buffer) nil t)) m m) ;; set immediately
(setq left-margin-width m) ;; persist until reset
(setq right-margin-width m)
(message "To reset, change Buffer or call again with arg 0.")
)
;; --------------------------------------------------------------------------------
;; ** Fill and justify a paragraph
;; this is just a shortcut for:
;; C-u 70 <ret> M-x fill-paragraph
;; but C-q is just easier to remember
;; however, if pressed again it un-fills the paragraph,
;; idea via: [[http://endlessparentheses.com/fill-and-unfill-paragraphs-with-a-single-key.html][endlessparentheses]]
(defun tvd-fill-and-justify-or-unfill()
(interactive)
(let ((fill-column
(if (eq last-command 'tvd-fill-and-justify-or-unfill)
(progn (setq this-command nil)
(point-max))
fill-column)))
(fill-paragraph 70)))
(global-set-key (kbd "C-q") 'tvd-fill-and-justify-or-unfill) ; like M-q, which is bound to x-window-quit in xmonad: fill+justify
;; --------------------------------------------------------------------------------
;; ** Make a read-only copy of the current buffer
;; I just create a new read-only buffer and copy the contents of the
;; current one into it, which can be used as backup. I use this in
;; cases where I need to re-factor a file and do lots of changes. With
;; the buffer copy I have a reference to compare without the need to
;; leave emacs and look at revision control diffs or the like, and if
;; a file is not maintained via VC anyway.
(defvar copy-counter 0)
(defun get-copy-buffer-name()
"return unique copy buffer name"
(let ((name (concat "*COPY " (buffer-name (current-buffer)) " (RO)")))
(if (not (get-buffer name))
(progn
(setq copy-counter (1+ copy-counter))
(concat name "<" (number-to-string copy-counter) ">"))
(concat name))))
(defun copy-buffer-read-only()
"Create a read-only copy of the current buffer"
(interactive)
(let ((old-buffer (current-buffer))
(new-buffer-name (get-copy-buffer-name)))
(progn
(delete-other-windows)
(split-window-horizontally)
(other-window 1)
(if (not (eq (get-buffer new-buffer-name) nil))
(kill-buffer (get-buffer new-buffer-name)))
(set-buffer (get-buffer-create new-buffer-name))
(insert-buffer-substring old-buffer)
(read-only-mode)
(switch-to-buffer new-buffer-name)
(other-window 1))))
(defalias 'cp 'copy-buffer-read-only)
(global-set-key (kbd "C-c C-p") 'copy-buffer-read-only) ; make read-only buffer copy
;; --------------------------------------------------------------------------------
;; ** Cleanup, close all windows and kill all buffers
;; From time to time I get annoyed by the many dozen buffers
;; opened. In such cases I like to close them all at once.
;; No key binding though, just in case I stumble upon it and kill my
;; setup accidentally.
(defun kill-all-buffers ()
"Kill all buffers, clean up, close all windows"
(interactive)
(when (y-or-n-p "Close all windows and kill all buffers?")
(delete-other-windows)
(clean-buffer-list)
(dolist (buffer (buffer-list))
(kill-buffer buffer))
(delete-minibuffer-contents)
(if (fboundp 'tramp-cleanup-all-connections)
(tramp-cleanup-all-connections))
(with-current-buffer (get-buffer-create "*text*")
(text-mode))
(autoscratch-buffer)))
;; --------------------------------------------------------------------------------
;; ** Cleanup current buffer
;; Remove TABs, leading and trailing spaces, re-indent a buffer.
;; via [[http://whattheemacsd.com/buffer-defuns.el-01.html][whattheemacs.d]]
(defun cleanup-buffer ()
"Perform a bunch of safe operations on the whitespace content of a buffer.
Does not indent buffer, because it is used for a before-save-hook, and that
might be bad."
(interactive)
(untabify (point-min) (point-max))
(delete-trailing-whitespace)
(save-excursion
(replace-regexp "^\n\\{3,\\}" "\n\n" nil (point-min) (point-max)))
(set-buffer-file-coding-system 'utf-8)
(indent-region (point-min) (point-max)))
(defalias 'cb 'cleanup-buffer)
;; related, I use this to cleanup directories and rename files and
;; directories to my liking. Sometimes I get a disk or stick from
;; Windows users and they use every character available on their
;; keyboards to name files and dirs. I can't have this shit.
;;
(defun cleanup-dired-buffer ()
"If inside a wdired (edit) buffer, rename everything"
(interactive)
(delete-trailing-whitespace)
(save-excursion
(replace-regexp "[\(\)'`#,_&\!]" "" nil (point-min) (point-max))
(replace-string " " "-" nil (point-min) (point-max))
(replace-regexp "--*" "-" nil (point-min) (point-max))
(replace-string "ä" "ae" nil (point-min) (point-max))
(replace-string "ö" "oe" nil (point-min) (point-max))
(replace-string "ü" "ue" nil (point-min) (point-max))
(replace-string "Ä" "Ae" nil (point-min) (point-max))
(replace-string "Ö" "Oe" nil (point-min) (point-max))
(replace-string "Ü" "Ue" nil (point-min) (point-max))
(replace-string "ß" "ss" nil (point-min) (point-max))
(replace-string ".." "." nil (point-min) (point-max))))
(defun cleanup-dir()
"Cleanup wdired buffer in one whole step, used for emacsclient buffers"
(interactive)
(wdired-change-to-wdired-mode)
(cleanup-dired-buffer)
(wdired-finish-edit)
(kill-this-buffer))
;; --------------------------------------------------------------------------------
;; ** Remove Umlauts and other crab in current buffer
;; converts:
;; Stan Lem - ein schönes Leben & sonst nix(ungekuerzte Ausgabe)
;; to:
;; Stan_Lem-ein_schoenes_Leben_sonst_nix_ungekuerzte_Ausgabe
;;
;; used in dired buffers to cleanup filenames by german windows users.
(defun umlaute-weg()
(interactive)
(let ((umlaute '((Ü . Ue)
(Ä . Ae)
(Ö . Oe)
(ü . ue)
(ä . ae)
(ö . oe)
(ß . ss)))
(regs (list
'(" " . "_")
'("_-_" . "-")
'("[\(\)&]" . "_")
'("__*" . "_")
'("_$" . "")
)))
(save-excursion
(dolist (pair umlaute)
(replace-regexp (symbol-name (car pair))
(symbol-name (cdr pair))
nil
(point-min) (point-max)))
(dolist (reg regs)
(replace-regexp (car reg) (cdr reg) nil
(point-min) (point-max))))))
;; --------------------------------------------------------------------------------
;; ** Better newline(s)
;; Add newline and jump to indent from wherever I am in the current
;; line, that is it is not required to be on the end of line.
;; via [[http://whattheemacsd.com/editing-defuns.el-01.html][whattheemacs.d]]
(defun open-line-below ()
(interactive)
(end-of-line)
(newline)
(indent-for-tab-command))
(defun open-line-above ()
(interactive)
(end-of-line)
(beginning-of-line)
(newline)
(forward-line -1)
(indent-for-tab-command))
;; disabled, interferes with modes.
;; (global-set-key (kbd "<C-return>") 'open-line-below)
;; (global-set-key (kbd "<C-S-return>") 'open-line-above)
;; --------------------------------------------------------------------------------
;; ** Mouse Rectangle
;; There's not much use for the mouse in emacs, but this gimick is
;; funny and works like a charm.
;; via [[http://emacs.stackexchange.com/a/7261][stackoverflow]]
(defun mouse-start-rectangle (start-event)
(interactive "e")
(deactivate-mark)
(mouse-set-point start-event)
(rectangle-mark-mode +1)
(let ((drag-event))
(track-mouse
(while (progn
(setq drag-event (read-event))
(mouse-movement-p drag-event))
(mouse-set-point drag-event)))))
(global-set-key (kbd "S-<down-mouse-1>") 'mouse-start-rectangle)
;; --------------------------------------------------------------------------------
;; ** DOS <=> UNIX conversion helpers
(defun dos2unix ()
(interactive)
(set-buffer-file-coding-system 'utf-8-unix)
(message (format "converted current buffer to %s" buffer-file-coding-system)))
(defun unix2dos ()
(interactive)
(set-buffer-file-coding-system 'utf-8-dos)
(message (format "converted current buffer to %s" buffer-file-coding-system)))
;; --------------------------------------------------------------------------------
;; ** helper do add the same thing to multiple mode hooks
;; via [[http://stackoverflow.com/posts/3900056/revisions][stackoverflow]]
;; usage samples below.
(defun add-something-to-mode-hooks (mode-list something)
"helper function to add a callback to multiple hooks"
(dolist (mode mode-list)
(add-hook (intern (concat (symbol-name mode) "-mode-hook")) something)))
;; --------------------------------------------------------------------------------
;; ** helper to catch load errors
;; Try to eval 'fn, catch errors, if any but make it possible for
;; emacs to continue undisturbed, used with SMEX, see below.
(defmacro safe-wrap (fn &rest clean-up)
`(unwind-protect
(let (retval)
(condition-case ex
(setq retval (progn ,fn))
('error
(message (format "Caught exception: [%s]" ex))
(setq retval (cons 'exception (list ex)))))
retval)
,@clean-up))
;; --------------------------------------------------------------------------------
;; ** Alignment Wrappers
;; align-regexp is already a very usefull tool, however, sometimes I
;; want to repeat the alignment and I hate C-u, so here are some
;; wrappers to make this easier.
(defun align-repeat (regex &optional alignment)
"Aply REGEX to all columns not just the first. Align by
ALIGNMENT which must be 'left or 'right. The default is 'left.
Right alignment:
col1 ,col2
col1 ,col2
Left alignment:
col1, col2
col1, col2"
(interactive "MRepeat Align Regex [ ]: ")
(let ((spc " ")
(beg (point-min))
(end (point-max))
(areg "%s\\(\\s-*\\)" ; default left aligned
))
(when (string= regex "")
(setq regex spc))
(when (region-active-p)
(setq beg (region-beginning))
(setq end (region-end)))
(when (eq alignment 'right)
(setq areg "\\(\\s-*\\)%s"))
(align-regexp beg end (format areg regex) 1 1 t)))
(defun align-repeat-left (regex)
(interactive "MRepeat Left Align Regex [ ]: ")
(align-regexp-repeat regex 'left))
(defun align-repeat-right (regex)
(interactive "MRepeat Left Align Regex [ ]: ")
(align-regexp-repeat regex 'right))
;; ** String Helpers
;; Some helper functions I use here and there.
(defun tvd-alist-keys (A)
"return a list of keys of alist A"
(let ((K ()))
(dolist (e A)
(push (car e) K)
)
K))
(defun tvd-get-line ()
"return current line in current buffer"
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))
(defun tvd-starts-with (s begins)
"Return non-nil if string S starts with BEGINS."
(cond ((>= (length s) (length begins))
(string-equal (substring s 0 (length begins)) begins))
(t nil)))
(defun tvd-replace-all (regex replace)
"Replace all matches of REGEX with REPLACE in current buffer."
(interactive)
(goto-char (point-min))
(while (re-search-forward regex nil t)
(replace-match replace)))