From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp10.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id 6JUoGFLyw2N6iwAAbAwnHQ (envelope-from ) for ; Sun, 15 Jan 2023 13:32:18 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp10.migadu.com with LMTPS id EBkfF1Lyw2NYggEAG6o9tA (envelope-from ) for ; Sun, 15 Jan 2023 13:32:18 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 19924E38A for ; Sun, 15 Jan 2023 13:32:18 +0100 (CET) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pH2B1-0007F0-I4; Sun, 15 Jan 2023 07:31:55 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pH2An-0007EF-FR for emacs-orgmode@gnu.org; Sun, 15 Jan 2023 07:31:43 -0500 Received: from mout01.posteo.de ([185.67.36.65]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pH2Al-0005Hy-KY for emacs-orgmode@gnu.org; Sun, 15 Jan 2023 07:31:41 -0500 Received: from submission (posteo.de [185.67.36.169]) by mout01.posteo.de (Postfix) with ESMTPS id 509CE2400CC for ; Sun, 15 Jan 2023 13:31:38 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1673785898; bh=YPgUMhZ1NiZyjdKzpIV9QKjqFVjI4MRiz5DGOMb1PuU=; h=From:To:Cc:Subject:Date:From; b=Xy+rN+/VdfuuSdxHVVBDASGqEFQUTsI0Dyz8oO5phIQrv9YwpZn2+VyBvKxzN0G5P uRCqSucy8XDWogVpKSZg/m3AHNuG5an/G6yheSupsyxvZkDCUwUH9dhhkc//nTn30B 7dc6jErlA9rq6/wTYZrR9pazeXAw5fLbfJDChrS0O7PE/fkfe87G4VCI2Di791vM8U hiRBgOPm+x7WkSBh80Ktc414wlS6ZKM7ci+dCUILB22IDlnJg7ks34cSsoTMaZN6Gq hBm4LI0OFbjfGUWqty6g76AG1Y5b3tcCXsrL/vLaXicgUyH32+s40IbCyozCCkAILW XlYH4qZvVujqA== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4NvvfK51w0z9rxD; Sun, 15 Jan 2023 13:31:37 +0100 (CET) From: Ihor Radchenko To: emacs-orgmode@gnu.org Cc: Ihor Radchenko Subject: [PATCH 3/4] org-metaup, org-metadown: Move subtrees in active region Date: Sun, 15 Jan 2023 12:31:31 +0000 Message-Id: <8f6fcd70966c1d5434d9058affb6a03498c95c89.1673785107.git.yantar92@posteo.net> In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=185.67.36.65; envelope-from=yantar92@posteo.net; helo=mout01.posteo.de X-Spam_score_int: -43 X-Spam_score: -4.4 X-Spam_bar: ---- X-Spam_report: (-4.4 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: emacs-orgmode-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=posteo.net header.s=2017 header.b="Xy+rN+/V"; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=posteo.net ARC-Seal: i=1; s=key1; d=yhetil.org; t=1673785938; a=rsa-sha256; cv=none; b=pdwGpqjlWkK2U1nwcUQ/Whn6myPnvaFcAQD/j9sT7CehrHayh+MTz6T/mU5OPTfUAUDvrE C0yr5FnA9RT0mAqNd8e7r+3CUaaKLAMBe40hrPvXNF/m8CV56/GG7+JLs9bNvy8HhxzBvq StKdI3gyy7elvjYoBJ4OkCoOEJ6uPGut2P1JJjdpg0IuWMClOOybo0NHeohWOzX9Kp4SU1 yAYnXuc89LPpn0PWQ/+JBWjzC8g3TR7H7mLidQkOefELHGIT9QwXVlLYDRDqRbz6LLNVjU MgluJpk08m8600j+i0URQ9zXh75YEadIfY7tc3wTeoEUCJN2ltXhHVptTaunuA== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1673785938; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=5RO+CrBdKdouVhEpwEzoQ8hGYaCLohK5rxy8jT1blKo=; b=Ex/nONSdSKq+vWeOjiSu8czDtwj4ZyOka5CYxHnfA/i2IaekVTPjEqYjqSdVauuFeh+gXn WLbGvxovd1+zmXaKOM9LVp5hv36gvhvipkIaYlrlN1nCngRM1Nz0vQ02BSTxEFTjnAUmiG bVwmnstzXiQnmCKJFWY40IJhyd1na+Aaot9PCVzSZ6DRI3O6jFACwkqIjFreG9dzFJnhpO zUbFFsJVxqPbshdY6klTe8wgJJPznqDycfvPY374D5rpDqEXtFM+TmAytlbA/qUuBjCGbt AiuWTHMJWyxW8+IoyUc+zljyRlDJ7O1eUjXjJ9JW59QP9H89UpD6rVc3BKBwAQ== X-Migadu-Queue-Id: 19924E38A X-Migadu-Scanner: scn0.migadu.com Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=posteo.net header.s=2017 header.b="Xy+rN+/V"; spf=pass (aspmx1.migadu.com: domain of "emacs-orgmode-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="emacs-orgmode-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=posteo.net X-Migadu-Spam-Score: -5.66 X-Spam-Score: -5.66 X-TUID: JpbyTYK01iZq * lisp/org.el (org-metaup): (org-metadown): When active region contains headings, move the containing subtrees according to the selection. Do not deactive region. * testing/lisp/test-org.el (test-org/move-subtree): Add test. --- lisp/org.el | 46 ++++++++++++++++++++++++++++++++++ testing/lisp/test-org.el | 54 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 100 insertions(+) diff --git a/lisp/org.el b/lisp/org.el index 9fd8189a7..0c782769d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -16888,6 +16888,30 @@ (defun org-metaup (&optional _arg) (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaup-hook)) + ((and (org-region-active-p) + (org-with-limited-levels + (save-excursion + (goto-char (region-beginning)) + (org-at-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) + (let ((beg (region-beginning)) + (end (region-end))) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char beg) + (let ((level (org-current-level))) + (when (or (and (> level 1) (re-search-forward (format "^\\*\\{1,%s\\} " (1- level)) end t)) + ;; Search previous subtree. + (progn + (goto-char beg) + (beginning-of-line) + (not (re-search-backward (format "^\\*\\{%s\\} " level) nil t)))) + (user-error "Cannot move past superior level or buffer limit")) + ;; Drag first subtree above below the selected. + (while (< (point) end) + (let ((deactivate-mark nil)) + (call-interactively 'org-move-subtree-down))))))) ((org-region-active-p) (let* ((a (save-excursion (goto-char (region-beginning)) @@ -16925,6 +16949,28 @@ (defun org-metadown (&optional _arg) (interactive "P") (cond ((run-hook-with-args-until-success 'org-metadown-hook)) + ((and (org-region-active-p) + (org-with-limited-levels + (save-excursion + (goto-char (region-beginning)) + (org-at-heading-p)))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) + (let ((beg (region-beginning)) + (end (region-end))) + (save-excursion + (goto-char beg) + (setq beg (point-marker)) + (let ((level (org-current-level))) + (when (or (and (> level 1) (re-search-forward (format "^\\*\\{1,%s\\} " (1- level)) end t)) + ;; Search next subtree. + (progn + (goto-char end) + (not (re-search-forward (format "^\\*\\{%s\\} " level) nil t)))) + (user-error "Cannot move past superior level or buffer limit")) + ;; Drag first subtree below above the selected. + (while (> (point) beg) + (let ((deactivate-mark nil)) + (call-interactively 'org-move-subtree-up))))))) ((org-region-active-p) (let* ((a (save-excursion (goto-char (region-beginning)) diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 7ed4ffd19..4c66fa038 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -5091,6 +5091,60 @@ (ert-deftest test-org/previous-block () ;;; Outline structure +(ert-deftest test-org/move-subtree () + "Test `org-metaup' and `org-metadown' on headings." + (should + (equal "* H2\n* H1\n" + (org-test-with-temp-text "* H1\n* H2\n" + (org-metadown) + (buffer-string)))) + (should + (equal "* H2\n* H1\n" + (org-test-with-temp-text "* H1\n* H2\n" + (org-metaup) + (buffer-string)))) + (should-error + (org-test-with-temp-text "* H1\n* H2\n" + (org-metadown) + (buffer-string))) + (should-error + (org-test-with-temp-text "* H1\n* H2\n" + (org-metaup) + (buffer-string))) + (should-error + (org-test-with-temp-text "* H1\n** H1.2\n* H2" + (org-metadown) + (buffer-string))) + (should-error + (org-test-with-temp-text "* H1\n** H1.2\n" + (org-metaup) + (buffer-string))) + ;; With selection + (should + (equal "* T\n** H3\n** H1\n** H2\n" + (org-test-with-temp-text "* T\n** H1\n** H2\n** H3\n" + (set-mark (point)) + (search-forward "H2") + (org-metadown) + (buffer-string)))) + (should + (equal "* T\n** H1\n** H2\n** H0\n** H3\n" + (org-test-with-temp-text "* T\n** H0\n** H1\n** H2\n** H3\n" + (set-mark (point)) + (search-forward "H2") + (org-metaup) + (buffer-string)))) + (should-error + (org-test-with-temp-text "* T\n** H1\n** H2\n* T2\n" + (set-mark (point)) + (search-forward "H2") + (org-metadown))) + (should-error + (org-test-with-temp-text "* T\n** H1\n** H2\n* T2\n" + (set-mark (point)) + (search-forward "H2") + (org-metaup)))) + (ert-deftest test-org/demote () "Test `org-demote' specifications." ;; Add correct number of stars according to `org-odd-levels-only'. -- 2.39.0