blob: 801ae4e9673ae2d7b1948091dc6850374e2ed848 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
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 (lsh 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)
|
