Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 347 lines (310 sloc) 12.037 kb
02b35f8 @mhayashi1120 fix face problems
authored
1 ;;; rect+.el --- Extensions to rect.el
9b6ac7d @mhayashi1120
authored
2
23f2272 @mhayashi1120 fix My name
authored
3 ;; Author: Masahiro Hayashi <mhayashi1120@gmail.com>
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
4 ;; Keywords: extensions, data, tools
f02d02b @mhayashi1120 update URL
authored
5 ;; URL: https://github.com/mhayashi1120/Emacs-rectplus/raw/master/rect+.el
8c280e0 @mhayashi1120 fix multibyte string problem (string-width)
authored
6 ;; Emacs: GNU Emacs 22 or later
0db05ba @mhayashi1120 fix `rectplus-append-rectangle-to-eol' when empty line
authored
7 ;; Version: 1.0.9
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
8 ;; Package-Requires: ()
9b6ac7d @mhayashi1120
authored
9
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 3, or (at
13 ;; your option) any later version.
14
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
24
25 ;;; Commentary:
26
02b35f8 @mhayashi1120 fix face problems
authored
27 ;; rect+.el provides extensions to rect.el
9b6ac7d @mhayashi1120
authored
28
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
29 ;; ## Install:
9b6ac7d @mhayashi1120
authored
30
31 ;; Put this file into load-path'ed directory, and byte compile it if
32 ;; desired. And put the following expression into your ~/.emacs.
33 ;;
34 ;; (require 'rect+)
35 ;; (define-key ctl-x-r-map "C" 'rectplus-copy-rectangle)
36 ;; (define-key ctl-x-r-map "N" 'rectplus-insert-number-rectangle)
37 ;; (define-key ctl-x-r-map "\M-c" 'rectplus-create-rectangle-by-regexp)
38 ;; (define-key ctl-x-r-map "A" 'rectplus-append-rectangle-to-eol)
39 ;; (define-key ctl-x-r-map "R" 'rectplus-kill-ring-to-rectangle)
40 ;; (define-key ctl-x-r-map "K" 'rectplus-rectangle-to-kill-ring)
41 ;; (define-key ctl-x-r-map "\M-l" 'rectplus-downcase-rectangle)
42 ;; (define-key ctl-x-r-map "\M-u" 'rectplus-upcase-rectangle)
43
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
44 ;; ```********** Emacs 22 or earlier **********```
26bc314 @mhayashi1120 fix doc
authored
45 ;; (require 'rect+)
accd833 @mhayashi1120 color-dired.el defvar -> defcustom
authored
46 ;; (global-set-key "\C-xrC" 'rectplus-copy-rectangle)
47 ;; (global-set-key "\C-xrN" 'rectplus-insert-number-rectangle)
48 ;; (global-set-key "\C-xr\M-c" 'rectplus-create-rectangle-by-regexp)
49 ;; (global-set-key "\C-xrA" 'rectplus-append-rectangle-to-eol)
50 ;; (global-set-key "\C-xrR" 'rectplus-kill-ring-to-rectangle)
51 ;; (global-set-key "\C-xrK" 'rectplus-rectangle-to-kill-ring)
52 ;; (global-set-key "\C-xr\M-l" 'rectplus-downcase-rectangle)
53 ;; (global-set-key "\C-xr\M-u" 'rectplus-upcase-rectangle)
9b6ac7d @mhayashi1120
authored
54
55 ;;; Code:
56
57 (require 'rect)
58
59 (defvar current-prefix-arg)
60
f12ca5a @mhayashi1120 add autoload comments
authored
61 ;;;###autoload
9b6ac7d @mhayashi1120
authored
62 (defun rectplus-rectangle-to-kill-ring ()
63 "Killed rectangle to normal `kill-ring'.
64 After executing this command, you can type \\[yank]."
65 (interactive)
66 (with-temp-buffer
67 (yank-rectangle)
68 ;;avoid message
f23bb45 @mhayashi1120 remove trailing space
authored
69 (let (message-log-max)
9b6ac7d @mhayashi1120
authored
70 (message ""))
71 (kill-new (buffer-string)))
72 (message (substitute-command-keys
73 (concat "Killed rectangle converted to normal text. "
74 "You can type \\[yank] now."))))
75
f12ca5a @mhayashi1120 add autoload comments
authored
76 ;;;###autoload
9b6ac7d @mhayashi1120
authored
77 (defun rectplus-kill-ring-to-rectangle (&optional succeeding)
f23bb45 @mhayashi1120 remove trailing space
authored
78 "Make rectangle from clipboard or `kill-ring'.
9b6ac7d @mhayashi1120
authored
79 After executing this command, you can type \\[yank-rectangle]."
f23bb45 @mhayashi1120 remove trailing space
authored
80 (interactive
9b6ac7d @mhayashi1120
authored
81 (let (str)
f23bb45 @mhayashi1120 remove trailing space
authored
82 (when current-prefix-arg
9b6ac7d @mhayashi1120
authored
83 (setq str (read-from-minibuffer "Succeeding string to killed: ")))
84 (list str)))
85 (let ((tab tab-width))
86 (with-temp-buffer
87 ;; restore
88 (setq tab-width tab)
89 (insert (current-kill 0))
90 (goto-char (point-min))
91 (let ((max 0)
92 str len list)
93 (while (not (eobp))
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
94 (setq str (buffer-substring (point-at-bol) (point-at-eol)))
9b6ac7d @mhayashi1120
authored
95 (when succeeding
96 (setq str (concat str succeeding)))
8c280e0 @mhayashi1120 fix multibyte string problem (string-width)
authored
97 (setq len (string-width str))
9b6ac7d @mhayashi1120
authored
98 (when (> len max)
99 (setq max len))
100 (setq list (cons str list))
101 (forward-line 1))
f23bb45 @mhayashi1120 remove trailing space
authored
102 (setq killed-rectangle
9b6ac7d @mhayashi1120
authored
103 (rectplus-non-rectangle-to-rectangle (nreverse list) max)))))
f23bb45 @mhayashi1120 remove trailing space
authored
104 (message (substitute-command-keys
9b6ac7d @mhayashi1120
authored
105 (concat "Killed text converted to rectangle. "
106 "You can type \\[yank-rectangle] now."))))
107
f12ca5a @mhayashi1120 add autoload comments
authored
108 ;;;###autoload
9b6ac7d @mhayashi1120
authored
109 (defun rectplus-append-rectangle-to-eol (&optional preceeding)
110 "Append killed rectangle to end-of-line sequentially."
111 (interactive
112 (let (str)
f23bb45 @mhayashi1120 remove trailing space
authored
113 (when current-prefix-arg
9b6ac7d @mhayashi1120
authored
114 (setq str (read-from-minibuffer "Preceeding string to append: ")))
115 (list str)))
116 (unless preceeding
117 (setq preceeding ""))
118 (save-excursion
119 (mapc
120 (lambda (x)
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
121 (goto-char (point-at-eol))
9b6ac7d @mhayashi1120
authored
122 (insert preceeding)
123 (insert x)
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
124 (forward-line 1)
0db05ba @mhayashi1120 fix `rectplus-append-rectangle-to-eol' when empty line
authored
125 (when (and (eolp)
126 (not (bolp)))
700de43 @mhayashi1120 rename to familiar function point-at-eol/point-at-bol
authored
127 (newline)))
9b6ac7d @mhayashi1120
authored
128 killed-rectangle)))
129
f12ca5a @mhayashi1120 add autoload comments
authored
130 ;;;###autoload
9b6ac7d @mhayashi1120
authored
131 (defun rectplus-copy-rectangle (start end)
132 "Copy rectangle area."
133 (interactive "r")
134 (deactivate-mark)
135 (setq killed-rectangle (extract-rectangle start end)))
136
f12ca5a @mhayashi1120 add autoload comments
authored
137 ;;;###autoload
b8ce411 @mhayashi1120 extend acceptable formats
authored
138 (defun rectplus-insert-number-rectangle (begin end number-fmt &optional step start-from)
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
139 "Insert incremental number into each left edges of rectangle's line.
9b6ac7d @mhayashi1120
authored
140
b8ce411 @mhayashi1120 extend acceptable formats
authored
141 BEGIN END is rectangle region to insert numbers.
142 Which is allowed BEGIN over END. In this case, inserted descendant numbers.
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
143 e.g
144 1. In dired buffer type `\\<dired-mode-map>\\[dired-sort-toggle-or-edit]' \
145 to sort by modified date descendantly.
b8ce411 @mhayashi1120 extend acceptable formats
authored
146 2. Type \\<dired-mode-map>\\[wdired-change-to-wdired-mode] to use `wdired'.
147 3. Activate region from old file to new file.
148 4. Do this command to make sequential file name ordered by modified date.
9b6ac7d @mhayashi1120
authored
149
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
150 NUMBER-FMT may indicate start number and inserted format.
9b6ac7d @mhayashi1120
authored
151 \"1\" => [\"1\" \"2\" \"3\" ...]
152 \"001\" => [\"001\" \"002\" \"003\" ...]
153 \" 1\" => [\" 1\" \" 2\" \" 3\" ...]
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
154 \" 5\" => [\" 5\" \" 6\" \" 7\" ...]
9b6ac7d @mhayashi1120
authored
155
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
156 This format indication more familiar than `rectangle-number-lines'
157 implementation, I think :-)
158
b8ce411 @mhayashi1120 extend acceptable formats
authored
159 On the other hand NUMBER-FMT accept \"%d\", \"%o\", \"%x\" like format too.
bb3fe08 @mhayashi1120 fix comments and message
authored
160
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
161 \"%03d\" => [\"001\" \"002\" \"003\" ...]
162 \"%3d\" => [\" 1\" \" 2\" \" 3\" ...]
163 \"file-%03d\" => [\"file-001\" \"file-002\" \"file-003\" ...]
b8ce411 @mhayashi1120 extend acceptable formats
authored
164 \"%03x\" => [\"001\" ... \"00a\" \"00b\" ...]
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
165
166 START-FROM indicate number to start, more prior than NUMBER-FMT.
167 STEP is incremental count. Default is 1.
9b6ac7d @mhayashi1120
authored
168 "
f23bb45 @mhayashi1120 remove trailing space
authored
169 (interactive
9b6ac7d @mhayashi1120
authored
170 (progn
171 (unless mark-active
172 (signal 'mark-inactive nil))
173 (let ((beg (region-beginning))
174 (fin (region-end))
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
175 fmt step start-num)
8c280e0 @mhayashi1120 fix multibyte string problem (string-width)
authored
176 ;; swap start end if mark move backward to beginning-of-buffer
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
177 (when (eq beg (point))
178 (let ((tmp beg))
179 (setq beg fin
180 fin tmp)))
181 (setq fmt (rectplus-read-from-minibuffer
b8ce411 @mhayashi1120 extend acceptable formats
authored
182 "Start number or format: "
183 ;; allow all
184 ".+"))
9b6ac7d @mhayashi1120
authored
185 (when current-prefix-arg
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
186 (setq step (rectplus-read-number "Step: " 1))
b8ce411 @mhayashi1120 extend acceptable formats
authored
187 (when (rectplus--just-a-format-p fmt)
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
188 (setq start-num (rectplus-read-number "Start from: " 1))))
9b6ac7d @mhayashi1120
authored
189 (deactivate-mark)
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
190 (list beg fin fmt step start-num))))
b8ce411 @mhayashi1120 extend acceptable formats
authored
191 (let* ((min (min begin end))
192 (max (max begin end))
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
193 (lines (rectplus--count-lines min max))
194 (l 0)
b8ce411 @mhayashi1120 extend acceptable formats
authored
195 fmt start rect-lst)
196 (cond
197 ((rectplus--just-a-format-p number-fmt)
198 (setq fmt number-fmt)
199 ;; default is start from 1
200 (setq start (or start-from 1)))
201 ((string-match "\\([0 ]\\)*\\([1-9][0-9]*\\)" number-fmt)
202 (let* ((before (substring number-fmt 0 (match-beginning 0)))
203 (after (substring number-fmt (match-end 0)))
204 (start-text (match-string 2 number-fmt))
205 (padchar (match-string 1 number-fmt))
206 (fmt-body (match-string 0 number-fmt))
207 (fmtlen (number-to-string (length fmt-body))))
208 (setq fmt (concat before "%" padchar fmtlen "d" after))
209 (setq start (string-to-number start-text))))
210 (t (error "Invalid number format %s" fmt)))
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
211 (setq step (or step 1))
212 (save-excursion
213 (delete-rectangle min max)
214 ;; computing list of insertings
9b6ac7d @mhayashi1120
authored
215 (while (< l lines)
b8ce411 @mhayashi1120 extend acceptable formats
authored
216 (setq rect-lst (cons (format fmt start) rect-lst))
217 (setq start (+ step start)
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
218 l (1+ l)))
b8ce411 @mhayashi1120 extend acceptable formats
authored
219 (when (>= end begin)
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
220 (setq rect-lst (nreverse rect-lst)))
221 (goto-char min)
222 (insert-rectangle rect-lst))))
9b6ac7d @mhayashi1120
authored
223
f12ca5a @mhayashi1120 add autoload comments
authored
224 ;;;###autoload
9b6ac7d @mhayashi1120
authored
225 (defun rectplus-create-rectangle-by-regexp (start end regexp)
226 "Capture string matching to REGEXP.
227 Only effect to region if region is activated.
228 "
f23bb45 @mhayashi1120 remove trailing space
authored
229 (interactive
9b6ac7d @mhayashi1120
authored
230 (let* ((beg (if mark-active (region-beginning) (point-min)))
231 (end (if mark-active (region-end) (point-max)))
232 (regexp (rectplus-read-regexp "Regexp")))
233 (list beg end regexp)))
234 (let ((max 0)
235 str len list)
236 (save-excursion
f23bb45 @mhayashi1120 remove trailing space
authored
237 (save-restriction
9b6ac7d @mhayashi1120
authored
238 (narrow-to-region start end)
239 (goto-char (point-min))
240 (while (re-search-forward regexp nil t)
241 (setq str (match-string 0))
242 (setq len (string-width str))
243 (setq list (cons str list))
244 (when (> len max)
245 (setq max len)))))
246 ;; fill by space
f23bb45 @mhayashi1120 remove trailing space
authored
247 (setq killed-rectangle
9b6ac7d @mhayashi1120
authored
248 (rectplus-non-rectangle-to-rectangle (nreverse list) max))))
249
f12ca5a @mhayashi1120 add autoload comments
authored
250 ;;;###autoload
9b6ac7d @mhayashi1120
authored
251 (defun rectplus-upcase-rectangle (start end)
8c280e0 @mhayashi1120 fix multibyte string problem (string-width)
authored
252 "Upcase rectangle"
9b6ac7d @mhayashi1120
authored
253 (interactive "*r")
254 (rectplus-do-translate start end 'upcase))
255
f12ca5a @mhayashi1120 add autoload comments
authored
256 ;;;###autoload
9b6ac7d @mhayashi1120
authored
257 (defun rectplus-downcase-rectangle (start end)
8c280e0 @mhayashi1120 fix multibyte string problem (string-width)
authored
258 "Downcase rectangle"
9b6ac7d @mhayashi1120
authored
259 (interactive "*r")
260 (rectplus-do-translate start end 'downcase))
261
b8ce411 @mhayashi1120 extend acceptable formats
authored
262 (defun rectplus--just-a-format-p (fmt)
263 (and
264 (condition-case nil (format fmt 1) (error nil))
265 ;; heuristic check ;-)
266 (catch 'done
267 (let ((i 0))
268 (while (< i 3)
269 (let* ((r (random))
270 (fmttext (format fmt r))
271 (dectext (number-to-string r))
272 (hextext (format "%x" r))
273 (octtext (format "%o" r))
274 (case-fold-search t))
275 (unless (or (string-match dectext fmttext)
276 (string-match hextext fmttext)
277 (string-match octtext fmttext))
278 (throw 'done nil))
279 (setq i (1+ i))))
280 t))))
281
dc3b1c3 @mhayashi1120 improve inserting numbers
authored
282 (defun rectplus--count-lines (start end)
283 (let ((lines 0))
284 (save-excursion
285 (goto-char start)
286 (while (and (<= (point) end)
287 (not (eobp)))
288 (forward-line 1)
289 (setq lines (1+ lines))))
290 lines))
291
9b6ac7d @mhayashi1120
authored
292 (defun rectplus-do-translate (start end translator)
293 "TRANSLATOR is function accept one string argument and return string."
f23bb45 @mhayashi1120 remove trailing space
authored
294 (apply-on-rectangle
9b6ac7d @mhayashi1120
authored
295 (lambda (s e)
296 (let* ((start (progn (move-to-column s) (point)))
297 (end (progn (move-to-column e) (point)))
298 (current (buffer-substring start end))
299 (new (funcall translator current)))
300 (unless (string= current new)
301 (delete-region start end)
302 (insert new))))
303 start end))
304
305 (defun rectplus-read-from-minibuffer (prompt must-match-regexp &optional default)
306 "Check input string by MUST-MACH-REGEXP.
307 See `read-from-minibuffer'."
308 (let (str)
309 (while (null str)
310 (setq str (read-from-minibuffer prompt default))
311 (unless (string-match must-match-regexp str)
312 (message "Invalid string!")
313 (sit-for 0.5)
314 (setq str nil)))
315 str))
316
317 (defun rectplus-read-number (prompt default)
f23bb45 @mhayashi1120 remove trailing space
authored
318 (string-to-number (rectplus-read-from-minibuffer
f02d02b @mhayashi1120 update URL
authored
319 prompt "\\`[-+]?[0-9]+\\'"
9b6ac7d @mhayashi1120
authored
320 (number-to-string default))))
321
322 (defun rectplus-non-rectangle-to-rectangle (strings &optional max)
323 (let ((fmt (concat "%-" (number-to-string max) "s")))
324 (mapcar
325 (lambda (s)
326 (format fmt s))
327 strings)))
328
329 (defun rectplus-read-regexp (prompt)
330 (if (fboundp 'read-regexp)
331 (read-regexp prompt)
332 (read-from-minibuffer (concat prompt ": "))))
333
f02d02b @mhayashi1120 update URL
authored
334 ;; for ELPA
335 ;;;###autoload(define-key ctl-x-r-map "C" 'rectplus-copy-rectangle)
336 ;;;###autoload(define-key ctl-x-r-map "N" 'rectplus-insert-number-rectangle)
337 ;;;###autoload(define-key ctl-x-r-map "\M-c" 'rectplus-create-rectangle-by-regexp)
338 ;;;###autoload(define-key ctl-x-r-map "A" 'rectplus-append-rectangle-to-eol)
339 ;;;###autoload(define-key ctl-x-r-map "R" 'rectplus-kill-ring-to-rectangle)
340 ;;;###autoload(define-key ctl-x-r-map "K" 'rectplus-rectangle-to-kill-ring)
341 ;;;###autoload(define-key ctl-x-r-map "\M-l" 'rectplus-downcase-rectangle)
342 ;;;###autoload(define-key ctl-x-r-map "\M-u" 'rectplus-upcase-rectangle)
343
9b6ac7d @mhayashi1120
authored
344 (provide 'rect+)
345
346 ;;; rect+.el ends here
Something went wrong with that request. Please try again.