Commit b9e81d0a authored by Stefan Monnier's avatar Stefan Monnier
Browse files

(move-to-column-force): Mark obsolete.

(operate-on-rectangle, delete-extract-rectangle-line)
(insert-rectangle, delete-whitespace-rectangle-line)
(open-rectangle-line, clear-rectangle-line): Use move-to-column.
(string-rectangle-history): New var.
(string-rectangle, string-insert-rectangle): Use it.
(delete-rectangle-line): Fix pos/column mixup and simplify.
parent d1bf2a73
......@@ -37,21 +37,12 @@
;;;###autoload
(defun move-to-column-force (column &optional flag)
"Move point to column COLUMN rigidly in the current line.
If COLUMN is within a multi-column character, replace it by
spaces and tab.
"Obsolete. Use `move-to-column'.
If COLUMN is within a multi-column character, replace it by spaces and tab.
As for `move-to-column', passing anything but nil or t in FLAG will move to
the desired column only if the line is long enough."
(let ((col (move-to-column column (or flag t))))
(if (> col column)
(let (pos)
(delete-char -1)
(insert-char ? (- column (current-column)))
(setq pos (point))
(indent-to col)
(goto-char pos)))
column))
(move-to-column column (or flag t)))
(make-obsolete 'move-to-column-force "move-to-column" "21.2")
;; not used any more --dv
;; extract-rectangle-line stores lines into this list
......@@ -88,12 +79,12 @@ Point is at the end of the segment of this line within the rectangle."
(while (< (point) endlinepos)
(let (startpos begextra endextra)
(if coerce-tabs
(move-to-column-force startcol)
(move-to-column startcol t)
(move-to-column startcol))
(setq begextra (- (current-column) startcol))
(setq startpos (point))
(if coerce-tabs
(move-to-column-force endcol)
(move-to-column endcol t)
(move-to-column endcol))
;; If we overshot, move back one character
;; so that endextra will be positive.
......@@ -135,24 +126,19 @@ the function is called."
))
(defun delete-rectangle-line (startcol endcol fill)
(let ((pt (line-end-position)))
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol)
(if (and (not fill) (<= pt endcol))
(delete-region (point) pt)
;; else
(setq pt (point))
(move-to-column-force endcol)
(delete-region pt (point))))
))
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(delete-region (point)
(progn (move-to-column endcol 'coerce)
(point)))))
(defun delete-extract-rectangle-line (startcol endcol lines fill)
(let ((pt (point-at-eol)))
(if (< (move-to-column-force startcol (or fill 'coerce)) startcol)
(if (< (move-to-column startcol (or fill 'coerce)) startcol)
(setcdr lines (cons (spaces-string (- endcol startcol))
(cdr lines)))
;; else
(setq pt (point))
(move-to-column-force endcol)
(move-to-column endcol t)
(setcdr lines (cons (buffer-substring pt (point)) (cdr lines)))
(delete-region pt (point)))
))
......@@ -277,7 +263,7 @@ and point is at the lower right corner."
(progn
(forward-line 1)
(or (bolp) (insert ?\n))
(move-to-column-force insertcolumn)))
(move-to-column insertcolumn t)))
(setq first nil)
(insert (car lines))
(setq lines (cdr lines)))))
......@@ -297,13 +283,13 @@ on the right side of the rectangle."
(goto-char start))
(defun open-rectangle-line (startcol endcol fill)
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(unless (and (not fill)
(= (point) (point-at-eol)))
(indent-to endcol))))
(defun delete-whitespace-rectangle-line (startcol endcol fill)
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(unless (= (point) (point-at-eol))
(delete-region (point) (progn (skip-syntax-forward " ") (point))))))
......@@ -324,20 +310,29 @@ With a prefix (or a FILL) argument, also fill too short lines."
;; string-rectangle uses this variable to pass the string
;; to string-rectangle-line.
(defvar string-rectangle-string)
(defvar string-rectangle-history nil)
(defun string-rectangle-line (startcol endcol string delete)
(move-to-column-force startcol)
(move-to-column startcol t)
(if delete
(delete-rectangle-line startcol endcol nil))
(insert string))
;;;###autoload
(defun string-rectangle (start end string)
"Replace rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width.
Called from a program, takes three args; START, END and STRING."
(interactive "*r\nsString rectangle: ")
(interactive
(progn (barf-if-buffer-read-only)
(list
(region-beginning)
(region-end)
(read-string (format "String rectangle (default `%s'): "
(or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)))))
(apply-on-rectangle 'string-rectangle-line start end string t))
(defalias 'replace-rectangle 'string-rectangle)
......@@ -349,7 +344,15 @@ Called from a program, takes three args; START, END and STRING."
When called from a program, the rectangle's corners are START and END.
The left edge of the rectangle specifies the column for insertion.
This command does not delete or overwrite any existing text."
(interactive "*r\nsString insert rectangle: ")
(interactive
(progn (barf-if-buffer-read-only)
(list
(region-beginning)
(region-end)
(read-string (format "String insert rectangle (default `%s'): "
(or (car string-rectangle-history) ""))
nil 'string-rectangle-history
(car string-rectangle-history)))))
(apply-on-rectangle 'string-rectangle-line start end string nil))
;;;###autoload
......@@ -366,13 +369,13 @@ rectangle which were empty."
(defun clear-rectangle-line (startcol endcol fill)
(let ((pt (point-at-eol))
spaces)
(when (= (move-to-column-force startcol (or fill 'coerce)) startcol)
(when (= (move-to-column startcol (or fill 'coerce)) startcol)
(if (and (not fill)
(<= (save-excursion (goto-char pt) (current-column)) endcol))
(delete-region (point) pt)
;; else
(setq pt (point))
(move-to-column-force endcol)
(move-to-column endcol t)
(setq spaces (- (point) pt))
(delete-region pt (point))
(indent-to (+ (current-column) spaces))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment