emacs: Overhaul configuration completely

3 files changed, 272 insertions, 0 deletions

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)