From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Juri Linkov Newsgroups: gmane.emacs.devel Subject: Design of commands operating on rectangular regions (was: Feature freezes and Emacs 25) Date: Thu, 12 Nov 2015 23:38:29 +0200 Organization: LINKOV.NET Message-ID: <876116ucdm.fsf_-_@mail.linkov.net> References: <87zizeme8k.fsf@tromey.com> <5625B166.3080104@dancol.org> <86zizdczhp.fsf@stephe-leake.org> <871tc315y3.fsf@lifelogs.com> <83k2pvqg0l.fsf@gnu.org> <837fluqkd1.fsf@gnu.org> <87oaf1s82r.fsf@mail.linkov.net> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1447364471 22676 80.91.229.3 (12 Nov 2015 21:41:11 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Thu, 12 Nov 2015 21:41:11 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Nov 12 22:40:56 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Zwzbz-0004L7-N2 for ged-emacs-devel@m.gmane.org; Thu, 12 Nov 2015 22:40:56 +0100 Original-Received: from localhost ([::1]:49890 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zwzbz-00009w-1e for ged-emacs-devel@m.gmane.org; Thu, 12 Nov 2015 16:40:55 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:40248) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zwzbt-0008Ml-0B for emacs-devel@gnu.org; Thu, 12 Nov 2015 16:40:51 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Zwzbo-0004LY-PA for emacs-devel@gnu.org; Thu, 12 Nov 2015 16:40:48 -0500 Original-Received: from sub3.mail.dreamhost.com ([69.163.253.7]:38028 helo=homiemail-a39.g.dreamhost.com) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zwzbo-0004Kp-8u for emacs-devel@gnu.org; Thu, 12 Nov 2015 16:40:44 -0500 Original-Received: from homiemail-a39.g.dreamhost.com (localhost [127.0.0.1]) by homiemail-a39.g.dreamhost.com (Postfix) with ESMTP id 25599150074 for ; Thu, 12 Nov 2015 13:40:43 -0800 (PST) Original-Received: from localhost.linkov.net (m83-191-160-148.cust.tele2.ee [83.191.160.148]) (Authenticated sender: jurta@jurta.org) by homiemail-a39.g.dreamhost.com (Postfix) with ESMTPA id E864715006D for ; Thu, 12 Nov 2015 13:40:41 -0800 (PST) In-Reply-To: (John Wiegley's message of "Tue, 10 Nov 2015 17:16:18 -0800") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.50 (x86_64-pc-linux-gnu) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x (no timestamps) [generic] X-Received-From: 69.163.253.7 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:194288 Archived-At: --=-=-= Content-Type: text/plain > If your work is similar to Alan's in nature, I'd be willing to extend its > deadline beyond the freeze date as well -- if it doesn't come in too late. Thanks, here is a complete patch from bug#19829 ready to install: --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=rectangular_regions.patch diff --git a/lisp/simple.el b/lisp/simple.el index 1f2f4fe..3d09a54 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -970,15 +970,34 @@ (defcustom delete-active-region t (defvar region-extract-function (lambda (delete) (when (region-beginning) - (if (eq delete 'delete-only) - (delete-region (region-beginning) (region-end)) - (filter-buffer-substring (region-beginning) (region-end) delete)))) + (cond + ((eq delete 'bounds) + (list (cons (region-beginning) (region-end)))) + ((eq delete 'delete-only) + (delete-region (region-beginning) (region-end))) + (t + (filter-buffer-substring (region-beginning) (region-end) delete))))) "Function to get the region's content. Called with one argument DELETE. If DELETE is `delete-only', then only delete the region and the return value is undefined. If DELETE is nil, just return the content as a string. +If DELETE is `bounds', then don't delete, but just return the +bounds of the region as a list of (START . END) boundaries. If anything else, delete the region and return its content as a string.") +(defvar region-insert-function + (lambda (lines) + (let ((first t)) + (while lines + (or first + (insert ?\n)) + (insert-for-yank (car lines)) + (setq lines (cdr lines) + first nil)))) + "Function to insert the region's content. +Called with one argument LINES. +Insert the region as a list of lines.") + (defun delete-backward-char (n &optional killflag) "Delete the previous N characters (following if N is negative). If Transient Mark mode is enabled, the mark is active, and N is 1, @@ -3282,7 +3306,8 @@ (defun shell-command-sentinel (process signal) (defun shell-command-on-region (start end command &optional output-buffer replace - error-buffer display-error-buffer) + error-buffer display-error-buffer + region-noncontiguous-p) "Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. Return the exit code of @@ -3345,7 +3370,8 @@ (defun shell-command-on-region (start end command current-prefix-arg current-prefix-arg shell-command-default-error-buffer - t))) + t + (region-noncontiguous-p)))) (let ((error-file (if error-buffer (make-temp-file @@ -3354,6 +3380,19 @@ (defun shell-command-on-region (start end command temporary-file-directory))) nil)) exit-status) + ;; Unless a single contiguous chunk is selected, operate on multiple chunks. + (if region-noncontiguous-p + (let ((input (concat (funcall region-extract-function 'delete) "\n")) + output) + (with-temp-buffer + (insert input) + (call-process-region (point-min) (point-max) + shell-file-name t t + nil shell-command-switch + command) + (setq output (split-string (buffer-string) "\n"))) + (goto-char start) + (funcall region-insert-function output)) (if (or replace (and output-buffer (not (or (bufferp output-buffer) (stringp output-buffer))))) @@ -3443,7 +3482,7 @@ (defun shell-command-on-region (start end command exit-status output)))) ;; Don't kill: there might be useful info in the undo-log. ;; (kill-buffer buffer) - )))) + ))))) (when (and error-file (file-exists-p error-file)) (if (< 0 (nth 7 (file-attributes error-file))) @@ -5038,6 +5077,8 @@ (defun region-active-p () ;; region is active when there's no mark. (progn (cl-assert (mark)) t))) +(defun region-noncontiguous-p () + (> (length (funcall region-extract-function 'bounds)) 1)) (defvar redisplay-unhighlight-region-function (lambda (rol) (when (overlayp rol) (delete-overlay rol)))) diff --git a/lisp/rect.el b/lisp/rect.el index acd3a48..560fbc2 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -257,6 +257,19 @@ (defun extract-rectangle (start end) (apply-on-rectangle 'extract-rectangle-line start end lines) (nreverse (cdr lines)))) +(defun extract-rectangle-bounds (start end) + "Return the bounds of the rectangle with corners at START and END. +Return it as a list of (START . END) boundaries, one for each line of +the rectangle." + (let (bounds) + (apply-on-rectangle + (lambda (startcol endcol) + (move-to-column startcol) + (push (cons (prog1 (point) (move-to-column endcol)) (point)) + bounds)) + start end) + (nreverse bounds))) + (defvar killed-rectangle nil "Rectangle for `yank-rectangle' to insert.") @@ -563,6 +576,8 @@ (add-function :around redisplay-unhighlight-region-function #'rectangle--unhighlight-for-redisplay) (add-function :around region-extract-function #'rectangle--extract-region) +(add-function :around region-insert-function + #'rectangle--insert-region) (defvar rectangle-mark-mode-map (let ((map (make-sparse-keymap))) @@ -681,8 +696,12 @@ (defun rectangle-previous-line (&optional n) (defun rectangle--extract-region (orig &optional delete) - (if (not rectangle-mark-mode) - (funcall orig delete) + (cond + ((not rectangle-mark-mode) + (funcall orig delete)) + ((eq delete 'bounds) + (extract-rectangle-bounds (region-beginning) (region-end))) + (t (let* ((strs (funcall (if delete #'delete-extract-rectangle #'extract-rectangle) @@ -696,7 +715,14 @@ (defun rectangle--extract-region (orig &optional delete) (put-text-property 0 (length str) 'yank-handler `(rectangle--insert-for-yank ,strs t) str) - str)))) + str))))) + +(defun rectangle--insert-region (orig strings) + (cond + ((not rectangle-mark-mode) + (funcall orig strings)) + (t + (funcall #'insert-rectangle strings)))) (defun rectangle--insert-for-yank (strs) (push (point) buffer-undo-list) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index ea8b524..d389f6e 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -666,6 +666,22 @@ (defun cua--extract-rectangle () (setq rect (cons row rect)))))) (nreverse rect))) +(defun cua--extract-rectangle-bounds () + (let (rect) + (if (not (cua--rectangle-virtual-edges)) + (cua--rectangle-operation nil nil nil nil nil ; do not tabify + (lambda (s e _l _r) + (setq rect (cons (cons s e) rect)))) + (cua--rectangle-operation nil 1 nil nil nil ; do not tabify + (lambda (s e l r _v) + (goto-char s) + (move-to-column l) + (setq s (point)) + (move-to-column r) + (setq e (point)) + (setq rect (cons (cons s e) rect))))) + (nreverse rect))) + (defun cua--insert-rectangle (rect &optional below paste-column line-count) ;; Insert rectangle as insert-rectangle, but don't set mark and exit with ;; point at either next to top right or below bottom left corner @@ -1394,6 +1410,8 @@ (defun cua--rectangle-post-command () (add-function :around region-extract-function #'cua--rectangle-region-extract) +(add-function :around region-insert-function + #'cua--insert-rectangle) (add-function :around redisplay-highlight-region-function #'cua--rectangle-highlight-for-redisplay) @@ -1405,8 +1423,12 @@ (defun cua--rectangle-highlight-for-redisplay (orig &rest args) (defun cua--rectangle-region-extract (orig &optional delete) (cond - ((not cua--rectangle) (funcall orig delete)) - ((eq delete 'delete-only) (cua--delete-rectangle)) + ((not cua--rectangle) + (funcall orig delete)) + ((eq delete 'bounds) + (cua--extract-rectangle-bounds)) + ((eq delete 'delete-only) + (cua--delete-rectangle)) (t (let* ((strs (cua--extract-rectangle)) (str (mapconcat #'identity strs "\n"))) diff --git a/lisp/replace.el b/lisp/replace.el index d6590c5..a06e363 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -284,7 +284,7 @@ (defun query-replace-read-args (prompt regexp-flag &optional noerror) (and current-prefix-arg (not (eq current-prefix-arg '-))) (and current-prefix-arg (eq current-prefix-arg '-))))) -(defun query-replace (from-string to-string &optional delimited start end backward) +(defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -328,22 +328,21 @@ (defun query-replace (from-string to-string &optional delimited start end backwa (if current-prefix-arg (if (eq current-prefix-arg '-) " backward" " word") "") - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) nil))) (list (nth 0 common) (nth 1 common) (nth 2 common) ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) - (nth 3 common)))) - (perform-replace from-string to-string t nil delimited nil nil start end backward)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) + (nth 3 common) + (if (use-region-p) (region-noncontiguous-p))))) + (perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p)) (define-key esc-map "%" 'query-replace) -(defun query-replace-regexp (regexp to-string &optional delimited start end backward) +(defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying what to do with it. For directions, type \\[help-command] at that time. @@ -408,18 +407,17 @@ (defun query-replace-regexp (regexp to-string &optional delimited start end back (if (eq current-prefix-arg '-) " backward" " word") "") " regexp" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) t))) (list (nth 0 common) (nth 1 common) (nth 2 common) ;; These are done separately here ;; so that command-history will record these expressions ;; rather than the values they had this time. - (if (and transient-mark-mode mark-active) - (region-beginning)) - (if (and transient-mark-mode mark-active) - (region-end)) - (nth 3 common)))) - (perform-replace regexp to-string t t delimited nil nil start end backward)) + (if (use-region-p) (region-beginning)) + (if (use-region-p) (region-end)) + (nth 3 common) + (if (use-region-p) (region-noncontiguous-p))))) + (perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p)) (define-key esc-map [?\C-%] 'query-replace-regexp) @@ -485,9 +483,9 @@ (defun query-replace-regexp-eval (regexp to-expr &optional delimited start end) ;; and the user might enter a single token. (replace-match-string-symbols to) (list from (car to) current-prefix-arg - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-beginning)) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-end)))))) (perform-replace regexp (cons 'replace-eval-replacement to-expr) t 'literal delimited nil nil start end)) @@ -523,9 +521,9 @@ (defun map-query-replace-regexp (regexp to-strings &optional n start end) (list from to (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-beginning)) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-end))))) (let (replacements) (if (listp to-strings) @@ -587,12 +585,12 @@ (defun replace-string (from-string to-string &optional delimited start end backw (if (eq current-prefix-arg '-) " backward" " word") "") " string" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) nil))) (list (nth 0 common) (nth 1 common) (nth 2 common) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-beginning)) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-end)) (nth 3 common)))) (perform-replace from-string to-string nil nil delimited nil nil start end backward)) @@ -661,12 +659,12 @@ (defun replace-regexp (regexp to-string &optional delimited start end backward) (if (eq current-prefix-arg '-) " backward" " word") "") " regexp" - (if (and transient-mark-mode mark-active) " in region" "")) + (if (use-region-p) " in region" "")) t))) (list (nth 0 common) (nth 1 common) (nth 2 common) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-beginning)) - (if (and transient-mark-mode mark-active) + (if (use-region-p) (region-end)) (nth 3 common)))) (perform-replace regexp to-string nil t delimited nil nil start end backward)) @@ -832,7 +830,7 @@ (defun keep-lines (regexp &optional rstart rend interactive) (unless (or (bolp) (eobp)) (forward-line 0)) (point-marker))))) - (if (and interactive transient-mark-mode mark-active) + (if (and interactive (use-region-p)) (setq rstart (region-beginning) rend (progn (goto-char (region-end)) @@ -901,7 +899,7 @@ (defun flush-lines (regexp &optional rstart rend interactive) (progn (goto-char (min rstart rend)) (setq rend (copy-marker (max rstart rend)))) - (if (and interactive transient-mark-mode mark-active) + (if (and interactive (use-region-p)) (setq rstart (region-beginning) rend (copy-marker (region-end))) (setq rstart (point) @@ -951,7 +949,7 @@ (defun how-many (regexp &optional rstart rend interactive) (setq rend (max rstart rend))) (goto-char rstart) (setq rend (point-max))) - (if (and interactive transient-mark-mode mark-active) + (if (and interactive (use-region-p)) (setq rstart (region-beginning) rend (region-end)) (setq rstart (point) @@ -2068,7 +2066,7 @@ (defun replace-dehighlight () (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag - &optional repeat-count map start end backward) + &optional repeat-count map start end backward region-noncontiguous-p) "Subroutine of `query-replace'. Its complexity handles interactive queries. Don't use this in your own program unless you want to query and set the mark just as `query-replace' does. Instead, write a simple loop like this: @@ -2115,6 +2113,9 @@ (defun perform-replace (from-string replacements ;; If non-nil, it is marker saying where in the buffer to stop. (limit nil) + ;; Use local binding in add-function below. + (isearch-filter-predicate isearch-filter-predicate) + (region-bounds nil) ;; Data for the next match. If a cons, it has the same format as ;; (match-data); otherwise it is t if a match is possible at point. @@ -2127,6 +2128,24 @@ (defun perform-replace (from-string replacements "Query replacing %s with %s: (\\\\[help] for help) ") minibuffer-prompt-properties)))) + ;; Unless a single contiguous chunk is selected, operate on multiple chunks. + (when region-noncontiguous-p + (setq region-bounds + (mapcar (lambda (position) + (cons (copy-marker (car position)) + (copy-marker (cdr position)))) + (funcall region-extract-function 'bounds))) + (add-function :after-while isearch-filter-predicate + (lambda (start end) + (delq nil (mapcar + (lambda (bounds) + (and + (>= start (car bounds)) + (<= start (cdr bounds)) + (>= end (car bounds)) + (<= end (cdr bounds)))) + region-bounds))))) + ;; If region is active, in Transient Mark mode, operate on region. (if backward (when end diff --git a/src/casefiddle.c b/src/casefiddle.c index b94ea8e..7064d9d 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -306,14 +306,30 @@ return Qnil; } -DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 2, "r", +DEFUN ("downcase-region", Fdowncase_region, Sdowncase_region, 2, 3, + "(list (region-beginning) (region-end) (region-noncontiguous-p))", doc: /* Convert the region to lower case. In programs, wants two arguments. These arguments specify the starting and ending character numbers of the region to operate on. When used as a command, the text between point and the mark is operated on. */) - (Lisp_Object beg, Lisp_Object end) + (Lisp_Object beg, Lisp_Object end, Lisp_Object region_noncontiguous_p) { - casify_region (CASE_DOWN, beg, end); + Lisp_Object bounds = Qnil; + + if (!NILP (region_noncontiguous_p)) + { + bounds = call1 (Fsymbol_value (intern ("region-extract-function")), + intern ("bounds")); + + while (CONSP (bounds)) + { + casify_region (CASE_DOWN, XCAR (XCAR (bounds)), XCDR (XCAR (bounds))); + bounds = XCDR (bounds); + } + } + else + casify_region (CASE_DOWN, beg, end); + return Qnil; } --=-=-=--