Moving things one level deeper

To ease gnu stow usage. Now we can do

stow -t ~ emacs

1 files changed, 340 insertions, 0 deletions

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 <id@ypei.org>
+;;         Protesilaos Stavrou <info@protesilaos.com>
+;;         Stefan Monnier <monnier@iro.umontreal.ca>
+;; Maintainer: Yuchen Pei <id@ypei.org>
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 <foo at acm.org>. 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: <https://github.com/BBoal/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