branch: externals/psgml commit a6c9fa072e0bbfa795000eea6cf5a4eb9cd1f1d8 Author: Stefan Monnier <monn...@iro.umontreal.ca> Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Fix compilation of files in subdirs; use lexical-binding * sgmldecl/fum.el: Fix compilation. (replace-grammar): Avoid insert-buffer. (spt-synexp): Use pcase. * testcase/tc22.el, testcase/tc18.el, testcase/tc16.el * testcase/tc15.el, testcase/tc13.el: Fix compilation, use lexical-binding. * auxfiles/reform.el, testcase/testsuit.el: Use lexical-binding. --- auxfiles/reform.el | 2 +- sgmldecl/fum.el | 50 +++++++++++++++++++++----------------------------- testcase/tc13.el | 7 +++++-- testcase/tc15.el | 7 +++++-- testcase/tc16.el | 7 +++++-- testcase/tc18.el | 7 +++++-- testcase/tc22.el | 5 ++++- testcase/testsuit.el | 6 +++--- 8 files changed, 49 insertions(+), 42 deletions(-) diff --git a/auxfiles/reform.el b/auxfiles/reform.el index 2005297..1c6e82e 100644 --- a/auxfiles/reform.el +++ b/auxfiles/reform.el @@ -1,4 +1,4 @@ -;;; reform.el --- ?? +;;; reform.el --- ?? -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. diff --git a/sgmldecl/fum.el b/sgmldecl/fum.el index 36fb431..1da7d3e 100644 --- a/sgmldecl/fum.el +++ b/sgmldecl/fum.el @@ -1,10 +1,10 @@ -;;; fum.el --- +;;; fum.el --- -*- lexical-binding:t -*- ;; Copyright (C) 1995, 2017 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; Version: $Id: fum.el,v 1.1 2000/04/12 16:44:26 lenst Exp $ -;; Keywords: +;; Keywords: ;; Last edited: Sat Aug 31 23:35:29 1996 by le...@triton.lstaflin.pp.se (Lennart Staflin) ;; This program is free software; you can redistribute it and/or @@ -27,10 +27,12 @@ ;;; Commentary: -;; +;; ;;; Code: +(require 'psgml-parse) + ;;;; Translation macros (defun macroexpand-next () @@ -50,7 +52,7 @@ (let ((end (point))) (backward-page 1) (kill-region (point) (1- end)) - (insert-buffer "*Formatted*"))) + (insert-buffer-substring "*Formatted*"))) (defun spt-nt-name (id) (intern (format "sgml-parse-nt-%s" id))) @@ -61,7 +63,7 @@ (setq *current-id* id) `(defun ,(spt-nt-name id) (check) (message "Enter %s" ,id) - (let ((res + (let ((res ,(spt-synexp 'check synexp))) (message "Exit %s: %s" ,id res) res))) @@ -69,29 +71,17 @@ (defun spt-synexp (check synexp) "Translate the syntax expression SYNEX to lisp with check option CHECK. The check option can be `t', `nil', or a variable name." - (cond ((stringp synexp) ; Token - (spt-token check synexp)) - ((consp synexp) - (case (car synexp) - ((delim) - (spt-delim check (cadr synexp))) - ((nt) - (spt-nt check (cadr synexp))) - ((seq) - (spt-seq check (cdr synexp))) - ((alt) - (spt-alt check (cdr synexp))) - ((must once) - (spt-synexp check (cadr synexp))) - ((many) - (spt-many check (cadr synexp))) - ((opt) - (spt-opt check (cadr synexp))) - ((var) - (spt-var check (cadr synexp) (caddr synexp))) - (else - (error "Illegal syntax expression: %s" synexp)))))) - + (pcase synexp + ((pred stringp) (spt-token check synexp)) ; Token + (`(delim ,d) (spt-delim check d)) + (`(nt ,id) (spt-nt check id)) + (`(seq . ,es) (spt-seq check es)) + (`(alt . ,es) (spt-alt check es)) + (`(,(or `must `once) ,e) (spt-synexp check e)) + (`(many ,e) (spt-many check e)) + (`(opt ,e) (spt-opt check e)) + (`(var ,v ,e) (spt-var check v e)) + (_ (error "Illegal syntax expression: %S" synexp)))) (defun spt-var (check var synexp) (if (null var) @@ -150,7 +140,7 @@ The check option can be `t', `nil', or a variable name." (while ,(spt-synexp nil synexp))) res)))) -(defun spt-opt (check synexp) +(defun spt-opt (_check synexp) `(or ,(spt-synexp nil synexp) t)) @@ -223,6 +213,7 @@ The check option can be `t', `nil', or a variable name." ;;;; SGML Declaration Grammar +(eval-when-compile (unless (fboundp 'spt-nt-name) (require 'fum))) (defnt "171+" ;; SGML declaration @@ -791,4 +782,5 @@ The check option can be `t', `nil', or a variable name." )))) ) +(provide 'fum) ;;; fum.el ends here diff --git a/testcase/tc13.el b/testcase/tc13.el index 113b6e4..632bfff 100644 --- a/testcase/tc13.el +++ b/testcase/tc13.el @@ -1,4 +1,4 @@ -;;; tc13.el --- +;;; tc13.el --- -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. @@ -15,6 +15,9 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. +(require 'psgml-parse) +(require 'cl-lib) + (defun psgml-tc13 () (set-buffer (get-buffer-create "*Tc13*")) (erase-buffer) @@ -27,6 +30,6 @@ (sgml-tree-etag-len el)))) (insert ">") (let ((el (sgml-parse-to-here))) - (assert (sgml-off-top-p el)))) + (cl-assert (sgml-off-top-p el)))) (psgml-tc13) diff --git a/testcase/tc15.el b/testcase/tc15.el index 49d5a58..89fb462 100644 --- a/testcase/tc15.el +++ b/testcase/tc15.el @@ -1,4 +1,4 @@ -;;; tc15.el --- +;;; tc15.el --- -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. @@ -15,6 +15,9 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. +(require 'psgml-parse) +(require 'cl-lib) + (defun psgml-tc15 () ;; Check that completing honors insert-case (set-buffer (get-buffer-create "*Tc15*")) @@ -25,6 +28,6 @@ (sgml-complete) (beginning-of-line) (let ((case-fold-search nil)) - (assert (looking-at "<foo")))) + (cl-assert (looking-at "<foo")))) (psgml-tc15) diff --git a/testcase/tc16.el b/testcase/tc16.el index 7722e26..eb19737 100644 --- a/testcase/tc16.el +++ b/testcase/tc16.el @@ -1,4 +1,4 @@ -;;; tc16.el --- +;;; tc16.el --- -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. @@ -15,6 +15,9 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. +(require 'psgml-parse) +(require 'cl-lib) + (let () (switch-to-buffer (generate-new-buffer "tc16 temp")) (insert-file-contents "tc16.html") @@ -23,5 +26,5 @@ (goto-char (point-min)) (while (re-search-forward "<\\(dt\\|li\\)>" nil t) (let ((gi (match-string 1))) - (assert (looking-at (format ".*</%s>" gi)))))) + (cl-assert (looking-at (format ".*</%s>" gi)))))) diff --git a/testcase/tc18.el b/testcase/tc18.el index 6b91593..ff0806c 100644 --- a/testcase/tc18.el +++ b/testcase/tc18.el @@ -1,4 +1,4 @@ -;;; tc18.el --- +;;; tc18.el --- -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. @@ -15,11 +15,14 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <http://www.gnu.org/licenses/>. +(require 'psgml-parse) +(require 'cl-lib) + (with-temp-buffer (insert-file-contents "tc18.html") (goto-char (point-min)) (search-forward "em class") (sgml-change-element-name "B") (beginning-of-line 1) - (assert (looking-at ".* class=")) + (cl-assert (looking-at ".* class=")) ) diff --git a/testcase/tc22.el b/testcase/tc22.el index 0e19904..d0342c8 100644 --- a/testcase/tc22.el +++ b/testcase/tc22.el @@ -1,4 +1,4 @@ -;;; tc22.el --- +;;; tc22.el --- -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. @@ -16,6 +16,9 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. +(require 'psgml-parse) +(require 'cl-lib) + (let ((sgml-ecat-files '("tc22.ecat")) (dd default-directory)) (save-current-buffer diff --git a/testcase/testsuit.el b/testcase/testsuit.el index 2486691..8a2904d 100644 --- a/testcase/testsuit.el +++ b/testcase/testsuit.el @@ -1,4 +1,4 @@ -;;; testsuit.el --- Test Suite for PSGML +;;; testsuit.el --- Test Suite for PSGML -*- lexical-binding:t -*- ;; Copyright (C) 2017 Free Software Foundation, Inc. @@ -51,8 +51,8 @@ (defun testsuit-run-test-case (case-description) - (let* ((file (first case-description)) - (expected (rest case-description)) + (let* ((file (car case-description)) + (expected (cdr case-description)) (sgml-show-warnings t) (warning-expected nil) (sgml-pi-function 'testsuit-pi-handler))