Call rng-locate-schema-file when locating a devbook schema

* 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.

Signed-off-by: Ulrich Müller <ulm@gentoo.org>

3 files changed, 44 insertions, 25 deletions

diff --git a/ChangeLog b/ChangeLog
index 2761a37..b06aee3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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