Ihor Radchenko <yanta...@posteo.net> writes: > Then, take your time.
All right, I finally found some time. > My specific suggestion was > 1. creating ob-graphviz.el that simply loads ob-dot I did not do this. > 2. making "graphviz" an alias to "dot" lang name for > babel Done in the attached patch 0002 (that builds on 0001). > For the question of editing, it may be more tricky - we may need to > implement fallback editing mode if the default is not available. > Maybe it is just a question is a simple change in > `org-src-get-lang-mode'. But one need to look into Org codebase and make > sure that nothing is broken or inconsistent as a result. Done in the attached patch 0001. I did not change `org-src-get-lang-mode' directly. Instead I wrapped it in `org-src-get-lang-mode-if-bound' which does little more. WDYT? Rudy -- "Chop your own wood and it will warm you twice." --- Henry Ford; Francis Kinloch, 1819; Henry David Thoreau, 1854 Rudolf Adamkovič <rud...@adamkovic.org> [he/him] http://adamkovic.org
>From f726287e23e3dbee7989a9177dd016c67c98ba4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rudolf=20Adamkovi=C4=8D?= <rud...@adamkovic.org> Date: Thu, 22 May 2025 14:35:31 +0200 Subject: [PATCH 1/2] Fall back to the Fundamental mode when editing code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-tangle.el (org-babel-tangle): * lisp/org-lint.el (org-lint-suspicious-language-in-src-block): Simplify code with the new function `org-src-get-lang-mode-if-bound'. * lisp/org-src.el (org-src-lang-modes, org-src-font-lock-fontify-block) (org-src-get-lang-mode, org-src-get-lang-mode-if-bound) (org-edit-export-block, org-edit-src-code, org-edit-inline-src-code): When editing source blocks, inline source code, or export blocks and the major mode listed in `org-src-lang-modes' is not available, do not stop with a user error. Instead, fall back to the Fundamental mode, with an informational message. Done in preparation for the GraphViz mode support: Reported-by: Rudolf Adamkovič <rud...@adamkovic.org> Link: https://list.orgmode.org/m2zfikfhgp....@adamkovic.org/ --- lisp/ob-tangle.el | 4 +- lisp/org-lint.el | 5 +- lisp/org-src.el | 185 ++++++++++++++++++++++++---------------------- 3 files changed, 101 insertions(+), 93 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 38cad78ab..b9da99ac7 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -290,8 +290,8 @@ matching a regular expression." (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))))) + (when-let* ((lang-f (org-src-get-lang-mode-if-bound lang))) + (ignore-errors (funcall lang-f)))) ;; if file contains she-bangs, then make it executable (when she-bang (unless tangle-mode (setq tangle-mode #o755))) diff --git a/lisp/org-lint.el b/lisp/org-lint.el index 15950b231..7d5b5c839 100644 --- a/lisp/org-lint.el +++ b/lisp/org-lint.el @@ -563,9 +563,8 @@ Use :header-args: instead" (lambda (b) (when-let* ((lang (org-element-property :language b))) (unless (or (functionp (intern (format "org-babel-execute:%s" lang))) - ;; No babel backend, but there is corresponding - ;; major mode. - (fboundp (org-src-get-lang-mode lang))) + ;; No Babel backend, but relevant major mode is bound. + (org-src-get-lang-mode-if-bound lang)) (list (org-element-property :post-affiliated b) (format "Unknown source block language: '%s'" lang))))))) diff --git a/lisp/org-src.el b/lisp/org-src.el index 2b2dab772..7287114bb 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -667,80 +667,79 @@ This function is called by Emacs's automatic fontification, as long as `org-src-fontify-natively' is non-nil." (let ((modified (buffer-modified-p)) native-tab-width) (remove-text-properties start end '(face nil)) - (let ((lang-mode (org-src-get-lang-mode lang))) - (when (fboundp lang-mode) - (condition-case nil - (let ((string (buffer-substring-no-properties start end)) - (org-buffer (current-buffer))) - (with-current-buffer - (get-buffer-create - (format " *org-src-fontification:%s*" lang-mode)) - (let ((inhibit-modification-hooks nil)) - (erase-buffer) - ;; Add string and a final space to ensure property change. - (insert string " ")) - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (setq native-tab-width tab-width) - (font-lock-ensure) - (let ((pos (point-min)) next - ;; Difference between positions here and in org-buffer. - (offset (- start (point-min)))) - (while (setq next (next-property-change pos)) - ;; Handle additional properties from font-lock, so as to - ;; preserve, e.g., composition. - ;; FIXME: We copy 'font-lock-face property explicitly because - ;; `font-lock-mode' is not enabled in the buffers starting from - ;; space and the remapping between 'font-lock-face and 'face - ;; text properties may thus not be set. See commit - ;; 453d634bc. - (dolist (prop (append '(font-lock-face face) font-lock-extra-managed-props)) - (let ((new-prop (get-text-property pos prop))) - (when new-prop - (if (not (eq prop 'invisible)) - (put-text-property - (+ offset pos) (+ offset next) prop new-prop - org-buffer) - ;; Special case. `invisible' text property may - ;; clash with Org folding. Do not assign - ;; `invisible' text property directly. Use - ;; property alias instead. - (let ((invisibility-spec - (or - ;; ATOM spec. - (and (memq new-prop buffer-invisibility-spec) - new-prop) - ;; (ATOM . ELLIPSIS) spec. - (assq new-prop buffer-invisibility-spec)))) - (with-current-buffer org-buffer - ;; Add new property alias. - (unless (memq 'org-src-invisible - (cdr (assq 'invisible char-property-alias-alist))) - (setq-local - char-property-alias-alist - (cons (cons 'invisible - (nconc (cdr (assq 'invisible char-property-alias-alist)) - '(org-src-invisible))) - (remove (assq 'invisible char-property-alias-alist) - char-property-alias-alist)))) - ;; Carry over the invisibility spec, unless - ;; already present. Note that there might - ;; be conflicting invisibility specs from - ;; different major modes. We cannot do much - ;; about this then. - (when invisibility-spec - (add-to-invisibility-spec invisibility-spec)) - (put-text-property - (+ offset pos) (+ offset next) - 'org-src-invisible new-prop - org-buffer))))))) - (setq pos next))) - (set-buffer-modified-p nil))) - (error - (message "Native code fontification error in %S at pos%d\n Error: %S" - (current-buffer) start - (when (and (fboundp 'backtrace-get-frames) - (fboundp 'backtrace-to-string)) - (backtrace-to-string (backtrace-get-frames 'backtrace)))))))) + (when-let* ((lang-mode (org-src-get-lang-mode-if-bound lang))) + (condition-case nil + (let ((string (buffer-substring-no-properties start end)) + (org-buffer (current-buffer))) + (with-current-buffer + (get-buffer-create + (format " *org-src-fontification:%s*" lang-mode)) + (let ((inhibit-modification-hooks nil)) + (erase-buffer) + ;; Add string and a final space to ensure property change. + (insert string " ")) + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (setq native-tab-width tab-width) + (font-lock-ensure) + (let ((pos (point-min)) next + ;; Difference between positions here and in org-buffer. + (offset (- start (point-min)))) + (while (setq next (next-property-change pos)) + ;; Handle additional properties from font-lock, so as to + ;; preserve, e.g., composition. + ;; FIXME: We copy 'font-lock-face property explicitly because + ;; `font-lock-mode' is not enabled in the buffers starting from + ;; space and the remapping between 'font-lock-face and 'face + ;; text properties may thus not be set. See commit + ;; 453d634bc. + (dolist (prop (append '(font-lock-face face) font-lock-extra-managed-props)) + (let ((new-prop (get-text-property pos prop))) + (when new-prop + (if (not (eq prop 'invisible)) + (put-text-property + (+ offset pos) (+ offset next) prop new-prop + org-buffer) + ;; Special case. `invisible' text property may + ;; clash with Org folding. Do not assign + ;; `invisible' text property directly. Use + ;; property alias instead. + (let ((invisibility-spec + (or + ;; ATOM spec. + (and (memq new-prop buffer-invisibility-spec) + new-prop) + ;; (ATOM . ELLIPSIS) spec. + (assq new-prop buffer-invisibility-spec)))) + (with-current-buffer org-buffer + ;; Add new property alias. + (unless (memq 'org-src-invisible + (cdr (assq 'invisible char-property-alias-alist))) + (setq-local + char-property-alias-alist + (cons (cons 'invisible + (nconc (cdr (assq 'invisible char-property-alias-alist)) + '(org-src-invisible))) + (remove (assq 'invisible char-property-alias-alist) + char-property-alias-alist)))) + ;; Carry over the invisibility spec, unless + ;; already present. Note that there might + ;; be conflicting invisibility specs from + ;; different major modes. We cannot do much + ;; about this then. + (when invisibility-spec + (add-to-invisibility-spec invisibility-spec)) + (put-text-property + (+ offset pos) (+ offset next) + 'org-src-invisible new-prop + org-buffer))))))) + (setq pos next))) + (set-buffer-modified-p nil))) + (error + (message "Native code fontification error in %S at pos%d\n Error: %S" + (current-buffer) start + (when (and (fboundp 'backtrace-get-frames) + (fboundp 'backtrace-to-string)) + (backtrace-to-string (backtrace-get-frames 'backtrace))))))) ;; Add Org faces. (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t)))) (when (or (facep src-face) (listp src-face)) @@ -977,7 +976,7 @@ Org-babel commands." (defun org-src-get-lang-mode (lang) "Return major mode that should be used for LANG. -LANG is a string, and the returned major mode is a symbol." +LANG is a string, and the returned value is a symbol." (let ((mode (intern (concat (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) @@ -987,6 +986,16 @@ LANG is a string, and the returned major mode is a symbol." (major-mode-remap mode) mode))) +(defun org-src-get-lang-mode-if-bound (lang &optional fallback fallback-message-p) + "Return major mode for LANG, if bound, and FALLBACK otherwise. +LANG is a string. FALLBACK and the returned value are both symbols. If +FALLBACK-MESSAGE-P is non-nil, display a message when using FALLBACK." + (let ((mode (org-src-get-lang-mode lang))) + (if (functionp mode) mode + (when fallback-message-p + (message "%s not available, falling back to %s" mode fallback) + fallback)))) + (defun org-src-edit-buffer-p (&optional buffer) "Non-nil when current buffer is a source editing buffer. If BUFFER is non-nil, test it instead." @@ -1246,16 +1255,17 @@ Throw an error when not at an export block." (unless (and (org-element-type-p element 'export-block) (org-src--on-datum-p element)) (user-error "Not in an export block")) - (let* ((type (downcase (or (org-element-property :type element) - ;; Missing export-block type. Fallback - ;; to default mode. - "fundamental"))) - (mode (org-src-get-lang-mode type))) - (unless (functionp mode) (error "No such language mode: %s" mode)) + (let* ((lang-fallback "fundamental") + (lang (downcase (or (org-element-property :type element) + lang-fallback))) + (lang-f (org-src-get-lang-mode-if-bound + lang + #'fundamental-mode + (not (string= lang lang-fallback))))) (org-src--edit-element element - (org-src--construct-edit-buffer-name (buffer-name) type) - mode + (org-src--construct-edit-buffer-name (buffer-name) lang) + lang-f (lambda () (org-escape-code-in-region (point-min) (point-max))))) t)) @@ -1306,12 +1316,12 @@ name of the sub-editing buffer." (let* ((lang (if (eq type 'src-block) (org-element-property :language element) "example")) - (lang-f (and (eq type 'src-block) (org-src-get-lang-mode lang))) + (lang-f (and (eq type 'src-block) + (org-src-get-lang-mode-if-bound + lang #'fundamental-mode lang))) (babel-info (and (eq type 'src-block) (org-babel-get-src-block-info 'no-eval))) deactivate-mark) - (when (and (eq type 'src-block) (not (functionp lang-f))) - (error "No such language mode: %s" lang-f)) (org-src--edit-element element (or edit-buffer-name @@ -1341,10 +1351,9 @@ name of the sub-editing buffer." (org-src--on-datum-p context)) (user-error "Not on inline source code")) (let* ((lang (org-element-property :language context)) - (lang-f (org-src-get-lang-mode lang)) + (lang-f (org-src-get-lang-mode-if-bound lang #'fundamental-mode t)) (babel-info (org-babel-get-src-block-info 'no-eval)) deactivate-mark) - (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) (org-src--edit-element context (org-src--construct-edit-buffer-name (buffer-name) lang) -- 2.39.5 (Apple Git-154)
>From 4da2a6d10877901462780bbd74f9fe6dc42227d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rudolf=20Adamkovi=C4=8D?= <rud...@adamkovic.org> Date: Thu, 22 May 2025 14:40:51 +0200 Subject: [PATCH 2/2] Use Graphviz Dot mode if available MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/org-src.el (org-src-lang-modes): Default to the `graphviz-dot' mode for `dot' source blocks. If the mode is not available, Org will fall back to the `fundamental' mode automatically. Reported-by: Rudolf Adamkovič <rud...@adamkovic.org> Link: https://list.orgmode.org/m2zfikfhgp....@adamkovic.org/ --- lisp/org-src.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 7287114bb..0a9a2ed08 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -220,7 +220,7 @@ The shells are associated with `sh-mode'." ("cpp" . c++) ("ditaa" . artist) ("desktop" . conf-desktop) - ("dot" . fundamental) + ("dot" . graphviz-dot) ("elisp" . emacs-lisp) ("ocaml" . tuareg) ("screen" . shell-script) -- 2.39.5 (Apple Git-154)
