From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id EAvNK4S2jWDSBgEAgWs5BA (envelope-from ) for ; Sat, 01 May 2021 22:13:56 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id qKmBJ4S2jWCpDAAAB5/wlQ (envelope-from ) for ; Sat, 01 May 2021 20:13:56 +0000 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 C99DD18C53 for ; Sat, 1 May 2021 22:13:55 +0200 (CEST) Received: from localhost ([::1]:39074 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lcvzt-0002a1-JA for larch@yhetil.org; Sat, 01 May 2021 16:13:53 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:58996) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lcvzN-0002Z1-2e for emacs-orgmode@gnu.org; Sat, 01 May 2021 16:13:22 -0400 Received: from mout01.posteo.de ([185.67.36.65]:54751) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lcvzJ-0006rP-0c for emacs-orgmode@gnu.org; Sat, 01 May 2021 16:13:20 -0400 Received: from submission (posteo.de [89.146.220.130]) by mout01.posteo.de (Postfix) with ESMTPS id D9808240028 for ; Sat, 1 May 2021 22:13:11 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.eu; s=2017; t=1619899991; bh=PQx+o5hXBlGnzVcHtGPxcgdKSMC8ieelPZTSi5DSH1o=; h=Subject:To:Cc:From:Date:From; b=T8teElAWQICsTccL5c86L/ULOGk49w9LmBHJFsUytfiV52b/Hsic+Vlekkzbndki8 SAtiwtJvOaT8eSEErFIcfvnNfZnMwhr8dnUXFU+VKXIWOxgqvmYiyKoMJiKQIyPOXB kNPNAkYqMQSYz/ZshEpljUdDoKCSJQMJNX5Di6BQn2/oGvArE/im6usc8JrS+Yki4+ Z421k8e64h/hBupPicq2fxDnlrcVMDwDDwQcQTL/HPXYMMVu1HDDJe6bvhWI4kVtL2 tswgnmPuXTwCkFQMML5IOaOx06+rlaY//VWdmjobfgU4i91dWQzzW1Q9ed5fzE4D9c 2BW0zJQ4WiKrA== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4FXgQt6SPwz6tmH; Sat, 1 May 2021 22:13:10 +0200 (CEST) Subject: Re: [PATCH] ob-tangle.el: Speed up tangling To: Bastien References: <57480e77-024a-adcc-ec9a-c20b84ac762a@posteo.eu> <9dfb44d3-0c4a-6a66-0efa-c70e9434ee5e@posteo.eu> <87a6pe4hj1.fsf@gnu.org> From: =?UTF-8?Q?S=c3=a9bastien_Miquel?= Message-ID: Date: Sat, 1 May 2021 20:13:10 +0000 MIME-Version: 1.0 In-Reply-To: <87a6pe4hj1.fsf@gnu.org> Content-Type: multipart/mixed; boundary="------------38417396D2730ABE2511BBD6" Content-Language: fr Received-SPF: pass client-ip=185.67.36.65; envelope-from=sebastien.miquel@posteo.eu; 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, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=unavailable autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-To: sebastien.miquel@posteo.eu Cc: emacs-orgmode , mail@nicolasgoaziou.fr Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1619900036; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=YFciRoDlNkwm21IIGMHd5l+8VuR/KHHZoCQs8x1aO4g=; b=YwCpBSM1H5mEEpFWG5FbX2DbZs91LjsiwwbDpdUO3OgGXTEgMWGET6nykalSrIYR76ElVE /reIzXiiJvAhq034sh5oJpHFiQuWI+Zaxesa0FDbBq37xh6kndH7CPwdd6THTgRZ4lwAG3 MLVCNuvzaFSFm57B5Udb1EtQitv7PJxcVKOzLSiwvdBicL+Tpy+2zJuPeuFVGQNaT6a97w MhSWgKPBBpfS2lFFKKzaxnfiSih7PU/hcm+KDkpB2AZ11ddzJg0E57VcvQL3cUhe7DYLTK 021PJi74hhXu37AR0Ycjtc8igipjwb6a6+jDqLIQLkagvURk2fCJlc2Xm4NWZA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1619900036; a=rsa-sha256; cv=none; b=TSF2RrjeOiBiSJwboIilF+CSBsxpoKIvdMIdLkaxnv4VUMicx2RaGzCvAVTvEugU0VT3nR lik10Md4dBELYW8PH/p0eivYTQDqIwIs4Sw52E01Njj83OW8N2iwwh2O9lmsS4IPCJuuhc zzXu52jPq5/seMCNMIEhNnGWisdDsLFDKpVd6DlvqqvCSnDw//9JqjB3r0SjRWfYv6/LGB 7pbX39ZL+7MeKIzWySDolpmpejIkgoBNXJPVDLEMTUT7144fxjE5mWN5TJnRdg4B3uEi0X KNmNAZ5VoQ5RSCAgFQRjKjpeXX/F9Vc3G4Aeohx2o0CECLLRpLeqsWbEiTTjXQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=posteo.eu header.s=2017 header.b=T8teElAW; dmarc=pass (policy=none) header.from=posteo.eu; spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Spam-Score: -3.16 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=posteo.eu header.s=2017 header.b=T8teElAW; dmarc=pass (policy=none) header.from=posteo.eu; spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Queue-Id: C99DD18C53 X-Spam-Score: -3.16 X-Migadu-Scanner: scn0.migadu.com X-TUID: 7eFahec5ALsu This is a multi-part message in MIME format. --------------38417396D2730ABE2511BBD6 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 8bit Hi Bastien, Bastien writes: > The compiler is complaining with > > In toplevel form: > ob-tangle.el:196:1: Warning: Variable ‘modes’ left uninitialized > > Also, it breaks these two tests for me: > > 2 unexpected results: > FAILED ob-tangle/block-order > FAILED ob-tangle/continued-code-blocks-w-noweb-ref Indeed, I hadn't thought to run the tests, sorry. I've fixed my code and modified the `block-order` test in order for it to pass. The patch does modify the order of the tangled blocks. When several blocks with different languages are tangled to the same file, they used to be grouped according to language, and are now tangled in the order in which they appear. I assumed this was an oversight in the previous code, but since this test exists, maybe it was intended ? Nicolas Goaziou wrote this test, perhaps he could comment on this. Regards, -- Sébastien Miquel --------------38417396D2730ABE2511BBD6 Content-Type: text/x-patch; charset=UTF-8; name="0001-ob-tangle.el-Improve-tangling.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="0001-ob-tangle.el-Improve-tangling.patch" >From 2aa09e8d2f4e8703190e9035d711508c11b3a8eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Miquel?= Date: Sat, 1 May 2021 21:18:44 +0200 Subject: [PATCH] ob-tangle.el: Improve tangling * lisp/ob-tangle.el (org-babel-tangle-collect-blocks): Group collected blocks by tangled file name. (org-babel-tangle): Avoid quadratic behavior in number of blocks and set modes before writing to file. * testing/lisp/test-ob-tangle.el (ob-tangle/block-order): Update test. --- lisp/ob-tangle.el | 151 ++++++++++++++++----------------- testing/lisp/test-ob-tangle.el | 2 +- 2 files changed, 74 insertions(+), 79 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 4c0c3132d..36144d6ae 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -225,67 +225,55 @@ matching a regular expression." (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light)))) (user-error "Point is not in a source code block")))) path-collector) - (mapc ;; map over all languages - (lambda (by-lang) - (let* ((lang (car by-lang)) - (specs (cdr by-lang)) - (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) - (lang-f (org-src-get-lang-mode lang)) - she-banged) - (mapc - (lambda (spec) - (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) - (let* ((tangle (funcall get-spec :tangle)) - (she-bang (let ((sheb (funcall get-spec :shebang))) - (when (> (length sheb) 0) sheb))) - (tangle-mode (funcall get-spec :tangle-mode)) - (base-name (cond - ((string= "yes" tangle) - (file-name-sans-extension - (nth 1 spec))) - ((string= "no" tangle) nil) - ((> (length tangle) 0) tangle))) - (file-name (when base-name - ;; decide if we want to add ext to base-name - (if (and ext (string= "yes" tangle)) - (concat base-name "." ext) base-name)))) - (when file-name - ;; Possibly create the parent directories for file. - (let ((m (funcall get-spec :mkdirp)) - (fnd (file-name-directory file-name))) - (and m fnd (not (string= m "no")) - (make-directory fnd 'parents))) - ;; delete any old versions of file - (and (file-exists-p file-name) - (not (member file-name (mapcar #'car path-collector))) - (delete-file file-name)) - ;; drop source-block to file - (with-temp-buffer - (when (fboundp lang-f) (ignore-errors (funcall lang-f))) - (when (and she-bang (not (member file-name she-banged))) + (mapc ;; map over file-names + (lambda (by-fn) + (let ((file-name (car by-fn))) + (when file-name + (let ((lspecs (cdr by-fn)) + (fnd (file-name-directory file-name)) + modes make-dir she-banged lang) + ;; drop source-blocks to file + ;; We avoid append-to-file as it does not work with tramp. + (with-temp-buffer + (mapc + (lambda (lspec) + (let* ((block-lang (car lspec)) + (spec (cdr lspec)) + (get-spec (lambda (name) (cdr (assq name (nth 4 spec))))) + (she-bang (let ((sheb (funcall get-spec :shebang))) + (when (> (length sheb) 0) sheb))) + (tangle-mode (funcall get-spec :tangle-mode))) + (unless (string-equal block-lang lang) + (setq lang block-lang) + (let ((lang-f (org-src-get-lang-mode lang))) + (when (fboundp lang-f) (ignore-errors (funcall lang-f))))) + ;; if file contains she-bangs, then make it executable + (when she-bang + (unless tangle-mode (setq tangle-mode #o755))) + (when tangle-mode + (add-to-list 'modes tangle-mode)) + ;; Possibly create the parent directories for file. + (let ((m (funcall get-spec :mkdirp))) + (and m fnd (not (string= m "no")) + (setq make-dir t))) + ;; Handle :padlines unless first line in file + (unless (or (string= "no" (funcall get-spec :padline)) + (= (point) (point-min))) + (insert "\n")) + (when (and she-bang (not she-banged)) (insert (concat she-bang "\n")) - (setq she-banged (cons file-name she-banged))) - (org-babel-spec-to-string spec) - ;; We avoid append-to-file as it does not work with tramp. - (let ((content (buffer-string))) - (with-temp-buffer - (when (file-exists-p file-name) - (insert-file-contents file-name)) - (goto-char (point-max)) - ;; Handle :padlines unless first line in file - (unless (or (string= "no" (cdr (assq :padline (nth 4 spec)))) - (= (point) (point-min))) - (insert "\n")) - (insert content) - (write-region nil nil file-name)))) - ;; if files contain she-bangs, then make the executable - (when she-bang - (unless tangle-mode (setq tangle-mode #o755))) - ;; update counter - (setq block-counter (+ 1 block-counter)) - (unless (assoc file-name path-collector) - (push (cons file-name tangle-mode) path-collector)))))) - specs))) + (setq she-banged t)) + (org-babel-spec-to-string spec) + (setq block-counter (+ 1 block-counter)))) + lspecs) + (when make-dir + (make-directory fnd 'parents)) + ;; erase previous file and set permissions on empty + ;; file before writing + (write-region "" nil file-name nil 0) + (mapc (lambda (mode) (set-file-modes file-name mode)) modes) + (write-region nil nil file-name) + (push file-name path-collector)))))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t) (org-babel-tangle-collect-blocks lang-re tangle-file))) @@ -300,12 +288,8 @@ matching a regular expression." (lambda (file) (org-babel-with-temp-filebuffer file (run-hooks 'org-babel-post-tangle-hook))) - (mapcar #'car path-collector))) - ;; set permissions on tangled files - (mapc (lambda (pair) - (when (cdr pair) (set-file-modes (car pair) (cdr pair)))) - path-collector) - (mapcar #'car path-collector))))) + path-collector)) + path-collector)))) (defun org-babel-tangle-clean () "Remove comments inserted by `org-babel-tangle'. @@ -368,12 +352,12 @@ that the appropriate major-mode is set. SPEC has the form: (defun org-babel-tangle-collect-blocks (&optional lang-re tangle-file) "Collect source blocks in the current Org file. -Return an association list of source-code block specifications of -the form used by `org-babel-spec-to-string' grouped by language. -Optional argument LANG-RE can be used to limit the collected -source code blocks by languages matching a regular expression. -Optional argument TANGLE-FILE can be used to limit the collected -code blocks by target file." +Return an association list of language and source-code block +specifications of the form used by `org-babel-spec-to-string' +grouped by tangled file name. Optional argument LANG-RE can be +used to limit the collected source code blocks by languages +matching a regular expression. Optional argument TANGLE-FILE can +be used to limit the collected code blocks by target file." (let ((counter 0) last-heading-pos blocks) (org-babel-map-src-blocks (buffer-file-name) (let ((current-heading-pos @@ -390,12 +374,23 @@ code blocks by target file." (unless (or (string= src-tfile "no") (and tangle-file (not (equal tangle-file src-tfile))) (and lang-re (not (string-match-p lang-re src-lang)))) - ;; Add the spec for this block to blocks under its - ;; language. - (let ((by-lang (assoc src-lang blocks)) - (block (org-babel-tangle-single-block counter))) - (if by-lang (setcdr by-lang (cons block (cdr by-lang))) - (push (cons src-lang (list block)) blocks))))))) + ;; Add the spec for this block to blocks under its tangled + ;; file name. + (let* ((block (org-babel-tangle-single-block counter)) + (base-name (cond + ((string= "yes" src-tfile) + ;; buffer name + (file-name-sans-extension + (nth 1 block))) + ((> (length src-tfile) 0) src-tfile))) + (ext (or (cdr (assoc src-lang org-babel-tangle-lang-exts)) src-lang)) + (file-name (when base-name + ;; decide if we want to add ext to base-name + (if (and ext (string= "yes" src-tfile)) + (concat base-name "." ext) base-name))) + (by-fn (assoc file-name blocks))) + (if by-fn (setcdr by-fn (cons (cons src-lang block) (cdr by-fn))) + (push (cons file-name (list (cons src-lang block))) blocks))))))) ;; Ensure blocks are in the correct order. (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) (nreverse blocks)))) diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el index 42c02da9c..2ed4ba0da 100644 --- a/testing/lisp/test-ob-tangle.el +++ b/testing/lisp/test-ob-tangle.el @@ -308,7 +308,7 @@ another block (delete-file file))))) ;; Preserve order with mixed languages. (should - (equal '("1" "3" "2" "4") + (equal '("1" "2" "3" "4") (let ((file (make-temp-file "org-tangle-"))) (unwind-protect (progn -- 2.31.1 --------------38417396D2730ABE2511BBD6--