diff options
| -rw-r--r-- | ChangeLog | 7 | ||||
| -rw-r--r-- | devbook-mode.el | 46 | ||||
| -rw-r--r-- | test/devbook-mode-tests.el | 16 |
3 files changed, 44 insertions, 25 deletions
@@ -1,5 +1,12 @@ 2024-11-06 Ulrich Müller <ulm@gentoo.org> + * devbook-mode.el (devbook-set-schema): Renamed from + devbook-locate-schema-file. Call rng-locate-schema-file first, + then fall back to parent directories. + (devbook-mode): Update caller. + * test/devbook-mode-tests.el (devbook-mode-test-set-schema): + Renamed from devbook-mode-test-locate-schema and updated. + * test/ebuild-mode-tests.el (ebuild-mode-test-skeleton): * test/glep-mode-tests.el (glep-mode-test-skeleton): * test/gentoo-newsitem-mode-tests.el diff --git a/devbook-mode.el b/devbook-mode.el index e4a3bea..7205f77 100644 --- a/devbook-mode.el +++ b/devbook-mode.el @@ -30,24 +30,34 @@ (defvar devbook-schema-file-name "devbook.rnc") -(defun devbook-locate-schema-file (&optional noerror) - "Look for a devbook schema file in any parent directory. -If successful, load it as the schema for the current buffer. -Otherwise, signal an error, or return nil if the optional argument -NOERROR is non-nil." +(defun devbook-set-schema (&optional noerror) + "Set the schema for this buffer. +Call `rng-locate-schema-file' first, which tries to locate a schema +based on the buffer's contents and file-name. If unsuccessful, +look for a devbook schema file in any parent directory. If no +schema file could be found either way, use the vacuous schema which +allows any well-formed XML. + +Optional argument NOERROR suppresses signalling of any errors. +Return the schema file name, or nil if no schema was found." (interactive "P") - (let* ((dir (and buffer-file-name - (locate-dominating-file buffer-file-name - devbook-schema-file-name))) - (file (and dir (expand-file-name devbook-schema-file-name dir)))) - (cond (file - (condition-case err - (progn - (rng-set-schema-file-1 file) - (unless noninteractive (rng-what-schema))) - (error (unless noerror (signal (car err) (cdr err)))))) - (noerror nil) - (t (error "Schema file %s not found" devbook-schema-file-name))))) + (condition-case err + (rng-set-schema-file-1 + (or (cl-letf* ((origfn (symbol-function 'rng-document-element)) + ;; make sure that rng-document-element returns + ;; a document element even if the buffer is empty + ((symbol-function 'rng-document-element) + (lambda () + (or (funcall origfn) + '(nil nil "guide"))))) + (rng-locate-schema-file)) + (let ((dir (and buffer-file-name + (locate-dominating-file buffer-file-name + devbook-schema-file-name)))) + (and dir (expand-file-name devbook-schema-file-name dir))))) + (error (unless noerror (signal (car err) (cdr err))))) + (unless noninteractive (rng-what-schema)) + rng-current-schema-file-name) ;;;###autoload (define-derived-mode devbook-mode nxml-mode "DevBook" @@ -63,7 +73,7 @@ NOERROR is non-nil." ;; easy way to achieve this, so set to 0 which is right more often. (set (make-local-variable 'nxml-child-indent) 0) (unless rng-current-schema-file-name - (devbook-locate-schema-file t))) + (devbook-set-schema t))) (define-skeleton devbook-insert-skeleton "Insert a skeleton for a DevBook XML document." diff --git a/test/devbook-mode-tests.el b/test/devbook-mode-tests.el index 2529bbd..cd29751 100644 --- a/test/devbook-mode-tests.el +++ b/test/devbook-mode-tests.el @@ -26,8 +26,9 @@ (defmacro devbook-mode-test-run-silently (&rest body) `(let ((inhibit-message t)) ,@body)) -(ert-deftest devbook-mode-test-locate-schema () +(ert-deftest devbook-mode-test-set-schema () (cl-letf* ((rncfile "/home/larry/devmanual/devbook.rnc") + (rncschema "start = element foo { empty }\n") ((symbol-function 'file-exists-p) (lambda (file) (string-equal file rncfile))) ((symbol-function 'file-directory-p) @@ -36,14 +37,15 @@ (lambda (file &rest _args) (unless (string-equal file rncfile) (signal 'file-missing nil)) - (insert "start = element foo { empty }\n")))) + (insert rncschema)))) (let ((buffer-file-name "/home/larry/devmanual/quickstart/text.xml")) - (devbook-locate-schema-file) - (should (equal rng-current-schema-file-name rncfile))) - (let ((buffer-file-name "/home/larry/elsewhere/text.xml")) + (should (equal (devbook-set-schema) rncfile)) + (setq rncschema "foo = element foo { empty }\n") ; bad schema (should (equal - (should-error (devbook-locate-schema-file)) - '(error "Schema file devbook.rnc not found")))))) + (car (should-error (devbook-set-schema))) + 'rng-c-incorrect-schema))) + (let ((buffer-file-name "/home/larry/elsewhere/text.xml")) + (should-not (devbook-set-schema))))) (ert-deftest devbook-mode-test-skeleton () (with-temp-buffer |