branch: externals/org
commit cb7bcfdca117e3875618d73ad3ca5252a8f323e3
Author: Rudolf Adamkovič <rud...@adamkovic.org>
Commit: Ihor Radchenko <yanta...@posteo.net>
Fall back to Fundamental mode when editing code
* doc/org-manual.org (Editing Source Code): Describe the change in
behavior, namely how Org falls back to Fundamental mode when
appropriate major mode is unavailable, instead of showing an error
message.
* etc/ORG-NEWS: (Source blocks fall back to Fundamental mode, New
function ~org-src-get-lang-mode-if-bound~): Describe the new
functionality and the new function that enables it.
* 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/
---
doc/org-manual.org | 9 ++-
etc/ORG-NEWS | 14 ++++
lisp/ob-tangle.el | 4 +-
lisp/org-lint.el | 5 +-
lisp/org-src.el | 193 +++++++++++++++++++++++++++++------------------------
5 files changed, 127 insertions(+), 98 deletions(-)
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 15fc24712d..1e37fe2f36 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -19802,14 +19802,13 @@ group ~org-edit-structure~.
- ~org-src-lang-modes~ ::
#+vindex: org-src-lang-modes
- If an Emacs major-mode named ~<LANG>-mode~ exists, where
+ If an Emacs major mode named ~<LANG>-mode~ exists, where
{{{var(<LANG>)}}} is the language identifier from code block's
- header line, then the edit buffer uses that major mode. Use this
+ header line, then the edit buffer uses that major mode. If the
+ major mode does not exist, or the language identifier is omitted,
+ then the edit buffer falls back to Fundamental mode. Use this
variable to arbitrarily map language identifiers to major modes.
- When language identifier is omitted in the src block, Org mode's
- behavior is undefined.
-
- ~org-src-window-setup~ ::
#+vindex: org-src-window-setup
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 62502a6781..8dc70c6d84 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -215,6 +215,11 @@ take the date as an argument, and generate a list of pairs
for
types of datetrees (e.g. for lunar calendars, academic calendars,
retail 4-4-5 calendars, etc).
+*** Source blocks fall back to Fundamental mode
+
+Org now falls back to Fundamental mode for source blocks when the
+appropriate major mode is unavailable.
+
** New and changed options
# Changes dealing with changing default values of customizations,
@@ -366,6 +371,15 @@ to markdown during export to Markdown. This is analogous
to how
# This also includes changes in function behavior from Elisp perspective.
+*** New function ~org-src-get-lang-mode-if-bound~
+
+The new function is like ~org-src-get-lang-mode~, except that it
+ensures the returned major mode for the given language is bound, and
+so available to the user. If the mode is not bound, the function can
+optionally return a fallback mode and display a message when doing so.
+The function was added so that Org can fall back to Fundamental mode
+for source blocks where the appropriate major mode is unavailable.
+
*** New function ~org-gnus-no-new-news-other-frame~ (to be used in
~org-link-frame-setup~)
The new function is like ~org-gnus-no-new-news~, but always opens the
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 64bdced84f..4c224743be 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 31b29ec19f..fddf885eb4 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 2b2dab7725..3783b9fb79 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,20 @@ 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 and FALLBACK are both non-nil, display a message when
+falling back to a major mode different from that for LANG."
+ (let ((mode (org-src-get-lang-mode lang)))
+ (if (functionp mode)
+ mode
+ (when (and fallback
+ fallback-message-p
+ (not (eq fallback mode)))
+ (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 +1259,21 @@ 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-f-fallback #'fundamental-mode)
+ (lang (or (if-let* ((lang
+ (org-element-property :type element)))
+ (downcase lang))
+ (replace-regexp-in-string
+ "-mode$" ""
+ (symbol-name lang-f-fallback))))
+ (lang-f (org-src-get-lang-mode-if-bound
+ lang
+ lang-f-fallback
+ t)))
(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 +1324,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 +1359,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)
