From 0ee7fa9c382ae30295f0b8d88457f7856c7ff800 Mon Sep 17 00:00:00 2001 From: Thomas Voss Date: Wed, 16 Oct 2024 22:04:33 +0200 Subject: emacs: Overhaul configuration completely --- .config/emacs/site-lisp/increment.el | 132 +++++++++++++++++++++++++ .config/emacs/site-lisp/line-selection-mode.el | 18 ++++ .config/emacs/site-lisp/surround.el | 122 +++++++++++++++++++++++ 3 files changed, 272 insertions(+) create mode 100644 .config/emacs/site-lisp/increment.el create mode 100644 .config/emacs/site-lisp/line-selection-mode.el create mode 100644 .config/emacs/site-lisp/surround.el (limited to '.config/emacs/site-lisp') diff --git a/.config/emacs/site-lisp/increment.el b/.config/emacs/site-lisp/increment.el new file mode 100644 index 0000000..b5bea53 --- /dev/null +++ b/.config/emacs/site-lisp/increment.el @@ -0,0 +1,132 @@ +;;; increment.el -- Increment numbers at point -*- lexical-binding: t; -*- + +(require 'cl-macs) +(require 'rx) + +(defvar increment--binary-number-regexp + (rx (group (or ?- word-start)) + "0b" + (group (* ?0)) + (group (+ (any "01"))) + word-end)) + +(defvar increment--octal-number-regexp + (rx (group (or ?- word-start)) + "0o" + (group (* ?0)) + (group (+ (any "0-7"))) + word-end)) + +(defvar increment--decimal-number-regexp + (rx (group (? ?-)) + (group (* ?0)) + (group (+ (any digit))))) + +(defvar increment--hexadecimal-number-regexp + (rx (group (or ?- word-start)) + "0x" + (group (* ?0)) + (group (+ (any hex-digit))) + word-end)) + +(defvar increment--hexadecimal-lower-number-regexp + (rx (group (or ?- word-start)) + "0o" + (group (* ?0)) + (group (+ (any "0-9a-f"))) + word-end)) + +(defvar increment--number-regexp + (rx (or (seq (or ?- word-start) + (or (seq "0b" (+ (any "01"))) + (seq "0o" (+ (any "0-7"))) + (seq "0x" (+ (any hex-digit)))) + word-end) + (seq (? ?-) (+ (any digit)))))) + +(defun increment--number-to-binary-string (number) + (nreverse + (cl-loop for x = number then (ash x -1) + while (not (= x 0)) + concat (if (= 0 (logand x 1)) "0" "1")))) + +(defun increment--format-number-with-base + (number base leading-zeros buffer-substr hex-style) + (let* ((neg (> 0 number)) + (number (abs number)) + (number-string + (pcase base + (2 (increment--number-to-binary-string number)) + (8 (format "%o" number)) + (10 (number-to-string number)) + (16 (format (if (eq hex-style 'lower) "%x" "%X") number)))) + (length-diff (- (length buffer-substr) + (length number-string))) + (leading-zeros (if (> leading-zeros 0) + (+ leading-zeros length-diff) + 0))) + (concat + (when neg + "-") + (pcase base + (2 "0b") + (8 "0o") + (16 "0x")) + (when (> leading-zeros 0) + (make-string leading-zeros ?0)) + number-string))) + +(defun increment--match-number-at-point () + (cond ((thing-at-point-looking-at + increment--binary-number-regexp) + (cons 2 nil)) + ((thing-at-point-looking-at + increment--octal-number-regexp) + (cons 8 nil)) + ((thing-at-point-looking-at + increment--hexadecimal-number-regexp) + (cons 16 nil)) + ((thing-at-point-looking-at + increment--hexadecimal-lower-number-regexp) + (cons 16 'lower)) + ((thing-at-point-looking-at + increment--decimal-number-regexp) + (cons 10 nil)))) + +;;;###autoload +(cl-defun increment-number-at-point (&optional arg) + "Increment the number at point by ARG or 1 if ARG is nil. If called +interactively, the universal argument can be used to specify ARG. If +the number at point has leading zeros then the width of the number is +preserved." + (interactive "*p") + (save-match-data + (let (case-fold-search + (match-pair (increment--match-number-at-point))) + (unless match-pair + (let ((save-point (point))) + (unless (re-search-forward + increment--number-regexp + (line-end-position) :noerror) + (goto-char save-point) + (cl-return-from increment-number-at-point)) + (setq match-pair (increment--match-number-at-point)))) + (let* ((base (car match-pair)) + (hex-style (cdr match-pair)) + (substr (buffer-substring-no-properties + (match-beginning 3) (match-end 3))) + (sign (if (= (match-beginning 1) (match-end 1)) +1 -1)) + (result (+ (* (string-to-number substr base) sign) + (or arg 1)))) + (replace-match + (increment--format-number-with-base + result base (- (match-end 2) (match-beginning 2)) + substr hex-style)))))) + +;;;###autoload +(defun decrement-number-at-point (&optional arg) + "The same as `increment-number-at-point', but ARG is negated." + (interactive "*p") + (increment-number-at-point (- (or arg 1)))) + +(provide 'increment) diff --git a/.config/emacs/site-lisp/line-selection-mode.el b/.config/emacs/site-lisp/line-selection-mode.el new file mode 100644 index 0000000..83da013 --- /dev/null +++ b/.config/emacs/site-lisp/line-selection-mode.el @@ -0,0 +1,18 @@ +;;; line-selection-mode.el --- Minor mode for selection by lines -*- lexical-binding: t; -*- + +(defvar-local line-selection-mode--cursor-type nil) + +;;;###autoload +(define-minor-mode line-selection-mode + "Enable `hl-line-mode' and hide the current cursor." + :global nil + :init-value nil + (if line-selection-mode + (progn + (hl-line-mode) + (setq line-selection-mode--cursor-type cursor-type) + (setq-local cursor-type nil)) + (hl-line-mode -1) + (setq-local cursor-type line-selection-mode--cursor-type))) + +(provide 'line-selection-mode) diff --git a/.config/emacs/site-lisp/surround.el b/.config/emacs/site-lisp/surround.el new file mode 100644 index 0000000..8fdf443 --- /dev/null +++ b/.config/emacs/site-lisp/surround.el @@ -0,0 +1,122 @@ +;;; surround.el --- Surround a region with delimeters -*- lexical-binding: t; -*- + +(require 'cl-macs) + +(defgroup surround nil + "Customization group for `surround'." + :group 'convenience) + +(defcustom surround-with-paired-bracket-p t + "Surround text with paired brackets. +If non-nil surrounding text with a character (assuming that character is +not configured in `surround-pairs-alist') will attempt to surround the +text with the supplied character and its paired bracket. + +As an example, if `surround-with-paired-bracket-p' is non-nil and the +user attempts to surround the word “foo” with the character “｢” the +result would be “｢foo｣”. + +Whether or not an opening- or closing bracket is provided is not +important; the opening bracket will always be placed at the front of the +region and the closing bracket at the end of the region (assuming +left-to-right writing). + +In more technical terms this function surrounds text with both the +provided character and the characters corresponding Bidi_Paired_Bracket +Unicode property." + :type 'boolean + :package-version '(surround . "1.0.0") + :group 'surround) + +(defcustom surround-with-mirror-p t + "Surround text with mirrored characters. +If non-nil surrounding text with a character (assuming that character is +not configured in `surround-pairs-alist') will attempt to surround the +text with the supplied character and its mirror. + +As an example, if `surround-with-mirror-p' is non-nil and the user +attempts to surround the word “foo” with the character “«” the result +would be “«foo»”. + +Note that unlike `surround-with-paired-bracket-p', because there is no +concept of an “opening” or “closing” bracket — because this option +doesn't work in terms of brackets — ordering matters. This means that +surrounding “Ελλάδα” with “«” will result in “«Ελλάδα»” while +surrounding “Österreich” with “»” will result in “»Österreich«”. + +In more technical terms this function surrounds text with both the +provided character and the characters corresponding Bidi_Mirroring_Glyph +Unicode property." + :type 'boolean + :package-version '(surround . "1.0.0") + :group 'surround) + +(defvar surround-pairs-alist '((emacs-lisp-mode + . ((?` ("`" . "'"))))) + "TODO") + +(defun surround--get-pair-from-alist (char) + (declare (ftype (function (char) (cons string string))) + (side-effect-free t)) + (catch 'surround--break + (let ((char-as-string (char-to-string char))) + (dolist (pair surround-pairs-alist) + (let ((mode-or-t (car pair)) + (pairs (cdr pair))) + (when (or (derived-mode-p mode-or-t) + (eq t mode-or-t)) + (dolist (pair pairs) + (let ((open-or-trigger (car pair)) + (closing-or-pair (cdr pair))) + (if (numberp open-or-trigger) ; Implies trigger + (when (= char open-or-trigger) + (throw 'surround--break (car closing-or-pair))) + (when (string= char-as-string open-or-trigger) + (throw 'surround--break pair))))))))))) + +(defun surround--get-pair (char) + (declare (ftype (function (char) (cons string string))) + (side-effect-free t)) + (or (surround--get-pair-from-alist char) + (let ((char (char-to-string char)) + (other (char-to-string + (or (when surround-with-paired-bracket-p + (get-char-code-property char 'paired-bracket)) + (when surround-with-mirror-p + (get-char-code-property char 'mirroring)) + char))) + (bracket-type (get-char-code-property char 'bracket-type))) + (pcase bracket-type + ((or 'c 'n) (cons other char)) + ('o (cons char other)))))) + +(defun suprround--region (pair beginning end) + (save-excursion + (goto-char beginning) + (insert (car pair)) + (goto-char end) + (insert (cdr pair)))) + +(defun surround-region (char) + (interactive + (list (read-char-from-minibuffer + (format-prompt "Surround with" nil)))) + (when-let ((pair (surround--get-pair char))) + (dolist (bounds (cl-loop for (beginning . end) in (region-bounds) + collect (cons (set-marker (make-marker) beginning) + (set-marker (make-marker) end)))) + (surround--region pair (car bounds) (cdr bounds))))) + +(defun surround-padded-region (char) + (interactive + (list (read-char-from-minibuffer + (format-prompt "Surround with" nil)))) + (when-let ((pair (surround--get-pair char)) + (pair (cons (concat (car pair) " ") + (concat " " (cdr pair))))) + (dolist (bounds (cl-loop for (beginning . end) in (region-bounds) + collect (cons (set-marker (make-marker) beginning) + (set-marker (make-marker) end)))) + (surround--region pair (car bounds) (cdr bounds))))) + +(provide 'surround) -- cgit v1.2.3