-
Notifications
You must be signed in to change notification settings - Fork 1
/
flex-compile-xml-validate.el
137 lines (111 loc) · 4.87 KB
/
flex-compile-xml-validate.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
;;; flex-compile-xml-validate.el --- XML validation -*- lexical-binding: t; -*-
;; Copyright (C) 2015 - 2023 Paul Landes
;; Author: Paul Landes
;; Maintainer: Paul Landes
;; Keywords: xml validation compilation processes
;; URL: https://github.com/plandes/flex-compile
;; Package-Requires: ((emacs "26.1"))
;; Package-Version: 0
;; This file is not part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Implementation compiler for XML validation using command line `xmllint'.
;;; Code:
(require 'flex-compile-manage)
(eval-when-compile (require 'xml))
(defclass config-schema-file-prop (config-file-prop)
()
:method-invocation-order :c3
:documentation "A schema file property")
(cl-defmethod initialize-instance ((this config-schema-file-prop)
&optional slots)
"Initialize THIS instance using SLOTS as initial values."
(setq slots (plist-put slots :prompt "Schema file")
slots (plist-put slots :validate-modes '(nxml-mode))
slots (plist-put slots :input-type 'last))
(cl-call-next-method this slots))
(cl-defmethod flex-compiler-guess-schema-file ((this config-schema-file-prop))
"Try to determine where the XSD is by the location set in THIS property."
(with-temp-buffer
(-> (slot-value this 'prop-entry)
(slot-value 'config-file)
insert-file-contents)
(condition-case nil
(->> (xml-parse-region (point-min) (point-max))
car
xml-node-attributes
(assq 'xsi:schemaLocation)
cdr
(funcall #'(lambda (xsi)
(if (string-match "file://\\(.*\\)$" xsi)
(match-string 1 xsi)))))
(error))))
(cl-defmethod config-prop-read ((this config-schema-file-prop))
"Read the schema XSD file location from the user and set in THIS property."
(let* ((schema-guess (flex-compiler-guess-schema-file this))
(initial (and schema-guess (file-name-nondirectory schema-guess)))
(dir (and schema-guess (file-name-directory schema-guess))))
(read-file-name "Schema XSD: " dir schema-guess t initial)))
(defclass xml-validate-flex-compiler (single-buffer-flex-compiler
conf-file-flex-compiler)
((xmllint-program :initarg :xmllint-program
:initform "xmllint")
(schema-file :initarg :schema-file
:initform nil
:documentation "\
Location of the schema file to validate against."))
:method-invocation-order :c3
:documentation "\
Implementation compiler for XML validation using command line
\[xmllint](http://xmlsoft.org/xmllint.html) command line tool.")
(cl-defmethod initialize-instance ((this xml-validate-flex-compiler)
&optional slots)
"Initialize THIS instance using SLOTS as initial values."
(let ((props (list (config-schema-file-prop :object-name 'schema-file
:prop-entry this
:required t
:order 1))))
(setq slots (plist-put slots :object-name "xml-validate")
slots (plist-put slots :description "XML")
slots (plist-put slots :validate-modes '(nxml-mode))
slots (plist-put slots :buffer-name "XML Validation")
slots (plist-put slots :props (append (plist-get slots :props) props))))
(cl-call-next-method this slots))
(cl-defmethod flex-compiler-load-libraries ((this xml-validate-flex-compiler))
"Load the `xml' library for THIS compiler."
(ignore this)
(require 'xml))
(cl-defmethod config-prop-set ((this xml-validate-flex-compiler) prop val)
"Set property PROP to VAL for THIS compiler.
Also reset the `schema-file' slot since a setting any other value invalidates
it."
(setf (slot-value this 'schema-file) nil)
(cl-call-next-method this prop val))
(cl-defmethod flex-compiler-start-buffer ((this xml-validate-flex-compiler)
start-type)
"Return a new buffer for THIS compiler with a processing compilation.
This implementation runs the XML validation program.
START-TYPE is ignored."
(ignore start-type)
(with-slots (xmllint-program schema-file config-file) this
(let* ((cmd (mapconcat #'identity
`(,xmllint-program "--noout" "--schema"
,schema-file ,config-file)
" "))
(buffer-name (flex-compiler-buffer-name this)))
(compilation-start cmd nil #'(lambda (_) buffer-name)))))
(flex-compile-manager-register flex-compile-manage-inst
(xml-validate-flex-compiler))
(provide 'flex-compile-xml-validate)
;;; flex-compile-xml-validate.el ends here