From 093ffa5fbf7143f4668bb0a3dc9659a5cc836e12 Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Sat, 17 Jun 2023 17:20:29 +1000 Subject: Moving things one level deeper To ease gnu stow usage. Now we can do stow -t ~ emacs --- emacs/.emacs.d/lisp/my/my-editing.el | 340 +++++++++++++++++++++++++++++++++++ 1 file changed, 340 insertions(+) create mode 100644 emacs/.emacs.d/lisp/my/my-editing.el (limited to 'emacs/.emacs.d/lisp/my/my-editing.el') diff --git a/emacs/.emacs.d/lisp/my/my-editing.el b/emacs/.emacs.d/lisp/my/my-editing.el new file mode 100644 index 0000000..bd3ca83 --- /dev/null +++ b/emacs/.emacs.d/lisp/my/my-editing.el @@ -0,0 +1,340 @@ +;;; my-editing.el -- Editing related extensions for emacs core -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation. + +;; Author: Yuchen Pei +;; Protesilaos Stavrou +;; Stefan Monnier +;; Maintainer: Yuchen Pei +;; Package-Requires: ((emacs "28.2")) + +;; This file is part of dotfiles. + +;; dotfiles is free software: you can redistribute it and/or modify it under +;; the terms of the GNU Affero General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; dotfiles 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 Affero General +;; Public License for more details. + +;; You should have received a copy of the GNU Affero General Public +;; License along with dotfiles. If not, see . + +;;; Commentary: + +;; Editing related extensions. + +;;; Code: + + + +;;; Some of the following functions are adapted from prot-dotfiles +(defun my-comment-and-copy-selection () + (interactive) + (comment-dwim nil) + (my-yank-primary)) + +(defun my-kill-region-if-active (beg end &optional region) + (interactive (list (mark) (point) 'region)) + (when mark-active + (kill-region beg end region))) + +;;; Stefan Monnier . It is the opposite of fill-paragraph +(defun my-unfill-paragraph (&optional region) + "Takes a multi-line paragraph and makes it into a single line of text." + (interactive (progn (barf-if-buffer-read-only) '(t))) + (let ((fill-column (point-max)) + ;; This would override `fill-column' if it's an integer. + (emacs-lisp-docstring-fill-column t)) + (fill-paragraph nil region))) + +;;; fixme: move to search +(defun my-replace-leading-space (to-string begin end) + (interactive (list (read-string "Replace leading whitespace by: ") + (region-beginning) (region-end))) + (save-excursion + (goto-char begin) + (while (re-search-forward "^\\ +" end t) + (replace-match to-string)))) + +(defun my-concat-lines (begin end) + (interactive (list (region-beginning) (region-end))) + (replace-regexp "\n" " " nil begin end)) + +(defun my-save-without-formatting () + (interactive) + (read-only-mode 1) + (save-buffer) + (read-only-mode -1)) + +(defun my-yank-primary () + (interactive) + (let ((primary (gui-get-primary-selection))) + (push-mark) + (insert-for-yank primary))) + +(defun my-beginning-of-line-or-indentation () + "Move to beginning of line, or indentation" + (interactive) + (if (bolp) + (back-to-indentation) + (beginning-of-line))) + +(defun my-copy-url-at-point () + (interactive) + (when-let ((url (thing-at-point-url-at-point))) + (kill-new url) + (message "Copied: %s" (thing-at-point-url-at-point)))) + +(defun my-backward-kill-path-component () + (interactive) + (zap-up-to-char -1 ?/)) + +(defun my-toggle-forward-word-viper-symbol () + (interactive) + (require 'viper) + (cond ((eq (lookup-key (current-global-map) "\M-f") 'forward-word) + (progn + (define-key global-map "\M-f" 'viper-forward-word) + (define-key global-map "\M-b" 'viper-backward-word) + (message "M-f is viper-forward-word"))) + ((eq (lookup-key (current-global-map) "\M-f") 'viper-forward-word) + (progn + (define-key global-map "\M-f" 'forward-symbol) + (define-key global-map "\M-b" + (lambda () (interactive) + (forward-symbol -1))) + (message "M-f is forward-symbol"))) + (t (progn + (define-key global-map "\M-f" 'forward-word) + (define-key global-map "\M-b" 'backward-word) + (message "M-f is forward-word"))))) + +(defun my-kill-line-backward () + "Kill from point to the beginning of the line." + (interactive) + (kill-line 0)) + +(defun my--duplicate-buffer-substring (beg end &optional indent) + "Duplicate buffer substring between BEG and END positions. +With optional INDENT, run `indent-for-tab-command' after +inserting the substring." + (save-excursion + (goto-char end) + (insert (buffer-substring-no-properties beg end)) + (when indent + (indent-for-tab-command)))) + +;;;###autoload +(defun my-copy-line-or-region (&optional duplicate) + "Copy the current line or active region to the `kill-ring'. +With optional DUPLICATE as a prefix argument, duplicate the +current line or active region without adding it to the `kill-ring'." + (interactive "P") + (let* ((region (region-active-p)) + (beg (if region (region-beginning) (line-beginning-position))) + (end (if region (region-end) (1+ (line-end-position)))) + (message (if region "region" "line"))) + (if duplicate + (my--duplicate-buffer-substring beg end) + (copy-region-as-kill beg end) + (message "Copied current %s" message)))) + +;;;###autoload +(defun my-new-line-below (&optional arg) + "Create an empty line below the current one. +Move the point to the absolute beginning. Adapt indentation by +passing optional prefix ARG (\\[universal-argument]). Also see +`my-new-line-above'." + (interactive "P") + (end-of-line) + (if arg + (newline-and-indent) + (newline))) + +;;;###autoload +(defun my-new-line-above-or-below (&optional arg) + "Create an empty line above the current one. +Move the point to the absolute beginning. Open a new line below +by passing optional prefix ARG (\\[universal-argument])." + (interactive "P") + (if arg + (my-new-line-below) + (if (or (bobp) + (line-number-at-pos (point-min))) + (progn + (beginning-of-line) + (newline) + (forward-line -1)) + (forward-line -1) + (my-new-line-below)))) + +(defun my--pos-url-on-line (&optional char) + "Return position of `my-url-regexp' on line or at CHAR." + (save-excursion + (goto-char (or char (line-beginning-position))) + (re-search-forward my-url-regexp (line-end-position) :noerror))) + +;;;###autoload +(defun my-escape-url-line (&optional char) + "Escape all URLs or email addresses on the current line. +By default, start operating from `line-beginning-position' to the +end of the current line. With optional CHAR as a buffer +position, operate from CHAR to the end of the line." + (interactive) + (when-let ((regexp-end (my--pos-url-on-line char))) + (save-excursion + (goto-char regexp-end) + (unless (looking-at ">") + (insert ">") + (search-backward "\s") + (forward-char 1) + (insert "<"))) + (my-escape-url-line (1+ regexp-end)))) + +;; Thanks to Bruno Boal for `my-escape-url-region'. I am +;; just renaming it for consistency with the rest of prot-simple.el. +;; Check Bruno's Emacs config: . + +;;;###autoload +(defun my-escape-url-region (&optional beg end) + "Apply `my-escape-url-line' on region lines between BEG and END." + (interactive + (if (region-active-p) + (list (region-beginning) (region-end)) + (error "There is no region!"))) + (unless (> end beg) + (cl-rotatef end beg)) + (save-excursion + (goto-char beg) + (setq beg (line-beginning-position)) + (while (<= beg end) + (my-escape-url-line beg) + (beginning-of-line 2) + (setq beg (point))))) + +;;;###autoload +(defun my-escape-url-dwim () + "Escape URL on the current line or lines implied by the active region. +Call the commands `my-escape-url-line' and +`my-escape-url-region' ." + (interactive) + (call-interactively + (if (region-active-p) + #'my-escape-url-region + #'my-escape-url-line))) + +;; Got those numbers from `string-to-char' +(defcustom my-insert-pair-alist + '(("' Single quote" . (39 39)) ; ' ' + ("\" Double quotes" . (34 34)) ; " " + ("` Elisp quote" . (96 39)) ; ` ' + ("‘ Single apostrophe" . (8216 8217)) ; ‘ ’ + ("“ Double apostrophes" . (8220 8221)) ; “ ” + ("( Parentheses" . (40 41)) ; ( ) + ("{ Curly brackets" . (123 125)) ; { } + ("[ Square brackets" . (91 93)) ; [ ] + ("< Angled brackets" . (60 62)) ; < > + ("« Εισαγωγικά Gr quote" . (171 187)) ; « » + ("= Equals signs" . (61 61)) ; = = + ("~ Tilde" . (126 126)) ; ~ ~ + ("* Asterisks" . (42 42)) ; * * + ("/ Forward Slash" . (47 47)) ; / / + ("_ underscores" . (95 95))) ; _ _ + "Alist of pairs for use with `my-insert-pair-completion'." + :type 'alist + :group 'my-editing) + +(defvar my--character-hist '() + "History of inputs for `my-insert-pair-completion'.") + +(defun my--character-prompt (chars) + "Helper of `my-insert-pair-completion' to read CHARS." + (let ((def (car my--character-hist))) + (completing-read + (format "Select character [%s]: " def) + chars nil t nil 'my--character-hist def))) + +;;;###autoload +(defun my-insert-pair (pair &optional count) + "Insert PAIR from `my-insert-pair-alist'. +Operate on the symbol at point. If the region is active, use it +instead. + +With optional COUNT (either as a natural number from Lisp or a +universal prefix argument (\\[universal-argument]) when used +interactively) prompt for the number of delimiters to insert." + (interactive + (list + (my--character-prompt my-insert-pair-alist) + current-prefix-arg)) + (let* ((data my-insert-pair-alist) + (left (cadr (assoc pair data))) + (right (caddr (assoc pair data))) + (n (cond + ((and count (natnump count)) + count) + (count + (read-number "How many delimiters?" 2)) + (1))) + (beg) + (end) + (forward)) + (cond + ((region-active-p) + (setq beg (region-beginning) + end (region-end))) + ((when (thing-at-point 'symbol) + (let ((bounds (bounds-of-thing-at-point 'symbol))) + (setq beg (car bounds) + end (cdr bounds))))) + (t (setq beg (point) + end (point) + forward t))) + (save-excursion + (goto-char end) + (dotimes (_ n) + (insert right)) + (goto-char beg) + (dotimes (_ n) + (insert left))) + (when forward (forward-char n)))) + +;;;###autoload +(defun my-delete-pair-dwim () + "Delete pair following or preceding point. +For Emacs version 28 or higher, the feedback's delay is +controlled by `delete-pair-blink-delay'." + (interactive) + (if (eq (point) (cdr (bounds-of-thing-at-point 'sexp))) + (delete-pair -1) + (delete-pair 1))) + +;;;###autoload +(defun my-zap-back-to-char (char &optional arg) + "Backward `zap-to-char' for CHAR. +Optional ARG is a numeric prefix to match ARGth occurance of +CHAR." + (interactive + (list + (read-char-from-minibuffer "Zap to char: " nil 'read-char-history) + (prefix-numeric-value current-prefix-arg))) + (zap-to-char (- arg) char)) + +(defun my-transpose-lines () + "Same as `transpose-lines' but move point to the original position + +Basically move the line up +" + (interactive) + (let ((line (current-line)) + (col (current-column))) + (call-interactively 'transpose-lines) + (goto-line line) + (forward-char col))) + +(provide 'my-editing) +;;; my-editing.el ends here -- cgit v1.2.3