X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/24078157b6a5b0b7dbb830e4242dd715dcf89e32..7371d05adf4e86f8c6c507d6a8177abac1680d06:/validate.el

diff --git a/validate.el b/validate.el
index ef628e954..286835e5b 100644
--- a/validate.el
+++ b/validate.el
@@ -1,27 +1,14 @@
 ;;; validate.el --- Schema validation for Emacs-lisp  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2016  Artur Malabarba
+;; Copyright (C) 2016  Free Software Foundation, Inc.
 
 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
 ;; Keywords: lisp
 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
-;; Version: 0.1
-
-;; 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 3 of the License, 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, see <http://www.gnu.org/licenses/>.
+;; Version: 0.4
 
 ;;; Commentary:
-
+;;
 ;; This library offers two functions that perform schema validation.
 ;; Use this is your Elisp packages to provide very informative error
 ;; messages when your users accidentally misconfigure a variable.
@@ -45,6 +32,26 @@
 ;; matches.  The function `validate-variable' verifies whether the value of a
 ;; custom variable matches its custom-type, while `validate-value' checks an
 ;; arbitrary value against an arbitrary schema.
+;;
+;; Missing features: `:inline', `plist', `coding-system', `color',
+;; `hook', `restricted-sexp'.
+
+;;; License:
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs 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 GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Code:
 (require 'cl-lib)
@@ -57,6 +64,9 @@
       "wrong number of elements"
     (seq-find #'identity (seq-mapn #'validate--check values schemas))))
 
+(defun validate--indent-by-2 (x)
+  (replace-regexp-in-string "^" "  " x))
+
 (defun validate--check (value schema)
   "Return nil if VALUE matches SCHEMA.
 If they don't match, return an explanation."
@@ -68,7 +78,7 @@ If they don't match, return an explanation."
     (setq args (or (plist-get props :args)
                    args))
     (let ((r
-           (cl-labels ((wtype ;wrong-type
+           (cl-labels ((wtype           ;wrong-type
                         (tt) (unless (funcall (intern (format "%sp" tt)) value)
                                (format "not a %s" tt))))
              ;; TODO: hook (top-level only).
@@ -120,8 +130,8 @@ If they don't match, return an explanation."
                                    (error "`choice' needs at least one argument")
                                  (let ((gather (mapcar (lambda (x) (validate--check value x)) args)))
                                    (when (seq-every-p #'identity gather)
-                                     (concat "all of the options failed\n  "
-                                             (mapconcat #'identity gather "\n  "))))))
+                                     (concat "all of the options failed\n"
+                                             (mapconcat #'validate--indent-by-2 gather "\n"))))))
                ;; TODO: `restricted-sexp'
                (set (or (wtype 'list)
                         (let ((failed (list t)))
@@ -138,7 +148,10 @@ If they don't match, return an explanation."
         (let ((print-length 4)
               (print-level 2))
           (format "Looking for `%S' in `%S' failed because:\n%s"
-                  schema value r))))))
+                  schema value
+                  (if (string-match "\\`Looking" r)
+                      r
+                    (validate--indent-by-2 r))))))))
 
 
 ;;; Exposed API
@@ -168,5 +181,20 @@ with `validate-value'. NOERROR is passed to `validate-value'."
       (if noerror val
         (error "Variable `%s' has no custom-type." symbol)))))
 
+;;;###autoload
+(defun validate-mark-safe-local (symbol)
+  "Mark SYMBOL as a safe local if its custom type is obeyed."
+  (put symbol 'safe-local-variable
+       (lambda (val)
+         (validate-value val (custom-variable-type symbol) 'noerror))))
+
+(defmacro validate-setq (symbol value)
+  "Like `setq', but throw an error if validation fails.
+VALUE is validated against SYMBOL's custom type."
+  `(if (boundp ',symbol)
+       (setq ,symbol (validate-value ,value (custom-variable-type ',symbol)))
+     (user-error "Trying to validate a variable that's not defined yet: `%s'.\nYou need to require the package before validating"
+                 ',symbol)))
+
 (provide 'validate)
 ;;; validate.el ends here