37 |
|
|
38 |
;;;###autoload |
;;;###autoload |
39 |
(defun move-to-column-force (column &optional flag) |
(defun move-to-column-force (column &optional flag) |
40 |
"Move point to column COLUMN rigidly in the current line. |
"Obsolete. Use `move-to-column'. |
41 |
If COLUMN is within a multi-column character, replace it by |
If COLUMN is within a multi-column character, replace it by spaces and tab. |
|
spaces and tab. |
|
|
|
|
42 |
As for `move-to-column', passing anything but nil or t in FLAG will move to |
As for `move-to-column', passing anything but nil or t in FLAG will move to |
43 |
the desired column only if the line is long enough." |
the desired column only if the line is long enough." |
44 |
(let ((col (move-to-column column (or flag t)))) |
(move-to-column column (or flag t))) |
45 |
(if (> col column) |
(make-obsolete 'move-to-column-force "move-to-column" "21.2") |
|
(let (pos) |
|
|
(delete-char -1) |
|
|
(insert-char ? (- column (current-column))) |
|
|
(setq pos (point)) |
|
|
(indent-to col) |
|
|
(goto-char pos))) |
|
|
column)) |
|
46 |
|
|
47 |
;; not used any more --dv |
;; not used any more --dv |
48 |
;; extract-rectangle-line stores lines into this list |
;; extract-rectangle-line stores lines into this list |
79 |
(while (< (point) endlinepos) |
(while (< (point) endlinepos) |
80 |
(let (startpos begextra endextra) |
(let (startpos begextra endextra) |
81 |
(if coerce-tabs |
(if coerce-tabs |
82 |
(move-to-column-force startcol) |
(move-to-column startcol t) |
83 |
(move-to-column startcol)) |
(move-to-column startcol)) |
84 |
(setq begextra (- (current-column) startcol)) |
(setq begextra (- (current-column) startcol)) |
85 |
(setq startpos (point)) |
(setq startpos (point)) |
86 |
(if coerce-tabs |
(if coerce-tabs |
87 |
(move-to-column-force endcol) |
(move-to-column endcol t) |
88 |
(move-to-column endcol)) |
(move-to-column endcol)) |
89 |
;; If we overshot, move back one character |
;; If we overshot, move back one character |
90 |
;; so that endextra will be positive. |
;; so that endextra will be positive. |
126 |
)) |
)) |
127 |
|
|
128 |
(defun delete-rectangle-line (startcol endcol fill) |
(defun delete-rectangle-line (startcol endcol fill) |
129 |
(let ((pt (line-end-position))) |
(when (= (move-to-column startcol (or fill 'coerce)) startcol) |
130 |
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
(delete-region (point) |
131 |
(if (and (not fill) (<= pt endcol)) |
(progn (move-to-column endcol 'coerce) |
132 |
(delete-region (point) pt) |
(point))))) |
|
;; else |
|
|
(setq pt (point)) |
|
|
(move-to-column-force endcol) |
|
|
(delete-region pt (point)))) |
|
|
)) |
|
133 |
|
|
134 |
(defun delete-extract-rectangle-line (startcol endcol lines fill) |
(defun delete-extract-rectangle-line (startcol endcol lines fill) |
135 |
(let ((pt (point-at-eol))) |
(let ((pt (point-at-eol))) |
136 |
(if (< (move-to-column-force startcol (or fill 'coerce)) startcol) |
(if (< (move-to-column startcol (or fill 'coerce)) startcol) |
137 |
(setcdr lines (cons (spaces-string (- endcol startcol)) |
(setcdr lines (cons (spaces-string (- endcol startcol)) |
138 |
(cdr lines))) |
(cdr lines))) |
139 |
;; else |
;; else |
140 |
(setq pt (point)) |
(setq pt (point)) |
141 |
(move-to-column-force endcol) |
(move-to-column endcol t) |
142 |
(setcdr lines (cons (buffer-substring pt (point)) (cdr lines))) |
(setcdr lines (cons (buffer-substring pt (point)) (cdr lines))) |
143 |
(delete-region pt (point))) |
(delete-region pt (point))) |
144 |
)) |
)) |
263 |
(progn |
(progn |
264 |
(forward-line 1) |
(forward-line 1) |
265 |
(or (bolp) (insert ?\n)) |
(or (bolp) (insert ?\n)) |
266 |
(move-to-column-force insertcolumn))) |
(move-to-column insertcolumn t))) |
267 |
(setq first nil) |
(setq first nil) |
268 |
(insert (car lines)) |
(insert (car lines)) |
269 |
(setq lines (cdr lines))))) |
(setq lines (cdr lines))))) |
283 |
(goto-char start)) |
(goto-char start)) |
284 |
|
|
285 |
(defun open-rectangle-line (startcol endcol fill) |
(defun open-rectangle-line (startcol endcol fill) |
286 |
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
(when (= (move-to-column startcol (or fill 'coerce)) startcol) |
287 |
(unless (and (not fill) |
(unless (and (not fill) |
288 |
(= (point) (point-at-eol))) |
(= (point) (point-at-eol))) |
289 |
(indent-to endcol)))) |
(indent-to endcol)))) |
290 |
|
|
291 |
(defun delete-whitespace-rectangle-line (startcol endcol fill) |
(defun delete-whitespace-rectangle-line (startcol endcol fill) |
292 |
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
(when (= (move-to-column startcol (or fill 'coerce)) startcol) |
293 |
(unless (= (point) (point-at-eol)) |
(unless (= (point) (point-at-eol)) |
294 |
(delete-region (point) (progn (skip-syntax-forward " ") (point)))))) |
(delete-region (point) (progn (skip-syntax-forward " ") (point)))))) |
295 |
|
|
310 |
;; string-rectangle uses this variable to pass the string |
;; string-rectangle uses this variable to pass the string |
311 |
;; to string-rectangle-line. |
;; to string-rectangle-line. |
312 |
(defvar string-rectangle-string) |
(defvar string-rectangle-string) |
313 |
|
(defvar string-rectangle-history nil) |
314 |
(defun string-rectangle-line (startcol endcol string delete) |
(defun string-rectangle-line (startcol endcol string delete) |
315 |
(move-to-column-force startcol) |
(move-to-column startcol t) |
316 |
(if delete |
(if delete |
317 |
(delete-rectangle-line startcol endcol nil)) |
(delete-rectangle-line startcol endcol nil)) |
318 |
(insert string)) |
(insert string)) |
319 |
|
|
320 |
;;;###autoload |
;;;###autoload |
321 |
|
|
322 |
(defun string-rectangle (start end string) |
(defun string-rectangle (start end string) |
323 |
"Replace rectangle contents with STRING on each line. |
"Replace rectangle contents with STRING on each line. |
324 |
The length of STRING need not be the same as the rectangle width. |
The length of STRING need not be the same as the rectangle width. |
325 |
|
|
326 |
Called from a program, takes three args; START, END and STRING." |
Called from a program, takes three args; START, END and STRING." |
327 |
(interactive "*r\nsString rectangle: ") |
(interactive |
328 |
|
(progn (barf-if-buffer-read-only) |
329 |
|
(list |
330 |
|
(region-beginning) |
331 |
|
(region-end) |
332 |
|
(read-string (format "String rectangle (default `%s'): " |
333 |
|
(or (car string-rectangle-history) "")) |
334 |
|
nil 'string-rectangle-history |
335 |
|
(car string-rectangle-history))))) |
336 |
(apply-on-rectangle 'string-rectangle-line start end string t)) |
(apply-on-rectangle 'string-rectangle-line start end string t)) |
337 |
|
|
338 |
(defalias 'replace-rectangle 'string-rectangle) |
(defalias 'replace-rectangle 'string-rectangle) |
344 |
When called from a program, the rectangle's corners are START and END. |
When called from a program, the rectangle's corners are START and END. |
345 |
The left edge of the rectangle specifies the column for insertion. |
The left edge of the rectangle specifies the column for insertion. |
346 |
This command does not delete or overwrite any existing text." |
This command does not delete or overwrite any existing text." |
347 |
(interactive "*r\nsString insert rectangle: ") |
(interactive |
348 |
|
(progn (barf-if-buffer-read-only) |
349 |
|
(list |
350 |
|
(region-beginning) |
351 |
|
(region-end) |
352 |
|
(read-string (format "String insert rectangle (default `%s'): " |
353 |
|
(or (car string-rectangle-history) "")) |
354 |
|
nil 'string-rectangle-history |
355 |
|
(car string-rectangle-history))))) |
356 |
(apply-on-rectangle 'string-rectangle-line start end string nil)) |
(apply-on-rectangle 'string-rectangle-line start end string nil)) |
357 |
|
|
358 |
;;;###autoload |
;;;###autoload |
369 |
(defun clear-rectangle-line (startcol endcol fill) |
(defun clear-rectangle-line (startcol endcol fill) |
370 |
(let ((pt (point-at-eol)) |
(let ((pt (point-at-eol)) |
371 |
spaces) |
spaces) |
372 |
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol) |
(when (= (move-to-column startcol (or fill 'coerce)) startcol) |
373 |
(if (and (not fill) |
(if (and (not fill) |
374 |
(<= (save-excursion (goto-char pt) (current-column)) endcol)) |
(<= (save-excursion (goto-char pt) (current-column)) endcol)) |
375 |
(delete-region (point) pt) |
(delete-region (point) pt) |
376 |
;; else |
;; else |
377 |
(setq pt (point)) |
(setq pt (point)) |
378 |
(move-to-column-force endcol) |
(move-to-column endcol t) |
379 |
(setq spaces (- (point) pt)) |
(setq spaces (- (point) pt)) |
380 |
(delete-region pt (point)) |
(delete-region pt (point)) |
381 |
(indent-to (+ (current-column) spaces)))))) |
(indent-to (+ (current-column) spaces)))))) |