branch: scratch/psgml commit 9272d11f719d84107229e57dd4d4df3b68e7f75b Author: Stefan Monnier <monn...@iro.umontreal.ca> Commit: Stefan Monnier <monn...@iro.umontreal.ca>
General update, cl-lib, lexical-binding, copyright headers Fix up copyright headers and GPL version. Use lexical-binding everywhere. Use cl-lib. Move `provide' calls to the end of files. Use (declare (debug ..)) rather than def-edebug-spec. Move `make-local-variable' into the corresponding `set'. Use (declare (gv-setter ..)) rather than defsetf. * ChangeLog.old: Move from ChangeLog. * TODO: Add new entries. * ECAT: Move to auxfiles/ECAT. * psgml-dtd.el (sgml-declare-element): Don't use return value of `incf'. * psgml-edit.el (sgml-fold-region, sgml-operate-on-tags): Use with-silent-modifications. (sgml-edit-attrib-mode-map): Move initialization into declaration. (sgml-attr-default-keymap): Use `remap'. (sgml-edit-attrib-mode): Use define-derived-mode. (sgml-edit-external-entity): Use pcase. * psgml-fs.el (fs-element): Use pcase. * psgml-lucid.el (sgml-mode-map): Move binding to psgml.el. * psgml-maint.el (psgml-common-files): Remove psgml-sysdep.el. * psgml-other.el (sgml-mode-map): Move bindings to psgml.el. (sgml-with-modification-state): Remove. (sgml-current-tree): Declare var. (sgml-element-appdata): Declare function. (sgml-set-face-for): Use with-silent-modifications and check inhibit-modification-hooks rather than sgml-parse-in-loop. (buffer-substring-no-properties): Drop compatibility with Emacs<19.29. * psgml-sysdep.el: Remove. * psgml-parse.el: Inline psgml-sysdep. (sgml-scratch-buffer): Make permanent-local. (sgml-parser-syntax): Cleanup declaration and initialization. (xml-parser-syntax): Replace mapconcat -> mapc. (sgml-with-parser-syntax, sgml-with-parser-syntax-ro): Use with-syntax-table. (sgml-general-insert-case): Use pcase. (sgml-in-file-eval): Use with-current-buffer. (sgml-alias-fields): Use mapcar and defalias. (sgml-note-change-at): Use char-before. (sgml-display-log, sgml-reset-log): Use with-current-buffer. (sgml-parse-in-loop): Remove. Use inhibit-modification-hooks instead. (sgml-parser-loop): Use with-silent-modifications. * psgml.el: Don't provide `psgml-mode'. (psgml-version): Remove. (psgml-maintainer-address): Set to emacs-devel. (sgml-mode-abbrev-table): Merge defvar into define-abbrev-table. (sgml-mode-map): Merge intialization and declaration. (sgml-variable-description): Use replace-regexp-in-string. (run-hook-with-args): Remove compatibility definition. (sgml-main-menu): Use :filter. (sgml-compute-insert-dtd-items, sgml-compute-custom-markup-items): Add dummy arg, for use as filter. Return dummy entry when empty. Use mapcar. (sgml-command-post): Use with-demoted-errors. (sgml-mode): Use define-derived-mode. (sgml-mode-markup-syntax-table): Move initialization into declaration. (sgml-restore-buffer-modified-p): Remove. --- ChangeLog => ChangeLog.old | 52 +---- TODO | 57 +++-- ECAT => auxfiles/ECAT | 0 psgml-api.el | 20 +- psgml-charent.el | 28 +-- psgml-debug.el | 53 +++-- psgml-dtd.el | 52 +++-- psgml-edit.el | 224 +++++++++----------- psgml-fs.el | 75 ++++--- psgml-ids.el | 14 +- psgml-info.el | 54 +++-- psgml-lucid.el | 24 +-- psgml-maint.el | 34 ++- psgml-nofill.el | 20 +- psgml-other.el | 78 ++----- psgml-parse.el | 500 +++++++++++++++++++++----------------------- psgml-sysdep.el | 9 - psgml-vars.el | 20 ++ psgml-xpr.el | 14 +- psgml.el | 344 +++++++++++++----------------- psgml.texi | 2 +- 21 files changed, 749 insertions(+), 925 deletions(-) diff --git a/ChangeLog b/ChangeLog.old similarity index 94% rename from ChangeLog rename to ChangeLog.old index 8b1a677..65ffa97 100644 --- a/ChangeLog +++ b/ChangeLog.old @@ -1,53 +1,3 @@ -2016-10-18 Stefan Monnier <monn...@iro.umontreal.ca> - - * psgml.el: Add dummy `Version:'. - (sgml-running-lucid): Remove. Use (featurep 'xemacs) instead. - (sgml-parse-colon-path): Don't use dyn-bound vars as args. - (sgml-mode): Don't call obsolete make-local-hook. - - * psgml-xpr.el (sgml-delimiters): Avoid `list*'. - - * psgml-parse.el (sgml-set-buffer-multibyte): Remove obsolete code. - (sgml-load-dtd, sgml-bdtd-load): Don't bother binding find-file-type. - (sgml-delimiters): Use `defvar' since it's sometimes modified. - (sgml-try-merge-special-case): Remove unused arg `pubid'. - (sgml-set-initial-state): Don't call obsolete make-local-hook. - (sgml-parse-until-end-of, sgml-parse-to, sgml-parse-continue): - Don't use dyn-bound vars as args. - - * psgml-other.el: Require` psgml-parse'. - - * psgml-maint.el (psgml-elisp-source): Use (featurep 'xemacs). - (psgml-compile-files): Avoid `interactive-p'. - (psgml-install-elc): Remove unused var `destdir'. - - * psgml-lucid.el: Explicitly require `cl'. - - * psgml-info.el (sgml-eltype-refrenced-elements): Avoid add-to-list. - - * psgml-fs.el (fs-add-output, fs-setup-buffer, fs-wrapper): - Use with-current-buffer. - (fs-do-style): Don't use dyn-bound vars as args. Use with-current-buffer. - - * psgml-edit.el (sgml-completion-table): Remove unused arg - `avoid-tags-in-cdata'. - (sgml-attribute-buffer): Use with-current-buffer. - (sgml-make-character-reference): Use match-string and string-to-number. - (sgml-edit-external-entity): Remove unused var `buffer'. - Use with-current-buffer. Silence spurious warning. - (sgml-append-to-help-bufferm, sgml-print-attlist, sgml-show-structure): - Use with-current-buffer. - (sgml-print-position-in-model): Remove unused arg `element-type'. - - * psgml-dtd.el (sgml-reduce-\,): Escape the comma in the name. - (sgml-write-dtd): Don't set obsolete `file-type'. - - * psgml-debug.el (sgml-auto-dump, test-sgml): Use with-current-buffer. - - * .gitignore: Add auto-generated ELPA files. - - * psgml-api.el (sgml-parse-data): Don't use dyn-bound vars as args. - 2008-12-16 Lennart Staflin <le...@lysator.liu.se> * psgml-dtd.el (sgml-parse-character-reference): string-to-int -> @@ -655,7 +605,7 @@ Tue Jan 4 19:51:03 2000 Lennart Staflin <le...@lysator.liu.se> Tue Dec 21 20:50:31 1999 Lennart Staflin <le...@lysator.liu.se> * psgml-other.el (sgml-set-face-for): set rear-nonsticky for face - when sgml-use-text-properties is true. (Suggested by Dirk Fr�mbgen) + when sgml-use-text-properties is true. (Suggested by Dirk Frömbgen) Sat Dec 18 18:55:02 1999 Lennart Staflin <le...@lysator.liu.se> diff --git a/TODO b/TODO index 96001a0..485649d 100644 --- a/TODO +++ b/TODO @@ -1,12 +1,23 @@ -TODO [Time-stamp: "2005-07-01 10:36:29 lenst"] -*- outline -*- - - -* Language fixup +TODO -*- outline -*- + +* Cleanup-related todo list +** Use a keymap filter for sgml-update-options-menu? +** Get rid of (redundant) invisible handling in sgml-update-display. +** Make psgml-mode derive from sgml-mode.el? +** Upgrade to GPLv3+ +** Figure out what sgml-attr-clean-and-insert does. +** Fix interaction with font-lock. +** Generate internal autoloads (at end of psgml.el) automatically. +** Allow cohabitation with sgml-mode.el. +** Rename sgml-xml-p (and maybe other variables ending in "-p"). + +* Old todo list +** Language fixup legal -> valid -* parse prolog and parent document +** parse prolog and parent document Perhaps sgml-parse-prolog() should test whether sgml-parent-document is non-nil, and if so, it should parse the @@ -22,7 +33,7 @@ do. sgml-load-doctype -* Rewrite sgml-popup-multi-menu +** Rewrite sgml-popup-multi-menu Should also split the menu if larger than sgml-max-menu-size. Construct the menu as a keymap. @@ -30,13 +41,13 @@ Construct the menu as a keymap. What about XEmacs? -* Cosider removing sgml-balanced-tag-edit +** Cosider removing sgml-balanced-tag-edit Only affects sgml-tag-menu. Perhaps replace with a "context menu type" option. -* Restore window config after edit-attr +** Restore window config after edit-attr -* Indent and fill +** Indent and fill Should probably not indent in NOFILL elements. @@ -64,35 +75,35 @@ or is this always = -* sgml-kill-element +** sgml-kill-element if there is no following element, kill up to the end tag of the current element. -* sgml-do-data - needs a better docstring +** sgml-do-data - needs a better docstring -* Set-faces has other variables sensible defaults +** Set-faces has other variables sensible defaults sgml-auto-activate-dtd -* Fix documentation of sgml-display-char-list-filename +** Fix documentation of sgml-display-char-list-filename File format is not properly descibed. -* Konstigt beteende n�r DOCTYPE specar en odefinierad elementtyp, -speciellt om det �r n�stan samma som topelementet i instansen men +** Konstigt beteende när DOCTYPE specar en odefinierad elementtyp, +speciellt om det är nästan samma som topelementet i instansen men skiljer sig i case. -* Change sgml-throw-on-warning to be a handler +** Change sgml-throw-on-warning to be a handler I.e. instead of throwing call a handler hook. The handler can then do the throw if that is desirable. -* Kanske sgml--add-before-p borde anv�ndas allm�nt +** Kanske sgml--add-before-p borde användas allmänt T.ex. av sgml-insert-element -* Kolla #REQUIRED attribut +** Kolla #REQUIRED attribut i sgml-parse-attribute-specification-list @@ -109,11 +120,11 @@ i sgml-parse-attribute-specification-list (mapcar (function sgml-attdecl-name) unspecified)))) -m�ste ocks� plocka bort optimering av start-tag utan asl. +måste också plocka bort optimering av start-tag utan asl. -Hur mycket �r funktionalliteten v�rd? Vad kostar den? +Hur mycket är funktionalliteten värd? Vad kostar den? -* Determining legal elements +** Determining legal elements If the current element has valid content, then only elements that does not make the current element invalid is legal. @@ -127,7 +138,7 @@ the element. Possibly clean up old functions and variables like sgml-omittag-transparent and sgml-insert-tag. -* Parsing start-tag +** Parsing start-tag Parse the different consituents of the start tag without reference to the DTD. If the tag is well-formed then check it against the DTD. If @@ -139,7 +150,7 @@ attributes. The check against the DTD will fill in attribute names for attributes specified with a value only. This is also the time to check for CONREF and check that all required attributes are given. -* Change buffer local variables to processing instructions +** Change buffer local variables to processing instructions Variables that defined in a local variables section of the document to customize the parser like sgml-shorttag and sgml-default-document diff --git a/ECAT b/auxfiles/ECAT similarity index 100% rename from ECAT rename to auxfiles/ECAT diff --git a/psgml-api.el b/psgml-api.el index db68062..12dff4d 100644 --- a/psgml-api.el +++ b/psgml-api.el @@ -1,13 +1,12 @@ -;;; psgml-api.el --- Extra API functions for PSGML -;; $Id: psgml-api.el,v 1.8 2002/04/25 20:50:27 lenst Exp $ +;;; psgml-api.el --- Extra API functions for PSGML -*- lexical-binding:t -*- -;; Copyright (C) 1994 Lennart Staflin +;; Copyright (C) 1994, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; 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 +;; 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, @@ -16,8 +15,7 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -27,10 +25,9 @@ ;;; Code: -(provide 'psgml-api) (require 'psgml) (require 'psgml-parse) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;; Mapping: map and modify @@ -52,13 +49,13 @@ leaves the element with no start-tag some elements may be ignored." (cond ;; Map content if any ((setq next (sgml-element-content element)) - (incf level)) + (cl-incf level)) ;; If in a sub-tree, move to next element (t (while (and (> level 0) (null (setq next (sgml-element-next element)))) (setq element (sgml-element-parent element)) - (decf level)))) + (cl-decf level)))) (setq element next)))) ;;;; Map content @@ -105,6 +102,5 @@ of the new entity with point at the first character. Use `sgml-pop-entity' to exit from this buffer." (sgml-push-to-entity (sgml-make-entity "#STRING" 'text string))) - - +(provide 'psgml-api) ;;; psgml-api.el ends here diff --git a/psgml-charent.el b/psgml-charent.el index 496c481..b46e901 100644 --- a/psgml-charent.el +++ b/psgml-charent.el @@ -1,15 +1,13 @@ -;;;; psgml-charent.el -;;; Last edited: 1999-12-18 18:54:53 lenst -;;; $Id: psgml-charent.el,v 1.7 2002/04/25 20:50:27 lenst Exp $ +;;; psgml-charent.el --- ??? -*- lexical-binding:t -*- -;; Copyright (C) 1994 Lennart Staflin +;; Copyright (C) 1994, 2016 Free Software Foundation, Inc. ;; Author: Steinar Bang, Falch Hurtigtrykk as., Oslo, 940711 ;; Lennart Staflin <le...@lysator.liu.se> ;; ;; 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 +;; 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, @@ -18,11 +16,10 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;;; Commentary: +;;; Commentary: ;; Functions to convert character entities into displayable characters ;; and displayable characters back into character entities. @@ -30,12 +27,9 @@ ;; This should either use iso-cvt or do better with a multilingual set of entities -;;;; Code: +;;; Code: -(provide 'psgml-charent) (require 'psgml-parse) -(eval-when-compile (require 'cl)) - ;;;; Variable declarations @@ -114,11 +108,11 @@ Alist with entity name as key and display character as content." (interactive) (let ((case-fold-search nil)) (save-excursion - (loop for pair in (sgml-charent-to-dispchar-alist) - do (goto-char (point-min)) - (while (search-forward (cdr pair) nil t) - (replace-match (concat "&" (car pair) ";") t t)))))) + (dolist (pair (sgml-charent-to-dispchar-alist)) + (goto-char (point-min)) + (while (search-forward (cdr pair) nil t) + (replace-match (concat "&" (car pair) ";") t t)))))) - +(provide 'psgml-charent) ;;; psgml-charent.el ends here diff --git a/psgml-debug.el b/psgml-debug.el index 1282f4b..13eb901 100644 --- a/psgml-debug.el +++ b/psgml-debug.el @@ -1,18 +1,32 @@ +;;; psgml-debug.el --- ??? -*- lexical-binding:t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; 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/>. + ;;;;\filename psgml-debug.el -;;;\Last edited: 2001-03-10 00:32:00 lenst -;;;\RCS $Id: psgml-debug.el,v 2.31 2005/03/02 19:43:45 lenst Exp $ ;;;\author {Lennart Staflin} ;;;\maketitle ;;\begin{codeseg} -(provide 'psgml-debug) (require 'psgml) (require 'psgml-parse) (require 'psgml-edit) (require 'psgml-dtd) +(eval-when-compile (require 'cl-lib)) (autoload 'sgml-translate-model "psgml-dtd" "" nil) (eval-when-compile - (require 'cl) (require 'elp) (require 'edebug)) @@ -51,9 +65,7 @@ (defun sgml-start-auto-dump () (interactive) - (add-hook 'post-command-hook - (function sgml-auto-dump) - 'append)) + (add-hook 'post-command-hook #'sgml-auto-dump 'append)) (defun sgml-comepos (epos) (if (sgml-strict-epos-p epos) @@ -110,14 +122,6 @@ edebug-print-circle nil ) -(eval-when (load) - (unless (featurep 'xemacs) - (def-edebug-spec sgml-with-parser-syntax (&rest form)) - (def-edebug-spec sgml-with-parser-syntax-ro (&rest form)) - (def-edebug-spec sgml-skip-upto (sexp)) - (def-edebug-spec sgml-check-delim (sexp &optional sexp)) - (def-edebug-spec sgml-parse-delim (sexp &optional sexp)) - (def-edebug-spec sgml-is-delim (sexp &optional sexp sexp sexp)))) ;;;; dump @@ -128,7 +132,7 @@ (with-output-to-temp-buffer "*DTD dump*" (princ (format "Dependencies: %S\n" (sgml-dtd-dependencies dtd))) - (loop for et being the symbols of (sgml-dtd-eltypes dtd) + (cl-loop for et being the symbols of (sgml-dtd-eltypes dtd) do (sgml-dp-element et)))) (defun sgml-dump-element (el-name) @@ -167,7 +171,7 @@ (defun sgml-dp-model (model &optional indent) (or indent (setq indent 0)) (let ((sgml-code-xlate (sgml-translate-model model))) - (loop + (cl-loop for i from 0 for x in sgml-code-xlate do (cond ((sgml-normal-state-p (car x)) @@ -179,11 +183,11 @@ (princ (format "%s%d: and-node next=%d\n" (make-string indent ? ) i (sgml-code-xlate (sgml-and-node-next (car x))))) - (loop for m in (sgml-and-node-dfas (car x)) + (cl-loop for m in (sgml-and-node-dfas (car x)) do (sgml-dp-model m (+ indent 2)))))))) (defun sgml-untangel-moves (moves) - (loop for m in moves + (cl-loop for m in moves collect (list (sgml-move-token m) (sgml-code-xlate (sgml-move-dest m))))) @@ -206,7 +210,7 @@ (princ (format "%s--next\n" (make-string indent ? ))) (sgml-dp-state (sgml-and-state-next state) (+ 2 indent)) (princ (format "%s--dfas\n" (make-string indent ? ))) - (loop for m in (sgml-and-state-dfas state) + (cl-loop for m in (sgml-and-state-dfas state) do (sgml-dp-model m (+ indent 2)) (princ (format "%s--\n" (make-string indent ? ))))))) @@ -216,7 +220,7 @@ (defun sgml-build-autoloads () (interactive) (with-output-to-temp-buffer "*autoload*" - (loop + (cl-loop for file in '("psgml-parse" "psgml-edit" "psgml-dtd" "psgml-info" "psgml-charent") do @@ -276,6 +280,8 @@ ;;;; Profiling +(require 'elp) + (defun profile-sgml (&optional file) (interactive) (or file (setq file (expand-file-name "~/work/sigmalink/BBB/config/configspec.xml"))) @@ -283,7 +289,7 @@ (sgml-need-dtd) (sgml-instrument-parser) (elp-reset-all) - (dotimes (i 5) + (dotimes (_ 5) (garbage-collect) (sgml-reparse-buffer (function sgml-handle-shortref))) (elp-results)) @@ -377,3 +383,6 @@ (elp-instrument-list)) ;\end{codeseg} + +(provide 'psgml-debug) +;;; psgml-debug.el ends here diff --git a/psgml-dtd.el b/psgml-dtd.el index bd165b0..8d76565 100644 --- a/psgml-dtd.el +++ b/psgml-dtd.el @@ -1,13 +1,12 @@ -;;;; psgml-dtd.el --- DTD parser for SGML-editing mode with parsing support -;; $Id: psgml-dtd.el,v 2.32 2008/12/16 13:57:29 lenst Exp $ +;;; psgml-dtd.el --- DTD parser for SGML-editing mode with parsing support -*- lexical-binding:t -*- -;; Copyright (C) 1994 Lennart Staflin +;; Copyright (C) 1994, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; 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 +;; 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, @@ -16,21 +15,18 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;;; Commentary: +;;; Commentary: ;; Part of major mode for editing the SGML document-markup language. -;;;; Code: +;;; Code: -(provide 'psgml-dtd) (require 'psgml) (require 'psgml-parse) -(eval-when-compile (require 'cl)) ;;;; Variables @@ -120,7 +116,7 @@ Syntax: var dfa-expr &body forms" (length (sgml-state-opts s))) (let ((final nil) dest) - (loop for m in (append (sgml-state-reqs s) + (cl-loop for m in (append (sgml-state-reqs s) (sgml-state-opts s)) do (setq dest (sgml-move-dest m)) @@ -135,12 +131,12 @@ Syntax: var dfa-expr &body forms" (length (sgml-state-opts s2))) (= (length (sgml-state-reqs s1)) (length (sgml-state-reqs s2))) - (loop for m in (sgml-state-opts s1) + (cl-loop for m in (sgml-state-opts s1) always (eq (sgml-move-dest m) (sgml-move-dest (sgml-moves-lookup (sgml-move-token m) (sgml-state-opts s2))))) - (loop for m in (sgml-state-reqs s1) + (cl-loop for m in (sgml-state-reqs s1) always (eq (sgml-move-dest m) (sgml-move-dest (sgml-moves-lookup (sgml-move-token m) @@ -203,9 +199,9 @@ Syntax: var dfa-expr &body forms" (let ((moves (append (sgml-state-reqs s1) (sgml-state-opts s1)))) (cond (;; optimize the case where all moves from s1 goes to empty states - (loop for m in moves + (cl-loop for m in moves always (sgml-empty-state-p (sgml-move-dest m))) - (loop for m in moves do (setf (sgml-move-dest m) s2)) + (cl-loop for m in moves do (setf (sgml-move-dest m) s2)) (when (sgml-state-final-p s1) (sgml-copy-moves s2 s1))) (t ; general case @@ -242,10 +238,10 @@ Syntax: var dfa-expr &body forms" (l dfas)) (while l ; For each si: ;; For m in opts(si): add optional move from s to &n on token(m). - (loop for m in (sgml-state-opts (car l)) + (cl-loop for m in (sgml-state-opts (car l)) do (sgml-add-opt-move s (sgml-move-token m) &n)) ;; For m in reqs(si): add required move from s to &n on token(m). - (loop for m in (sgml-state-reqs (car l)) + (cl-loop for m in (sgml-state-reqs (car l)) do (sgml-add-req-move s (sgml-move-token m) &n)) (setq l (cdr l))) ;; Return s. @@ -401,7 +397,7 @@ Case transformed for general names." (sgml-skip-ps) (if (sgml-is-delim "NULL" digit) (let ((suffix (sgml-parse-nametoken))) - (loop for n in names + (cl-loop for n in names collect (concat n suffix))) names))) (t ; gi/ranked element @@ -578,8 +574,9 @@ Case transformed for general names." (sgml-eltype-excludes et) exclusions (sgml-eltype-includes et) inclusions)) (setq names (cdr names))) + (cl-incf sgml-no-elements) (sgml-lazy-message "Parsing doctype (%s elements)..." - (incf sgml-no-elements)))) + sgml-no-elements))) ;;;; Parse doctype: Entity @@ -691,7 +688,7 @@ Case transformed for general names." (setq attlist (nreverse attlist)) (unless assnot (sgml-before-eltype-modification) - (loop for elname in assel do + (cl-loop for elname in assel do (setf (sgml-eltype-attlist (sgml-lookup-eltype elname)) (sgml-merge-attlists (sgml-eltype-attlist @@ -700,7 +697,7 @@ Case transformed for general names." (defun sgml-merge-attlists (old new) (setq old (nreverse (copy-sequence old))) - (loop for att in new do + (cl-loop for att in new do (unless (assoc (car att) old) (setq old (cons att old)))) (nreverse old)) @@ -798,7 +795,7 @@ Case transformed for general names." (defun sgml-do-usemap-element (mapname) ;; This is called from sgml-do-usemap with the mapname (sgml-before-eltype-modification) - (loop for e in (sgml-parse-name-group) do + (cl-loop for e in (sgml-parse-name-group) do (setf (sgml-eltype-shortmap (sgml-lookup-eltype e sgml-dtd-info)) (if (null mapname) 'empty @@ -826,7 +823,7 @@ Case transformed for general names." (defvar sgml-translate-table nil) (defun sgml-translate-node (node) - (assert (not (numberp node))) + (cl-assert (not (numberp node))) (let ((tp (assq node sgml-translate-table))) (unless tp (setq tp (cons node (length sgml-translate-table))) @@ -856,7 +853,7 @@ Case transformed for general names." (defvar sgml-code-xlate nil) (defsubst sgml-code-xlate (node) - ;;(let ((x (cdr (assq node sgml-code-xlate)))) (assert x) x) + ;;(let ((x (cdr (assq node sgml-code-xlate)))) (cl-assert x) x) (cdr (assq node sgml-code-xlate))) (defun sgml-code-number (num) @@ -886,7 +883,7 @@ FORMS should produce the binary coding of element in VAR." (seq (cadr loop-c))) `(let ((seq ,seq)) (sgml-code-number (length seq)) - (loop for ,var in seq + (cl-loop for ,var in seq do ,@body)))) (put 'sgml-code-sequence 'lisp-indent-hook 1) @@ -911,7 +908,7 @@ FORMS should produce the binary coding of element in VAR." (setq s (car s)) ; s is node (cond ((sgml-normal-state-p s) - (assert (and (< (length (sgml-state-opts s)) 255) + (cl-assert (and (< (length (sgml-state-opts s)) 255) (< (length (sgml-state-reqs s)) 256))) (sgml-code-sequence (x (sgml-state-opts s)) (sgml-code-move x)) @@ -937,7 +934,7 @@ FORMS should produce the binary coding of element in VAR." ((eq c sgml-any) (insert 3)) ((null c) (insert 4)) (t - (assert (sgml-model-group-p c)) + (cl-assert (sgml-model-group-p c)) (insert 128) (sgml-code-model c)))) (sgml-code-tokens (sgml-eltype-includes et)) @@ -1011,4 +1008,5 @@ Construct the binary coded DTD (bdtd) in the current buffer." (write-region (point-min) (point-max) file))) +(provide 'psgml-dtd) ;;; psgml-dtd.el ends here diff --git a/psgml-edit.el b/psgml-edit.el index 2c6bdc6..7ad7d52 100644 --- a/psgml-edit.el +++ b/psgml-edit.el @@ -1,14 +1,12 @@ -;;; psgml-edit.el --- Editing commands for SGML-mode with parsing support -;; -;; $Id: psgml-edit.el,v 2.76 2005/05/19 19:35:00 lenst Exp $ +;;; psgml-edit.el --- Editing commands for SGML-mode with parsing support -*- lexical-binding:t -*- -;; Copyright (C) 1994, 1995, 1996 Lennart Staflin +;; Copyright (C) 1994-1996, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; 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 +;; 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, @@ -17,8 +15,7 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;;; Commentary: @@ -28,11 +25,10 @@ ;;;; Code: -(provide 'psgml-edit) (require 'psgml) (require 'psgml-parse) (require 'psgml-ids) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; (eval-when-compile ;; (setq byte-compile-warnings '(free-vars unresolved callargs redefine))) @@ -203,7 +199,7 @@ a list using attlist TO." (let ((new-values nil) (sgml-show-warnings t) tem) - (loop for attspec in values + (cl-loop for attspec in values as from-decl = (sgml-lookup-attdecl (sgml-attspec-name attspec) from) as to-decl = (sgml-lookup-attdecl (sgml-attspec-name attspec) to) do @@ -265,18 +261,11 @@ If called from a program first two arguments are start and end of region. And optional third argument true unhides." (interactive "r\nP") (setq selective-display t) - ;; FIXME: Use `with-silent-modifications'. - (let ((mp (buffer-modified-p)) - (inhibit-read-only t) - (before-change-functions nil) - (after-change-functions nil)) - (unwind-protect - (subst-char-in-region beg end - (if unhide ?\r ?\n) - (if unhide ?\n ?\r) - 'noundo) - (when sgml-buggy-subst-char-in-region - (set-buffer-modified-p mp))))) + (with-silent-modifications + (subst-char-in-region beg end + (if unhide ?\r ?\n) + (if unhide ?\n ?\r) + 'noundo))) (defun sgml-fold-element () "Fold the lines comprising the current element, leaving the first line visible. @@ -499,7 +488,7 @@ Deprecated: ELEMENT" (cond ((sgml-final-p sgml-current-state) (princ "Valid end-tags : ") - (loop for e in (sgml-current-list-of-endable-eltypes) + (cl-loop for e in (sgml-current-list-of-endable-eltypes) do (princ (sgml-end-tag-of e)) (princ " ")) (terpri)) (t @@ -557,7 +546,7 @@ Deprecated: ELEMENT" (princ prompt) (let ((col (length prompt)) (w (1- (frame-width)))) - (loop for e in list + (cl-loop for e in list as str = (sgml-start-tag-of e) do (setq col (+ col (length str) 2)) @@ -609,7 +598,7 @@ Deprecated: ELEMENT" (el nil)) (goto-char pos) (setq el (sgml-find-element-of pos)) - (assert (not (null el))) + (cl-assert (not (null el))) (message "%s %s" (cond ((eq el sgml-top-tree) "outside document element") @@ -661,7 +650,7 @@ tag inserted." (let ((completion-ignore-case sgml-namecase-general)) (completing-read "Tag: " (sgml-completion-table) nil t "<" )))) (sgml-find-context-of (point)) - (assert (null sgml-markup-type)) + (cl-assert (null sgml-markup-type)) ;; Fix white-space before tag (unless (sgml-element-data-p (sgml-parse-to-here)) (skip-chars-backward " \t") @@ -735,7 +724,7 @@ after the first tag inserted." newpos))) (defun sgml-default-asl (element) - (loop for attdecl in (sgml-element-attlist element) + (cl-loop for attdecl in (sgml-element-attlist element) when (sgml-default-value-type-p (sgml-attdecl-default-value attdecl) 'REQUIRED) collect @@ -762,7 +751,7 @@ after the first tag inserted." "Insert the attributes with values AVL and declarations ATTLIST. AVL should be a assoc list mapping symbols to strings." (let (name val dcl def) - (loop for attspec in attlist do + (cl-loop for attspec in attlist do (setq name (sgml-attspec-name attspec) val (cdr-safe (sgml-lookup-attspec name avl)) dcl (sgml-attdecl-declared-value attspec) @@ -876,7 +865,7 @@ AVL should be a assoc list mapping symbols to strings." (unless (assoc elt attlist) ; avoid duplicates (push (sgml-make-attdecl elt 'CDATA 'REQUIRED) attlist))) (setq attlist (nreverse attlist))) - (assert (sgml-bpos-p (sgml-element-stag-epos element))) + (cl-assert (sgml-bpos-p (sgml-element-stag-epos element))) (goto-char (sgml-element-start element)) (delete-char (sgml-element-stag-len element)) (sgml-insert-start-tag name asl attlist @@ -888,7 +877,7 @@ AVL should be a assoc list mapping symbols to strings." "Return the attribute value read from user. ATTDECL is the attribute declaration for the attribute to read. CURVALUE is nil or a string that will be used as default value." - (assert attdecl) + (cl-assert attdecl) (let* ((name (sgml-attdecl-name attdecl)) (dv (sgml-attdecl-declared-value attdecl)) (tokens (sgml-declared-value-token-group dv)) @@ -940,7 +929,7 @@ CURVALUE is nil or a string that will be used as default value." (member string (sgml-id-alist)))))) (defun sgml-non-fixed-attributes (attlist) - (loop for attdecl in attlist + (cl-loop for attdecl in attlist unless (sgml-default-value-type-p 'FIXED (sgml-attdecl-default-value attdecl)) collect attdecl)) @@ -968,8 +957,8 @@ CURVALUE is nil or a string that will be used as default value." (sgml-element-name el) (sgml-element-attval el name))))) ;; Body - (assert (stringp name)) - (assert (or (null value) (stringp value))) + (cl-assert (stringp name)) + (cl-assert (or (null value) (stringp value))) (let* ((el (sgml-find-attribute-element)) (asl (cons (sgml-make-attspec name value) (sgml-element-attribute-specification-list el))) @@ -988,7 +977,7 @@ of then current element." 0)) (let ((u (sgml-find-context-of (point))) (start (point-marker))) - (loop repeat sgml-split-level do + (cl-loop repeat sgml-split-level do (goto-char (sgml-element-start u)) (setq u (sgml-element-parent u))) ;; Verify that a new element can be started @@ -1019,7 +1008,7 @@ of then current element." (interactive (list (completing-read "Insert DTD: " sgml-custom-dtd nil t))) (let ((entry (assoc doctype sgml-custom-dtd))) - (sgml-doctype-insert (second entry) (cddr entry)))) + (sgml-doctype-insert (cadr entry) (cddr entry)))) (defun sgml-custom-markup (markup) "Insert markup from the sgml-custom-markup alist." @@ -1199,7 +1188,7 @@ buffers local variables list." (setq attlist (list (sgml-make-attdecl name 'CDATA nil)))))) (or attlist (error "No non-fixed attributes for element")) - (loop for attdecl in attlist + (cl-loop for attdecl in attlist for name = (sgml-attdecl-name attdecl) for defval = (sgml-attdecl-default-value attdecl) for tokens = (or (sgml-declared-value-token-group @@ -1211,7 +1200,7 @@ buffers local variables list." (sgml-attdecl-name attdecl) (nconc (if tokens - (loop for val in tokens collect + (cl-loop for val in tokens collect (list val (list 'sgml-insert-attribute name val))) (list @@ -1271,20 +1260,20 @@ after the first tag inserted." (sgml-current-list-of-valid-eltypes)))) (change-menu (cons "Change To" - (loop for gi in alt-gi - collect `(,gi (sgml-change-element-name ,gi)))))) + (cl-loop for gi in alt-gi + collect `(,gi (sgml-change-element-name ,gi)))))) (sgml-popup-multi-menu event "Start Tag" - (list* `("Action" - ("Edit attributes" (sgml-edit-attributes)) - ("Normalize" (sgml-normalize-element)) - ("Fill" (sgml-fill-element - (sgml-find-context-of (point)))) - ("Splice" (sgml-untag-element)) - ("Fold" (sgml-fold-element))) - change-menu - `("--" "--") - attrib-menu))))) + `(("Action" + ("Edit attributes" (sgml-edit-attributes)) + ("Normalize" (sgml-normalize-element)) + ("Fill" (sgml-fill-element + (sgml-find-context-of (point)))) + ("Splice" (sgml-untag-element)) + ("Fold" (sgml-fold-element))) + ,change-menu + ("--" "--") + . ,attrib-menu))))) @@ -1416,14 +1405,10 @@ Editing is done in a separate window." (xml-p sgml-xml-p)) (switch-to-buffer-other-window (sgml-attribute-buffer element asl)) - (make-local-variable 'sgml-start-attributes) - (setq sgml-start-attributes start) - (make-local-variable 'sgml-always-quote-attributes) - (setq sgml-always-quote-attributes quote) - (make-local-variable 'sgml-main-buffer) - (setq sgml-main-buffer cb) - (make-local-variable 'sgml-xml-p) - (setq sgml-xml-p xml-p)))) + (set (make-local-variable 'sgml-start-attributes) start) + (set (make-local-variable 'sgml-always-quote-attributes) quote) + (set (make-local-variable 'sgml-main-buffer) cb) + (set (make-local-variable 'sgml-xml-p) xml-p)))) (defun sgml-effective-attlist (eltype) @@ -1458,9 +1443,8 @@ Editing is done in a separate window." (with-current-buffer buf (erase-buffer) (sgml-edit-attrib-mode) - (make-local-variable 'sgml-attlist) - (setq sgml-attlist (sgml-effective-attlist - (sgml-element-eltype element))) + (set (make-local-variable 'sgml-attlist) + (sgml-effective-attlist (sgml-element-eltype element))) (sgml-insert '(read-only t) (substitute-command-keys "<%s -- Edit values and finish with \ @@ -1545,40 +1529,35 @@ Editing is done in a separate window." (insert ")")) -(defvar sgml-edit-attrib-mode-map (make-sparse-keymap)) +(defvar sgml-edit-attrib-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'sgml-edit-attrib-finish) + (define-key map "\C-c\C-d" 'sgml-edit-attrib-default) + (define-key map "\C-c\C-k" 'sgml-edit-attrib-abort) + (define-key map "\C-a" 'sgml-edit-attrib-field-start) + (define-key map "\C-e" 'sgml-edit-attrib-field-end) + (define-key map "\t" 'sgml-edit-attrib-next) + map)) ;; used as only for #DEFAULT in attribute editing. Binds all normally inserting ;; keys to a command that will clear the #DEFAULT before doing self-insert. (defvar sgml-attr-default-keymap (let ((map (make-sparse-keymap))) (set-keymap-parent map sgml-edit-attrib-mode-map) - (substitute-key-definition 'self-insert-command - 'sgml-attr-clean-and-insert - map - global-map) - (put 'sgml-default 'local-map map))) - -(define-key sgml-edit-attrib-mode-map "\C-c\C-c" 'sgml-edit-attrib-finish) -(define-key sgml-edit-attrib-mode-map "\C-c\C-d" 'sgml-edit-attrib-default) -(define-key sgml-edit-attrib-mode-map "\C-c\C-k" 'sgml-edit-attrib-abort) + (define-key map [remap self-insert-command] 'sgml-attr-clean-and-insert) + map)) -(define-key sgml-edit-attrib-mode-map "\C-a" 'sgml-edit-attrib-field-start) -(define-key sgml-edit-attrib-mode-map "\C-e" 'sgml-edit-attrib-field-end) -(define-key sgml-edit-attrib-mode-map "\t" 'sgml-edit-attrib-next) +(put 'sgml-default 'local-map sgml-attr-default-keymap) -(defun sgml-edit-attrib-mode () +(define-derived-mode sgml-edit-attrib-mode text-mode "SGML edit attributes" "Major mode to edit attribute specification list. \\<sgml-edit-attrib-mode-map> Use \\[sgml-edit-attrib-next] to move between input fields. Use \\[sgml-edit-attrib-default] to make an attribute have its default value. To abort edit kill buffer (\\[kill-buffer]) and remove window \(\\[delete-window]). -To finish edit use \\[sgml-edit-attrib-finish]. +To finish edit use \\[sgml-edit-attrib-finish]. -\\{sgml-edit-attrib-mode-map}" - (setq mode-name "SGML edit attributes" - major-mode 'sgml-edit-attrib-mode) - (use-local-map sgml-edit-attrib-mode-map) - (run-hooks 'text-mode-hook 'sgml-edit-attrib-mode-hook)) +\\{sgml-edit-attrib-mode-map}") (defun sgml-edit-attrib-abort () "Abort the attribute editor, removing the window." @@ -1695,7 +1674,7 @@ To finish edit use \\[sgml-edit-attrib-finish]. (while (eq 'sgml-form (get-text-property (point) 'category)) (setq start (next-single-property-change (point) 'category)) (unless start (error "No attribute value here")) - (assert (number-or-marker-p start)) + (cl-assert (number-or-marker-p start)) (goto-char start)))) (defun sgml-edit-attrib-field-end () @@ -1706,7 +1685,7 @@ To finish edit use \\[sgml-edit-attrib-finish]. (get-text-property (1+ (point)) 'read-only)) (point) (next-single-property-change (point) 'read-only)))) - (assert (number-or-marker-p end)) + (cl-assert (number-or-marker-p end)) (goto-char end))) (defun sgml-edit-attrib-next () @@ -1728,36 +1707,31 @@ To finish edit use \\[sgml-edit-attrib-finish]. "\\(</?>\\|</?[_A-Za-z][-_:A-Za-z0-9.]*\\(\\([^'\"></]\\|'[^']*'\\|\"[^\"]*\"\\)*\\)/?>?\\)")) (defun sgml-operate-on-tags (action &optional attr-p) - (let ((buffer-modified-p (buffer-modified-p)) - (inhibit-read-only t) - (buffer-read-only nil) - (before-change-functions nil) - (markup-index ; match-data index in tag regexp + (let ((markup-index ; match-data index in tag regexp (if attr-p 2 1)) (tagcount ; number tags to give them uniq ; invisible properties 1)) - (unwind-protect - (save-excursion - (goto-char (point-min)) - (while (re-search-forward sgml-tag-regexp nil t) - (cond - ((eq action 'hide) - (let ((tag (downcase - (buffer-substring-no-properties - (1+ (match-beginning 0)) - (match-beginning 2))))) - (if (or attr-p (not (member tag sgml-exposed-tags))) - (add-text-properties - (match-beginning markup-index) (match-end markup-index) - (list 'invisible tagcount - 'rear-nonsticky '(invisible face)))))) - ((eq action 'show) ; ignore markup-index - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil))) - (t (error "Invalid action: %s" action))) - (incf tagcount))) - (sgml-restore-buffer-modified-p buffer-modified-p)))) + (with-silent-modifications + (save-excursion + (goto-char (point-min)) + (while (re-search-forward sgml-tag-regexp nil t) + (cond + ((eq action 'hide) + (let ((tag (downcase + (buffer-substring-no-properties + (1+ (match-beginning 0)) + (match-beginning 2))))) + (if (or attr-p (not (member tag sgml-exposed-tags))) + (add-text-properties + (match-beginning markup-index) (match-end markup-index) + (list 'invisible tagcount + 'rear-nonsticky '(invisible face)))))) + ((eq action 'show) ; ignore markup-index + (remove-text-properties (match-beginning 0) (match-end 0) + '(invisible nil))) + (t (error "Invalid action: %s" action))) + (cl-incf tagcount)))))) (defun sgml-hide-tags () "Hide all tags in buffer." @@ -1876,7 +1850,7 @@ elements with omitted end-tags." (attlist (sgml-element-attlist element)) (asl (sgml-element-attribute-specification-list element))) (save-excursion - (assert (or (zerop (sgml-element-stag-len element)) + (cl-assert (or (zerop (sgml-element-stag-len element)) (= (point) (sgml-element-start element)))) (delete-char (sgml-element-stag-len element)) (sgml-insert-start-tag name asl attlist nil))))) @@ -1990,8 +1964,8 @@ characters in the current coding system." (let* ((type (sgml-entity-type entity)) (notation (sgml-entity-notation entity)) (handler (cdr (assoc notation sgml-notation-handlers)))) - (case type - (ndata + (pcase type + (`ndata (if handler (progn (message (format "Using '%s' to handle notation '%s'." @@ -2010,7 +1984,7 @@ characters in the current coding system." (with-no-warnings (process-kill-without-query process)))))) (error "Don't know how to handle notation '%s'." notation))) - (text (progn + (`text ;; here I try to construct a useful value for ;; `sgml-parent-element'. @@ -2039,8 +2013,8 @@ characters in the current coding system." (sgml-mode) (setq sgml-parent-document (cons parent ppos)) ;; update the live element indicator of the new window - (sgml-parse-to-here))) - (t (error "Can't edit entities of type '%s'." type)))))))) + (sgml-parse-to-here)) + (_ (error "Can't edit entities of type '%s'." type)))))))) ;;;; SGML mode: TAB completion @@ -2134,11 +2108,11 @@ If it is something else complete with ispell-complete-word." (defun sgml-options-menu (event vars) (let ((var (let ((maxlen - (loop for var in vars + (cl-loop for var in vars maximize (length (sgml-variable-description var))))) (sgml-popup-menu event "Options" - (loop for var in vars + (cl-loop for var in vars for desc = (sgml-variable-description var) collect (cons @@ -2194,7 +2168,7 @@ will reset the variable.") (let ((val (sgml-popup-menu event (sgml-variable-description var) - (loop for c in type collect + (cl-loop for c in type collect (cons (if (consp c) (car c) (format "%s" c)) (if (consp c) (cdr c) c)))))) @@ -2233,7 +2207,7 @@ will reset the variable.") (let ((c (sgml-element-content el)) (s (sgml-element-model el)) (found nil)) - (loop do + (cl-loop do ;; Fixme: this test avoids an error when DTD-less, but it's ;; probably an inappropriate kludge. -- fx (when (not (eq s 'ANY)) @@ -2361,18 +2335,18 @@ otherwise it will be added at the first legal position." (defun sgml-print-attlist (et) (with-current-buffer standard-output - (loop + (cl-loop for attdecl in (sgml-eltype-attlist et) do (princ " ") (princ (sgml-attdecl-name attdecl)) (let ((dval (sgml-attdecl-declared-value attdecl)) (defl (sgml-attdecl-default-value attdecl))) (when (listp dval) - (setq dval (concat (if (eq (first dval) + (setq dval (concat (if (eq (car dval) 'NOTATION) "#NOTATION (" "(") (mapconcat (function identity) - (second dval) + (cadr dval) "|") ")"))) (indent-to 15 1) @@ -2403,7 +2377,7 @@ otherwise it will be added at the first legal position." (princ " ->") (let* ((state parse-state) (required-seq ; the seq of req el following point - (loop for required = (sgml-required-tokens state) + (cl-loop for required = (sgml-required-tokens state) while (and required (null (cdr required))) collect (sgml-eltype-name (car required)) do (setq state (sgml-get-move state (car required))))) @@ -2449,7 +2423,7 @@ otherwise it will be added at the first legal position." (defun sgml-show-structure-insert (structure) - (loop for (gi level marker title) in structure do + (cl-loop for (gi level marker title) in structure do (let ((start (point))) (insert (make-string (* 2 level) ? )) (sgml-insert `(face match mouse-face highlight) gi) @@ -2495,9 +2469,9 @@ otherwise it will be added at the first legal position." end-epos))))))) (cons (list (sgml-general-insert-case gi) level marker title) - (loop for child = child1 then (sgml-element-next child) + (cl-loop for child = child1 then (sgml-element-next child) while child nconc (sgml-structure-elements child)))))) - +(provide 'psgml-edit) ;;; psgml-edit.el ends here diff --git a/psgml-fs.el b/psgml-fs.el index c5eb7e7..4a1a5bc 100644 --- a/psgml-fs.el +++ b/psgml-fs.el @@ -1,25 +1,23 @@ -;;; psgml-fs.el --- Format a SGML-file according to a style file -;; Copyright (C) 1995, 2000 Lennart Staflin +;;; psgml-fs.el --- Format a SGML-file according to a style file -*- lexical-binding:t -*- + +;; Copyright (C) 1995, 2000, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> -;; Version: $Id: psgml-fs.el,v 1.13 2002/07/14 10:03:26 lenst Exp $ ;; Keywords: -;;; 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. -;;; -;;; A copy of the GNU General Public License can be obtained from this -;;; program's author (send electronic mail to le...@lysator.liu.se) or from -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. -;;; +;; 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, 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/>. + ;;; Commentary: ;; The function `style-format' formats the SGML-file in the current buffer @@ -42,8 +40,8 @@ ;;; Code: (require 'psgml-api) -(eval-when-compile (require 'cl) - (require 'ps-print)) +(eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'ps-print)) ;;;; Formatting parameters @@ -69,13 +67,12 @@ ;;;; Formatting engine (defun fs-char (p) + (declare (gv-setter fs-set-char)) (cdr (assq p fs-char))) (defun fs-set-char (p val) (setcdr (assq p fs-char) val)) -(defsetf fs-char fs-set-char) - (defvar fs-para-acc "" "Accumulate text of paragraph") @@ -110,7 +107,7 @@ (when (if (fs-char 'ignore-empty-para) (string-match "[^\t\n ]" fs-para-acc) fs-left-indent) - (assert fs-left-indent) + (cl-assert fs-left-indent) (fs-output-para fs-para-acc fs-first-indent fs-left-indent fs-hang-from (fs-char 'literal)) @@ -174,7 +171,7 @@ (text nil)) (when entity-map (setq text - (loop for (name val) on entity-map by 'cddr + (cl-loop for (name val) on entity-map by 'cddr thereis (if (equal name (sgml-entity-name entity)) val)))) (unless text @@ -223,7 +220,7 @@ The value can be the style-sheet list, or it can be a file name ? ) hang-from)))) (let ((fs-char (nconc - (loop for st on style by 'cddr + (cl-loop for st on style by 'cddr unless (memq (car st) fs-special-styles) collect (cons (car st) (eval (cadr st)))) @@ -276,10 +273,8 @@ The value can be the style-sheet list, or it can be a file name (erase-buffer) (setq ps-left-header '(fs-title fs-filename)) - (make-local-variable 'fs-filename) - (setq fs-filename (file-name-nondirectory orig-filename)) - (make-local-variable 'fs-title) - (setq fs-title "")))) + (set (make-local-variable 'fs-filename) (file-name-nondirectory orig-filename)) + (set (make-local-variable 'fs-title) "")))) (defun fs-wrapper (buffer-name thunk) (fs-clear) @@ -308,10 +303,10 @@ The value can be the style-sheet list, or it can be a file name "Find current or related element." (let ((element fs-current-element)) (while moves - (case (pop moves) - (parent (setq element (sgml-element-parent element))) - (next (setq element (sgml-element-next element))) - (child (setq element (sgml-element-content element))))) + (pcase (pop moves) + (`parent (setq element (sgml-element-parent element))) + (`next (setq element (sgml-element-next element))) + (`child (setq element (sgml-element-content element))))) element)) (defun fs-element-content (&optional e) @@ -334,30 +329,30 @@ The value can be the style-sheet list, or it can be a file name (child (sgml-element-content parent)) (number 0)) (while (and child (not (eq child element))) - (incf number) + (cl-incf number) (setq child (sgml-element-next child))) number)) (defun fs-element-with-id (id) - (block func + (cl-block func (let ((element (sgml-top-element))) (while (not (sgml-off-top-p element)) (let ((attlist (sgml-element-attlist element))) - (loop for attdecl in attlist + (cl-loop for attdecl in attlist if (eq 'ID (sgml-attdecl-declared-value attdecl)) do (if (compare-strings id nil nil (sgml-element-attval element (sgml-attdecl-name attdecl)) nil nil) - (return-from func element)))) + (cl-return-from func element)))) ;; Next element (if (sgml-element-content element) (setq element (sgml-element-content element)) (while (null (sgml-element-next element)) (setq element (sgml-element-parent element)) (if (sgml-off-top-p element) - (return-from func nil))) + (cl-return-from func nil))) (setq element (sgml-element-next element))))) nil)) @@ -376,5 +371,5 @@ The value can be the style-sheet list, or it can be a file name (sgml-pop-entity) (nreverse result))) - -;;; fs.el ends here +(provide 'psgml-fs) +;;; psgml-fs.el ends here diff --git a/psgml-ids.el b/psgml-ids.el index a141f76..f097748 100644 --- a/psgml-ids.el +++ b/psgml-ids.el @@ -1,13 +1,12 @@ -;;; psgml-ids.el --- Management of ID/IDREFS for PSGML -;; $Id: psgml-ids.el,v 2.1 2005/02/09 15:29:09 lenst Exp $ +;;; psgml-ids.el --- Management of ID/IDREFS for PSGML -*- lexical-binding:t -*- -;; Copyright (C) 1999 Jean-Daniel Fekete +;; Copyright (C) 1999, 2016 Free Software Foundation, Inc. ;; Author: Jean-Daniel Fekete <jean-daniel.fek...@emn.fr> ;; 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 +;; 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, @@ -16,15 +15,13 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: ;; Provides some extra functions to manage IDs and IDREFs in attibutes -(provide 'psgml-ids) (require 'psgml) (require 'psgml-api) @@ -93,3 +90,6 @@ specified" (let ((el (or element (sgml-top-element)))) (sgml-map-element-modify (function sgml-ids-add-from) el))) + +(provide 'psgml-ids) +;;; psgml-ids.el ends here diff --git a/psgml-info.el b/psgml-info.el index 6e160a7..524c7d7 100644 --- a/psgml-info.el +++ b/psgml-info.el @@ -1,14 +1,12 @@ -;;;; psgml-info.el -;;; Last edited: 2000-11-09 19:23:50 lenst -;;; $Id: psgml-info.el,v 2.18 2005/05/19 19:06:47 lenst Exp $ +;;; psgml-info.el --- ??? -*- lexical-binding:t -*- -;; Copyright (C) 1994, 1995 Lennart Staflin +;; Copyright (C) 1994, 1995, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; 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 +;; 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, @@ -17,11 +15,11 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + -;;;; Commentary: +;;; Commentary: ;; This file is an addon to the PSGML package. @@ -44,15 +42,14 @@ ;; Will list all element types and the element types that can occur ;; in its content. -;;;; Code: +;;; Code: -(provide 'psgml-info) (require 'psgml) (require 'psgml-parse) (defconst sgml-attr-col 18) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;;;; Utility functions @@ -116,15 +113,15 @@ (while agenda (cond ((sgml-normal-state-p (car agenda)) - (loop for m in (append (sgml-state-opts (car agenda)) + (cl-loop for m in (append (sgml-state-opts (car agenda)) (sgml-state-reqs (car agenda))) do - (pushnew (sgml-move-token m) res :test #'equal) + (cl-pushnew (sgml-move-token m) res :test #'equal) (sgml-add-last-unique (sgml-move-dest m) states))) (t ; &-node (sgml-add-last-unique (sgml-and-node-next (car agenda)) states) - (loop for dfa in (sgml-and-node-dfas (car agenda)) do + (cl-loop for dfa in (sgml-and-node-dfas (car agenda)) do (sgml-add-last-unique dfa states)))) (setq agenda (cdr agenda))) (setq res @@ -166,7 +163,7 @@ (sgml-map-element-types (function (lambda (eltype) - (loop for a in (sgml-eltype-attlist eltype) do + (cl-loop for a in (sgml-eltype-attlist eltype) do (setq attributes (sgml-add-to-table (sgml-attdecl-name a) (sgml-eltype-name eltype) @@ -227,7 +224,7 @@ (sgml-map-element-types (function (lambda (eltype) - (loop for ref in (sgml-eltype-refrenced-elements eltype) + (cl-loop for ref in (sgml-eltype-refrenced-elements eltype) do (setq cross (sgml-add-to-table ref (sgml-eltype-name eltype) cross)))))) @@ -351,17 +348,17 @@ (defun sgml-princ-names (names &optional first sep) (setq sep (or sep " ")) - (loop with col = 0 + (cl-loop with col = 0 for name in names for this-sep = (if first (prog1 first (setq first nil)) sep) do (princ this-sep) - (incf col (length this-sep)) + (cl-incf col (length this-sep)) (when (and (> col 0) (> (+ col (length name)) fill-column)) (princ "\n ") (setq col 1)) (princ name) - (incf col (length name)))) + (cl-incf col (length name)))) (define-button-type 'sgml-eltype 'action (lambda (button) @@ -373,13 +370,13 @@ (let ((orig-buffer (current-buffer))) (with-current-buffer standard-output (setq sep (or sep " ")) - (loop with col = 0 + (cl-loop with col = 0 for et in eltypes for name = (sgml-eltype-name et) for this-sep = (if first (prog1 first (setq first nil)) sep) do (insert this-sep) - (incf col (length this-sep)) + (cl-incf col (length this-sep)) (when (and (> col 0) (> (+ col (length name)) fill-column)) (insert "\n ") (setq col 1)) @@ -388,7 +385,7 @@ (insert-text-button name :type 'sgml-eltype 'name name 'buffer orig-buffer 'follow-link t)) - (incf col (length name)))))) + (cl-incf col (length name)))))) (defun sgml-describe-element-type (et-name) @@ -424,16 +421,16 @@ (if (sgml-eltype-etag-optional et) "optional" "required"))) (princ "\nATTRIBUTES:\n") - (loop for attdecl in (sgml-eltype-attlist et) do + (cl-loop for attdecl in (sgml-eltype-attlist et) do (let ((name (sgml-attdecl-name attdecl)) (dval (sgml-attdecl-declared-value attdecl)) (defl (sgml-attdecl-default-value attdecl))) (when (listp dval) - (setq dval (concat (if (eq (first dval) + (setq dval (concat (if (eq (car dval) 'NOTATION) "#NOTATION (" "(") (mapconcat (function identity) - (second dval) + (cadr dval) "|") ")"))) (cond ((sgml-default-value-type-p 'FIXED defl) @@ -495,11 +492,11 @@ (fmt "%20s %s\n") (hdr "")) - (sgml-map-eltypes (function (lambda (_e) (incf elements))) + (sgml-map-eltypes (function (lambda (_e) (cl-incf elements))) sgml-dtd-info) - (sgml-map-entities (function (lambda (_e) (incf entities))) + (sgml-map-entities (function (lambda (_e) (cl-incf entities))) (sgml-dtd-entities sgml-dtd-info)) - (sgml-map-entities (function (lambda (_e) (incf parameters))) + (sgml-map-entities (function (lambda (_e) (cl-incf parameters))) (sgml-dtd-parameters sgml-dtd-info)) (with-output-to-temp-buffer (help-buffer) @@ -535,4 +532,5 @@ (defalias 'sgml-general-dtd-info 'sgml-describe-dtd) +(provide 'psgml-info) ;;; psgml-info.el ends here diff --git a/psgml-lucid.el b/psgml-lucid.el index b1b3f8e..76b5f4d 100644 --- a/psgml-lucid.el +++ b/psgml-lucid.el @@ -1,15 +1,13 @@ -;;;; psgml-lucid.el --- Part of SGML-editing mode with parsing support -;; $Id: psgml-lucid.el,v 2.8 2008/06/21 16:13:51 lenst Exp $ +;;; psgml-lucid.el --- Part of SGML-editing mode with parsing support -;; Copyright (C) 1994 Lennart Staflin +;; Copyright (C) 1994, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; William M. Perry <wmpe...@indiana.edu> -;; ;; 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 +;; 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, @@ -18,18 +16,17 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;;; Commentary: +;;; Commentary: -;;; Part of psgml.el +;; Part of psgml.el -;;; Menus for use with Lucid Emacs +;; Menus for use with Lucid Emacs -;;;; Code: +;;; Code: (require 'psgml) ;;(require 'easymenu) @@ -44,7 +41,7 @@ into several panes.") ;;;; Pop Up Menus -(defun sgml-popup-menu (event title entries) +(defun sgml-popup-menu (_event title entries) "Display a popup menu." (setq entries (loop for ent in entries collect @@ -96,7 +93,7 @@ into several panes.") (message "please make a choice from the menu.")))) value)) -(defun sgml-popup-multi-menu (pos title menudesc) +(defun sgml-popup-multi-menu (_pos title menudesc) "Display a popup menu. MENUS is a list of menus on the form (TITLE ITEM1 ITEM2 ...). ITEM should have to form (STRING EXPR) or STRING. The EXPR gets evaluated @@ -158,7 +155,6 @@ if the item is selected." ;;;; Key definitions -(define-key sgml-mode-map [button3] 'sgml-tags-menu) ;;;; Insert with properties diff --git a/psgml-maint.el b/psgml-maint.el index 89825c9..1775c30 100644 --- a/psgml-maint.el +++ b/psgml-maint.el @@ -1,26 +1,24 @@ -;;; psgml-maint.el --- Help functions to maintain PSGML source +;;; psgml-maint.el --- Help functions to maintain PSGML source -*- lexical-binding:t -*- -;; Copyright (C) 1996 Lennart Staflin +;; Copyright (C) 1996 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; Version: $Id: psgml-maint.el,v 1.8 2005/02/09 15:28:58 lenst Exp $ ;; Keywords: -;;; 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. -;;; -;;; A copy of the GNU General Public License can be obtained from this -;;; program's author (send electronic mail to le...@lysator.liu.se) or from -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. -;;; +;; 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, 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/>. +;; ;;; Commentary: @@ -39,7 +37,7 @@ (defconst psgml-common-files '("psgml.el" "psgml-parse.el" "psgml-edit.el" "psgml-dtd.el" - "psgml-info.el" "psgml-charent.el" "psgml-api.el" "psgml-sysdep.el" + "psgml-info.el" "psgml-charent.el" "psgml-api.el" "psgml-ids.el")) (defconst psgml-emacs-files '("psgml-other.el")) diff --git a/psgml-nofill.el b/psgml-nofill.el index 2363712..bf9db63 100644 --- a/psgml-nofill.el +++ b/psgml-nofill.el @@ -1,10 +1,28 @@ +;;; psgml-nofill.el --- ??? -*- lexical-binding:t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; 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/>. + (require 'psgml-parse) (require 'psgml-edit) +(eval-when-compile (require 'cl-lib)) ;; psgml-parse.el (defun sgml-parse-set-appflag (flagsym) - (loop for name = (sgml-parse-name) + (cl-loop for name = (sgml-parse-name) while name for et = (sgml-lookup-eltype name) for flag-value = t diff --git a/psgml-other.el b/psgml-other.el index 8eaa25f..4ea9d65 100644 --- a/psgml-other.el +++ b/psgml-other.el @@ -1,14 +1,12 @@ -;;;; psgml-other.el --- Part of SGML-editing mode with parsing support -;; $Id: psgml-other.el,v 2.26 2005/05/19 19:42:48 lenst Exp $ +;;; psgml-other.el --- Part of SGML-editing mode with parsing support -*- lexical-binding:t -*- -;; Copyright (C) 1994 Lennart Staflin +;; Copyright (C) 1994, 2016 Free Software Foundation, Inc ;; Author: Lennart Staflin <le...@lysator.liu.se> -;; ;; 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 +;; 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, @@ -17,21 +15,19 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;;; Commentary: +;;; Commentary: -;;; Part of psgml.el. Code not compatible with XEmacs. +;; Part of psgml.el. Code not compatible with XEmacs. -;;;; Code: +;;; Code: (require 'psgml) -(require 'psgml-parse) (require 'easymenu) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (defvar sgml-max-menu-size (/ (* (frame-height) 2) 3) "*Max number of entries in Tags and Entities menus before they are split @@ -41,10 +37,6 @@ into several panes.") ;;;; Key Commands ;; Doesn't this work in Lucid? *** -(define-key sgml-mode-map [?\M-\C-\ ] 'sgml-mark-element) - -;;(define-key sgml-mode-map [S-mouse-3] 'sgml-tags-menu) -(define-key sgml-mode-map [S-mouse-3] 'sgml-right-menu) ;;;; Pop Up Menus @@ -64,12 +56,12 @@ STRING." (defun sgml-split-long-menus (menus) - (loop + (cl-loop for (title . entries) in menus nconc (cond ((> (length entries) sgml-max-menu-size) - (loop for i from 1 while entries + (cl-loop for i from 1 while entries collect (let ((submenu (copy-sequence entries))) (setcdr (nthcdr (1- (min (length entries) sgml-max-menu-size)) @@ -119,29 +111,8 @@ if the item is selected." "Non-nil means use text properties for highlighting, not overlays. Overlays are significantly less efficient in large buffers.") -(eval-and-compile - (if (boundp 'inhibit-modification-hooks) ; Emacs 21 - (defmacro sgml-with-modification-state (&rest body) - `(let ((modified (buffer-modified-p)) - (inhibit-read-only t) - (inhibit-modification-hooks t) - (buffer-undo-list t) - (deactivate-mark nil)) - ,@body - (when (not modified) - (sgml-restore-buffer-modified-p nil)))) - (defmacro sgml-with-modification-state (&rest body) - `(let ((modified (buffer-modified-p)) - (inhibit-read-only t) - (after-change-functions nil) - (before-change-functions nil) - (buffer-undo-list t) - (deactivate-mark nil)) - ,@body - (when (not modified) - (sgml-restore-buffer-modified-p nil)))))) - -(defvar sgml-parse-in-loop) +(defvar sgml-current-tree) +(declare-function sgml-element-appdata "psgml-parse" (element prop)) (defun sgml-set-face-for (start end type) (let ((face (cdr (assq type sgml-markup-faces)))) @@ -149,13 +120,15 @@ Overlays are significantly less efficient in large buffers.") (setq face (sgml-element-appdata sgml-current-tree 'face))) (cond (sgml-use-text-properties - ;; `sgml-with-modification-state' is rather expensive. If we're - ;; in the parsing loop, hoist the job out of the loop. - (if (not sgml-parse-in-loop) - (sgml-with-modification-state - (put-text-property start end 'face face) - (when (and sgml-default-nonsticky (< start end)) - (put-text-property (1- end) end 'rear-nonsticky '(face)))) + ;; `with-silent-modifications' is rather expensive. + ;; Skip it if we're already within it. + ;; FIXME: A better fix would be to make sure all callers use + ;; with-silent-modifications. + (if (not inhibit-modification-hooks) + (with-silent-modifications + (put-text-property start end 'face face) + (when (and sgml-default-nonsticky (< start end)) + (put-text-property (1- end) end 'rear-nonsticky '(face)))) (put-text-property start end 'face face) (when (and sgml-default-nonsticky (< start end)) (put-text-property (1- end) end 'rear-nonsticky '(face))))) @@ -192,8 +165,9 @@ Overlays are significantly less efficient in large buffers.") ;; If inserting in front of an markup overlay, move that overlay. ;; this avoids the overlay beeing deleted and recreated by ;; sgml-set-face-for. + ;; FIXME: Use overlay's start insertion type instead! (when (and sgml-set-face (not sgml-use-text-properties)) - (loop for o in (overlays-at start) + (cl-loop for o in (overlays-at start) do (cond ((not (overlay-get o 'sgml-type))) ((= start (overlay-start o)) @@ -212,12 +186,6 @@ Overlays are significantly less efficient in large buffers.") (delete-overlay o)))) -;;;; Emacs before 19.29 - -(unless (fboundp 'buffer-substring-no-properties) - (defalias 'buffer-substring-no-properties 'buffer-substring)) - - ;;;; Provide (provide 'psgml-other) diff --git a/psgml-parse.el b/psgml-parse.el index fcbaf49..156678a 100644 --- a/psgml-parse.el +++ b/psgml-parse.el @@ -1,7 +1,7 @@ -;;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support +;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support -*- lexical-binding:t -*- ;; $Id: psgml-parse.el,v 2.105 2008/06/21 16:13:51 lenst Exp $ -;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Lennart Staflin +;; Copyright (C) 1994-1998, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; Acknowledgment: @@ -10,7 +10,7 @@ ;; 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 +;; 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, @@ -19,20 +19,19 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;;;; Commentary: +;;; Commentary: ;; Part of major mode for editing the SGML document-markup language. -;;;; Code: +;;; Code: (require 'psgml) -(require 'psgml-sysdep) -(require 'psgml-ids) ; just for sgml-add-id +(require (if (featurep 'xemacs) 'psgml-lucid 'psgml-other)) +(autoload 'sgml-add-id "psgml-ids") ;;; Interface to psgml-dtd @@ -41,7 +40,7 @@ (autoload 'sgml-write-dtd "psgml-dtd") (autoload 'sgml-check-dtd-subset "psgml-dtd") ) -(eval-when-compile (require 'cl)) +(require 'cl-lib) ;;;; Advise to do-auto-fill @@ -264,6 +263,7 @@ If this is nil, then current entity is main buffer.") "The global value of this variable is the first scratch buffer for entities. The entity buffers can have a buffer local value for this variable to point to the next scratch buffer.") +(put 'sgml-scratch-buffer 'permanent-local t) (defvar sgml-last-entity-buffer nil) @@ -295,64 +295,51 @@ Applicable to XML.") ;;;; Build parser syntax table -(setq sgml-parser-syntax (make-syntax-table)) +(defconst sgml-parser-syntax + (let ((st (make-syntax-table))) + (dotimes (i 256) ;FIXME: Why 256 here and 128 for xml? + (modify-syntax-entry i " " st)) -(let ((i 0)) - (while (< i 256) - (modify-syntax-entry i " " sgml-parser-syntax) - (setq i (1+ i)))) - -;;http://list-archive.xemacs.org/xemacs-beta/200011/msg00117.html -(mapconcat (function (lambda (c) - (modify-syntax-entry c "w" sgml-parser-syntax))) - ":ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrtsuvwxyz" "") -(mapconcat (function (lambda (c) - (modify-syntax-entry c "_" sgml-parser-syntax))) - "-.0123456789" "") - - -;;(progn (set-syntax-table sgml-parser-syntax) (describe-syntax)) + ;;http://list-archive.xemacs.org/xemacs-beta/200011/msg00117.html + (mapc (lambda (c) (modify-syntax-entry c "w" st)) + ":ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrtsuvwxyz") + (mapc (lambda (c) (modify-syntax-entry c "_" st)) + "-.0123456789") + st)) (defconst xml-parser-syntax (let ((tab (make-syntax-table))) - (let ((i 0)) - (while (< i 128) - (modify-syntax-entry i " " tab) - (setq i (1+ i)))) - (mapconcat (function (lambda (c) - (modify-syntax-entry c "w" tab))) - "_:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrtsuvwxyz" "") - (mapconcat (function (lambda (c) - (modify-syntax-entry c "_" tab))) - ;; Fixme: what's the non-ASCII character doing here? -- fx - "-.0123456789�" "") + (dotimes (i 128) ;FIXME: Why 128 here and 256 for sgml? + (modify-syntax-entry i " " tab)) + (mapc (lambda (c) (modify-syntax-entry c "w" tab)) + "_:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrtsuvwxyz") + (mapc (lambda (c) (modify-syntax-entry c "_" tab)) + ;; Fixme: what's the non-ASCII character doing here? -- fx + "-.0123456789·") tab)) -;;(progn (set-syntax-table xml-parser-syntax) (describe-syntax)) - (defmacro sgml-with-parser-syntax (&rest body) - `(let ((normal-syntax-table (syntax-table)) - (cb (current-buffer))) - (set-syntax-table (if sgml-xml-p xml-parser-syntax sgml-parser-syntax)) - (unwind-protect - (progn ,@body) - (setq sgml-last-buffer (current-buffer)) - (set-buffer cb) - (set-syntax-table normal-syntax-table)))) + (declare (debug t)) + `(let ((cb (current-buffer))) + (with-syntax-table (if sgml-xml-p xml-parser-syntax sgml-parser-syntax) + (unwind-protect + (progn ,@body) + (setq sgml-last-buffer (current-buffer)) + (set-buffer cb))))) (defmacro sgml-with-parser-syntax-ro (&rest body) + (declare (debug t)) ;; Should only be used for parsing .... - `(let ((normal-syntax-table (syntax-table)) - (cb (current-buffer)) + ;; FIXME: Use `with-silent-modifications'? + `(let ((cb (current-buffer)) (buffer-modified (buffer-modified-p))) - (set-syntax-table (if sgml-xml-p xml-parser-syntax sgml-parser-syntax)) - (unwind-protect - (progn ,@body) - (setq sgml-last-buffer (current-buffer)) - (set-buffer cb) - (set-syntax-table normal-syntax-table) - (sgml-restore-buffer-modified-p buffer-modified) - (sgml-debug "Restoring buffer mod: %s" buffer-modified)))) + (with-syntax-table (if sgml-xml-p xml-parser-syntax sgml-parser-syntax) + (unwind-protect + (progn ,@body) + (setq sgml-last-buffer (current-buffer)) + (set-buffer cb) + (unless buffer-modified (restore-buffer-modified-p buffer-modified)) + (sgml-debug "Restoring buffer mod: %s" buffer-modified))))) (defvar mc-flag) @@ -522,7 +509,7 @@ Applicable to XML.") (defun sgml-final-and (state) (and (sgml-final (sgml-and-state-substate state)) - (loop for s in (sgml-and-state-dfas state) + (cl-loop for s in (sgml-and-state-dfas state) always (sgml-state-final-p s)) (sgml-state-final-p (sgml-and-state-next state)))) @@ -580,7 +567,7 @@ If this is not possible, but all DFAS are final, move by TOKEN in NEXT." (if (sgml-normal-state-p state) (sgml-tokens-of-moves (sgml-state-reqs state)) (or (sgml-required-tokens (sgml-and-state-substate state)) - (loop for s in (sgml-and-state-dfas state) + (cl-loop for s in (sgml-and-state-dfas state) nconc (sgml-tokens-of-moves (sgml-state-reqs s))) (sgml-tokens-of-moves (sgml-state-reqs (sgml-and-state-next state)))))) @@ -590,9 +577,9 @@ If this is not possible, but all DFAS are final, move by TOKEN in NEXT." (nconc (sgml-optional-tokens (sgml-and-state-substate state)) (if (sgml-final (sgml-and-state-substate state)) - (loop for s in (sgml-and-state-dfas state) + (cl-loop for s in (sgml-and-state-dfas state) nconc (sgml-tokens-of-moves (sgml-state-opts s)))) - (if (loop for s in (sgml-and-state-dfas state) + (if (cl-loop for s in (sgml-and-state-dfas state) always (sgml-state-final-p s)) (sgml-tokens-of-moves (sgml-state-opts (sgml-and-state-next state))))))) @@ -852,7 +839,7 @@ If ATTSPEC is nil, nil is returned." ;; dependencies = file* ;; merged = Compiled-DTD? where Compiled-DTD = (file, DTD) -(defstruct (sgml-dtd +(cl-defstruct (sgml-dtd (:type vector) (:constructor sgml-make-dtd (doctype))) doctype ; STRING, name of doctype @@ -902,7 +889,7 @@ If ATTSPEC is nil, nil is returned." (defmacro sgml-prop-fields (&rest names) (cons 'progn - (loop for n in names collect + (cl-loop for n in names collect `(defmacro ,(intern (format "sgml-eltype-%s" n)) (et) (list 'get et '',n))))) @@ -922,29 +909,23 @@ If ATTSPEC is nil, nil is returned." `(symbol-value ,et)) (defun sgml-eltype-model (et) + (declare (gv-setter fset)) (if (fboundp et) (symbol-function et) sgml-any)) -(defsetf sgml-eltype-model fset) - - (defun sgml-eltype-stag-optional (et) + (declare (gv-setter (lambda (f) (list 'sgml-set-eltype-flag et 1 f)))) (= 1 (logand (sgml-eltype-flags et) 1))) (defun sgml-eltype-etag-optional (et) + (declare (gv-setter (lambda (f) (list 'sgml-set-eltype-flag et 2 f)))) (/= 0 (logand 2 (sgml-eltype-flags et)))) (defsubst sgml-eltype-mixed (et) + (declare (gv-setter (lambda (f) (list 'sgml-set-eltype-flag et 4 f)))) (< 3 (sgml-eltype-flags et))) -(defsetf sgml-eltype-stag-optional (et) (f) - (list 'sgml-set-eltype-flag et 1 f)) -(defsetf sgml-eltype-etag-optional (et) (f) - (list 'sgml-set-eltype-flag et 2 f)) -(defsetf sgml-eltype-mixed (et) (f) - (list 'sgml-set-eltype-flag et 4 f)) - (defun sgml-set-eltype-flag (et mask f) (setf (sgml-eltype-flags et) (logior (logand (if (boundp et) @@ -956,10 +937,12 @@ If ATTSPEC is nil, nil is returned." (defun sgml-maybe-put (sym prop val) (when val (put sym prop val))) -(defsetf sgml-eltype-includes (et) (l) +;; FIXME: These are somewhat redundant, since setf will automatically +;; use `put' for those by default anyway. +(gv-define-setter sgml-eltype-includes (l et) (list 'sgml-maybe-put et ''includes l)) -(defsetf sgml-eltype-excludes (et) (l) +(gv-define-setter sgml-eltype-excludes (l et) (list 'sgml-maybe-put et ''excludes l)) (defmacro sgml-eltype-appdata (et prop) @@ -969,7 +952,7 @@ includes, excludes, conref-regexp, mixed, stag-optional, etag-optional." `(get ,et ,prop)) (defun sgml-eltype-all-miscdata (et) - (loop for p on (symbol-plist et) by (function cddr) + (cl-loop for p on (symbol-plist et) by (function cddr) unless (memq (car p) '(model flags includes excludes)) nconc (list (car p) (cadr p)))) @@ -990,7 +973,7 @@ includes, excludes, conref-regexp, mixed, stag-optional, etag-optional." (make-vector 73 0)) (defun sgml-eltype-table-empty (eltype-table) - (loop for x across eltype-table always (eq x 0))) + (cl-loop for x across eltype-table always (eq x 0))) (defun sgml-merge-eltypes (eltypes1 eltypes2) "Return the merge of two element type tables ELTYPES1 and ELTYPES2. @@ -1018,7 +1001,7 @@ This may change ELTYPES1, ELTYPES2 is unchanged. Returns the new table." (defun sgml-eltype-completion-table (eltypes) "Make a completion table from a list, ELTYPES, of element types." - (loop for et in eltypes as name = (sgml-eltype-name et) + (cl-loop for et in eltypes as name = (sgml-eltype-name et) if (boundp et) collect (cons name name))) @@ -1097,20 +1080,20 @@ or 2: two octets (n,m) interpreted as (n-t-1)*256+m+t." (aref sgml-read-nodes (sgml-read-octet))) (defun sgml-read-model-seq () - (loop repeat (sgml-read-number) collect (sgml-read-model))) + (cl-loop repeat (sgml-read-number) collect (sgml-read-model))) (defun sgml-read-token-seq () - (loop repeat (sgml-read-number) collect (sgml-read-token))) + (cl-loop repeat (sgml-read-number) collect (sgml-read-token))) (defun sgml-read-moves () - (loop repeat (sgml-read-number) + (cl-loop repeat (sgml-read-number) collect (sgml-make-move (sgml-read-token) (sgml-read-node-ref)))) (defun sgml-read-model () (let* ((n (sgml-read-number)) (sgml-read-nodes (make-vector n nil))) - (loop for i below n do (aset sgml-read-nodes i (sgml-make-state))) - (loop for e across sgml-read-nodes do + (cl-loop for i below n do (aset sgml-read-nodes i (sgml-make-state))) + (cl-loop for e across sgml-read-nodes do (cond ((eq 255 (sgml-read-peek)) ; a and-node (sgml-read-octet) ; skip (setf (sgml-and-node-next e) (sgml-read-node-ref)) @@ -1202,14 +1185,14 @@ or 2: two octets (n,m) interpreted as (n-t-1)*256+m+t." (setq sgml-loaded-dtd real-file)))) ;;;; Binary coded DTD module -;;; Works on the binary coded compiled DTD (bdtd) +;; Works on the binary coded compiled DTD (bdtd) -;;; bdtd-load: cfile dtdfile ents -> bdtd -;;; bdtd-merge: bdtd dtd -> dtd? -;;; bdtd-read-dtd: bdtd -> dtd +;; bdtd-load: cfile dtdfile ents -> bdtd +;; bdtd-merge: bdtd dtd -> dtd? +;; bdtd-read-dtd: bdtd -> dtd -;;; Implement by letting bdtd be implicitly the current buffer and -;;; dtd implicit in sgml-dtd-info. +;; Implement by letting bdtd be implicitly the current buffer and +;; dtd implicit in sgml-dtd-info. (defun sgml-bdtd-load (cfile dtdfile ents) "Load the compiled dtd from CFILE into the current buffer. @@ -1237,7 +1220,7 @@ settings in ENTS." If DEPENDENCIES contains the symbol t, FILE is not considered newer." (if (memq t dependencies) nil - (loop for f in dependencies + (cl-loop for f in dependencies always (file-newer-than-file-p file f)))) (defun sgml-compile-dtd (dtd-file to-file ents) @@ -1251,7 +1234,7 @@ buffer is assumed to be empty to start with." (sgml-parsing-dtd t)) (push dtd-file (sgml-dtd-dependencies sgml-dtd-info)) - (loop for (name . val) in ents + (cl-loop for (name . val) in ents do (sgml-entity-declare name parameters 'text val)) (sgml-push-to-entity dtd-file) (sgml-check-dtd-subset) @@ -1263,7 +1246,7 @@ buffer is assumed to be empty to start with." (defun sgml-check-entities (params1 params2) "Check that PARAMS1 is compatible with PARAMS2." - (block check-entities + (cl-block check-entities (sgml-map-entities (function (lambda (entity) (let ((other @@ -1277,7 +1260,7 @@ buffer is assumed to be empty to start with." (sgml-entity-name entity) (sgml-entity-text other) (sgml-entity-text entity)) - (return-from check-entities nil))))) + (cl-return-from check-entities nil))))) params1) t)) @@ -1311,11 +1294,11 @@ was successful or nil if failed." (setq temp (sgml-read-number)) ; # eltypes (setq sgml-read-token-vector (make-vector (1+ temp) nil)) (aset sgml-read-token-vector 0 sgml-pcdata-token) - (loop for i from 1 to temp do + (cl-loop for i from 1 to temp do (aset sgml-read-token-vector i (sgml-lookup-eltype (sgml-read-sexp)))) ;; Element type descriptions - (loop for i from 1 to (sgml-read-number) do + (cl-loop for i from 1 to (sgml-read-number) do (sgml-read-element (aref sgml-read-token-vector i))) (sgml-merge-entity-tables (sgml-dtd-entities sgml-dtd-info) (sgml-read-sexp)) @@ -1417,11 +1400,12 @@ CONTEXT. Applicable values for CONTEXT is `digit' -- any Digit, string -- delimiter with that name, list -- any of the contextual constraints in the list." + (declare (debug (sexp &optional sexp sexp sexp))) (or offset (setq offset 0)) (setq delim (upcase (format "%s" delim))) (let ((ds (sgml-get-delim-string delim))) - (assert ds) + (cl-assert ds) (cond ((eq context 'gi) (setq context '(nmstart stagc))) ((eq context 'com) @@ -1432,11 +1416,11 @@ list -- any of the contextual constraints in the list." (setq context (list context)))) `(if (and ; This and checks that characters ; of the delimiter - ,@(loop for i from 0 below (length ds) collect + ,@(cl-loop for i from 0 below (length ds) collect `(eq ,(aref ds i) (sgml-following-char ,(+ i offset)))) (or - ,@(loop + ,@(cl-loop for c in context collect ; context check (cond ((eq c 'nmstart) ; name start character @@ -1470,9 +1454,11 @@ list -- any of the contextual constraints in the list." delim (sgml-get-delim-string delim))) (defmacro sgml-parse-delim (delim &optional context) + (declare (debug (sexp &optional sexp))) `(sgml-is-delim ,delim ,context move)) (defmacro sgml-check-delim (delim &optional context) + (declare (debug (sexp sexp))) `(sgml-is-delim ,delim ,context check)) (defmacro sgml-skip-upto (delim) @@ -1481,14 +1467,15 @@ If DELIM is a string/symbol this is should be a delimiter role. Characters are skipped until the delimiter is recognized. If DELIM is a list of delimiters, skip until a character that is first in any of them." + (declare (debug (sexp))) (cond ((consp delim) (list 'skip-chars-forward (concat "^" - (loop for d in delim + (cl-loop for d in delim concat (let ((ds (member (upcase (format "%s" d)) sgml-delimiters))) - (assert ds) + (cl-assert ds) (let ((s (substring (cadr ds) 0 1))) (if (member s '("-" "\\")) (concat "\\" s) @@ -1507,12 +1494,12 @@ in any of them." ;;;; General lexical functions -;;; Naming conventions -;;; sgml-parse-xx try to parse xx, return nil if can't else return -;;; some propriate non-nil value. -;;; Except: for name/nametoken parsing, return 0 if can't. -;;; sgml-check-xx require xx, report error if can't parse. Return -;;; aproporiate value. +;; Naming conventions +;; sgml-parse-xx try to parse xx, return nil if can't else return +;; some propriate non-nil value. +;; Except: for name/nametoken parsing, return 0 if can't. +;; sgml-check-xx require xx, report error if can't parse. Return +;; aproporiate value. (defmacro sgml-parse-char (char) `(cond ((eq ,char (following-char)) @@ -1584,7 +1571,7 @@ in any of them." string)) (defun sgml-parse-set-appflag (flagsym) - (loop for name = (sgml-parse-name) + (cl-loop for name = (sgml-parse-name) while name for et = (sgml-lookup-eltype name) do (setf (sgml-eltype-appdata et flagsym) t) @@ -1660,22 +1647,35 @@ in any of them." ;;[lenst/1998-03-09 19:52:08] Perhaps not the right place (defun sgml-general-insert-case (text) (if sgml-namecase-general - (case sgml-general-insert-case - (upper (upcase text)) - (lower (downcase text)) - (t text)) + (pcase sgml-general-insert-case + (`upper (upcase text)) + (`lower (downcase text)) + (_ text)) text)) (defun sgml-entity-insert-case (text) (if sgml-namecase-entity - (case sgml-entity-insert-case - (upper (upcase text)) - (lower (downcase text)) - (t text)) + (pcase sgml-entity-insert-case + (`upper (upcase text)) + (`lower (downcase text)) + (_ text)) text)) (defun sgml-parse-name (&optional entity-name) + (declare + (compiler-macro + (lambda (form) + (cond + ((memq entity-name '(nil t)) + `(if (sgml-startnm-char-next) + (,(if entity-name 'sgml-entity-case 'sgml-general-case) + (buffer-substring-no-properties (point) + (progn (skip-syntax-forward "w_") + (point)))))) + (t + form))))) + (if (sgml-startnm-char-next) (let ((name (buffer-substring-no-properties (point) @@ -1685,16 +1685,6 @@ in any of them." (sgml-entity-case name) (sgml-general-case name))))) -(define-compiler-macro sgml-parse-name (&whole form &optional entity-name) - (cond - ((memq entity-name '(nil t)) - `(if (sgml-startnm-char-next) - (,(if entity-name 'sgml-entity-case 'sgml-general-case) - (buffer-substring-no-properties (point) - (progn (skip-syntax-forward "w_") - (point)))))) - (t - form))) (defsubst sgml-check-name (&optional entity-name) @@ -1927,7 +1917,7 @@ is not already in upper case." ;;;; Entity Manager -(defstruct (sgml-entity +(cl-defstruct (sgml-entity (:type list) (:constructor sgml-make-entity (name type text &optional notation))) name ; Name of entity (string) @@ -1942,13 +1932,12 @@ is not already in upper case." (not (eq (sgml-entity-type entity) 'text))) (defun sgml-entity-marked-undefined-p (entity) + (declare (gv-setter (lambda (val) + ;; `(setf (nthcdr 4 ,entity) ,val) + `(progn (setcdr (nthcdr 3 ,entity) ,val) + ,entity)))) (nthcdr 4 entity)) -(defsetf sgml-entity-marked-undefined-p (entity) (val) - ;; `(setf (nthcdr 4 ,entity) ,val) - `(progn (setcdr (nthcdr 3 ,entity) ,val) - ,entity)) - ;;; Entity tables @@ -1986,7 +1975,7 @@ If NAME is nil, this defines the default entity." (defun sgml-map-entities (fn entity-table &optional collect) (if collect (mapcar fn (cdr entity-table)) - (loop for e in (cdr entity-table) do (funcall fn e)))) + (cl-loop for e in (cdr entity-table) do (funcall fn e)))) (defun sgml-merge-entity-tables (tab1 tab2) "Merge entity table TAB2 into TAB1. TAB1 is modified." @@ -2021,7 +2010,7 @@ representation of the catalog." (file-readable-p file) (let ((c (assoc file (symbol-value cache-var))) (modtime (elt (file-attributes (file-truename file)) 5))) - (if (and c (equal (second c) modtime)) + (if (and c (equal (cadr c) modtime)) (cddr c) (when c (set cache-var (delq c (symbol-value cache-var)))) (let (new) @@ -2073,20 +2062,20 @@ catalogs to use." (sgml-main-directory)) (if (null cat) "empty/non existent" "exists")) (when sysid ; SYSTEM has first call - (loop for (key cname cfile) in cat while (not file) do + (cl-loop for (key cname cfile) in cat while (not file) do (when (and (eq 'system key) (string= sysid cname)) (sgml-trace-lookup " >> %s [by system]" cfile) (setq file cfile)))) (when pubid ;; Giv PUBLIC entries priority over ENTITY and DOCTYPE - (loop for (key cname cfile) in cat while (not file) do + (cl-loop for (key cname cfile) in cat while (not file) do (when (and (or override (not sysid)) (eq 'public key) (string= pubid cname)) (when (file-readable-p cfile) (setq file cfile)) (sgml-trace-lookup " >> %s [by pubid]%s" cfile (if file "" " !unreadable"))) (when (eq key 'override) (setq override cname)))) - (loop for (key cname cfile) in cat while (not file) do + (cl-loop for (key cname cfile) in cat while (not file) do (when (eq 'catalog key) (push cfile additional)) (when (and (or override (not sysid)) (eq type key) @@ -2115,7 +2104,7 @@ catalogs to use." ((eq type 'param) "parm") (t "sgml")))))) (sgml-debug "Ext. file subst. = %S" subst) - (loop for cand in sgml-public-map + (cl-loop for cand in sgml-public-map thereis (and (setq cand (sgml-subst-expand cand subst)) (file-readable-p @@ -2154,7 +2143,7 @@ Returns nil if entity is not found." (let* ((pubid (sgml-extid-pubid extid)) (sysid (sgml-extid-sysid extid))) (or (if sysid - (loop for fn in sgml-sysid-resolve-functions + (cl-loop for fn in sgml-sysid-resolve-functions thereis (funcall fn sysid))) (let ((file (sgml-external-file extid type name))) (and file (insert-file-contents file))) @@ -2178,7 +2167,7 @@ Returns nil if entity is not found." "Parse all entries in a catalogue." (let ((sgml-xml-p nil)) (sgml-trace-lookup " (Parsing catalog)") - (loop + (cl-loop while (sgml-skip-cs) for type = (downcase (sgml-check-cat-literal)) for class = (cdr (assoc type '(("public" . public) ("dtddecl" . public) @@ -2272,11 +2261,11 @@ Skips any leading spaces/comments." (cdr-safe (assq (downcase c) parts))) (defun sgml-subst-expand (s parts) - (loop for i from 0 to (1- (length s)) + (cl-loop for i from 0 to (1- (length s)) as c = (aref s i) concat (if (eq c ?%) - (or (sgml-subst-expand-char (aref s (incf i)) parts) - (return nil)) + (or (sgml-subst-expand-char (aref s (cl-incf i)) parts) + (cl-return nil)) (char-to-string (aref s i))))) (defun sgml-matched-string (string n &optional regexp noerror) @@ -2303,15 +2292,13 @@ Skips any leading spaces/comments." (sgml-external-file nil 'sgmldecl))) (defun sgml-in-file-eval (file expr) - (let ((cb (current-buffer))) - (set-buffer (find-file-noselect file)) - (prog1 (eval expr) - (set-buffer cb)))) + (with-current-buffer (find-file-noselect file) + (eval expr))) ;;;; Entity references and positions -(defstruct (sgml-eref +(cl-defstruct (sgml-eref (:constructor sgml-make-eref (entity start end)) (:type list)) entity @@ -2430,16 +2417,16 @@ text. Otherwise buffer position will be after entity reference." (defun sgml-ecat-lookup (files pubid file) "Return (file . ents) or nil." (let ((params (sgml-dtd-parameters sgml-dtd-info))) - (loop + (cl-loop for f in files do (sgml-debug "Search ECAT %s" f) thereis - (loop + (cl-loop for (type name cfile . ents) in (sgml-load-ecat f) thereis (if (and (cond ((eq type 'public) (equal name pubid)) ((eq type 'file) (equal name file))) - (loop for (name . val) in ents + (cl-loop for (name . val) in ents for entity = (sgml-lookup-entity name params) always (and entity (equal val (sgml-entity-text entity))))) @@ -2478,7 +2465,7 @@ text. Otherwise buffer position will be after entity reference." (sgml-debug "Merging special case") ;; Look for a compiled dtd in some other buffer (let ((cb (current-buffer))) - (loop for b in (buffer-list) + (cl-loop for b in (buffer-list) until (progn (set-buffer b) (and sgml-buffer-parse-state @@ -2522,7 +2509,7 @@ overrides the entity type in entity look up." ;; don't consider a RS shortref here again (setq sgml-rs-ignore-pos ref-start)) (unless (and sgml-scratch-buffer - (buffer-name sgml-scratch-buffer) + (buffer-live-p sgml-scratch-buffer) ;; An existing buffer may have been left unibyte by ;; processing a cdtd. ;; FIXME: looks strange, we haven't changed bufferw yet @@ -2540,19 +2527,16 @@ overrides the entity type in entity look up." (sgml-epos (point))))) (set-buffer sgml-scratch-buffer) (when (eq sgml-scratch-buffer (default-value 'sgml-scratch-buffer)) - (make-local-variable 'sgml-scratch-buffer) - (setq sgml-scratch-buffer nil)) + (set (make-local-variable 'sgml-scratch-buffer) nil)) (setq sgml-last-entity-buffer (current-buffer)) (erase-buffer) (sgml-set-buffer-multibyte 'default) (setq default-directory dd) (set-visited-file-name nil t) (set (make-local-variable 'sgml-current-file) nil) - (make-local-variable 'sgml-current-eref) - (setq sgml-current-eref eref) + (set (make-local-variable 'sgml-current-eref) eref) (set-syntax-table syntax-table) - (make-local-variable 'sgml-previous-buffer) - (setq sgml-previous-buffer cb) + (set (make-local-variable 'sgml-previous-buffer) cb) (setq sgml-xml-p xml-p) (setq sgml-rs-ignore-pos ; don't interpret beginning of buffer ; as #RS if internal entity. @@ -2600,7 +2584,7 @@ overrides the entity type in entity look up." (let* ((pubid (sgml-extid-pubid extid)) (sysid (sgml-extid-sysid extid))) (or (if sysid ; try the sysid hooks - (loop for fn in sgml-sysid-resolve-functions + (cl-loop for fn in sgml-sysid-resolve-functions thereis (funcall fn sysid))) (progn ;; Mark entity as not found @@ -2634,7 +2618,7 @@ overrides the entity type in entity look up." (defun sgml-goto-epos (epos) "Goto a position in an entity given by EPOS." - (assert epos) + (cl-assert epos) (cond ((sgml-bpos-p epos) (goto-char epos)) (t @@ -2651,15 +2635,15 @@ overrides the entity type in entity look up." (defun sgml-cleanup-entities () (let ((cb (current-buffer)) (n 0)) - (while (and sgml-scratch-buffer (buffer-name sgml-scratch-buffer)) + (while (and sgml-scratch-buffer (buffer-live-p sgml-scratch-buffer)) (set-buffer sgml-scratch-buffer) - (assert (not (eq sgml-scratch-buffer + (cl-assert (not (eq sgml-scratch-buffer (default-value 'sgml-scratch-buffer)))) - (incf n)) + (cl-incf n)) (while (> n 10) (set-buffer (prog1 sgml-previous-buffer (kill-buffer (current-buffer)))) - (decf n)) + (cl-decf n)) (set-buffer cb))) (defun sgml-any-open-param/file () @@ -2670,7 +2654,7 @@ overrides the entity type in entity look up." ;;;; Parse tree -(defstruct (sgml-tree +(cl-defstruct (sgml-tree (:type vector) (:constructor sgml-make-tree (eltype stag-epos stag-len parent level @@ -2726,17 +2710,11 @@ overrides the entity type in entity look up." ;;;; (text) Element view of parse tree (defmacro sgml-alias-fields (orig dest &rest fields) - (let ((macs nil)) - (while fields - (push - `(defmacro ,(intern (format "%s-%s" dest (car fields))) (element) - ,(format "Return %s field of ELEMENT." (car fields)) - (list - ',(intern (format "%s-%s" orig (car fields))) - element)) - macs) - (setq fields (cdr fields))) - (cons 'progn macs))) + `(progn + . ,(mapcar (lambda (field) + `(defalias ',(intern (format "%s-%s" dest field)) + ',(intern (format "%s-%s" orig field)))) + fields))) (sgml-alias-fields sgml-tree sgml-element eltype ; element object @@ -2846,7 +2824,7 @@ overrides the entity type in entity look up." (or (and (boundp 'which-function-mode) which-function-mode ) sgml-set-face) - (not (null sgml-buffer-parse-state)) + sgml-buffer-parse-state (sit-for 0)) (let ((deactivate-mark nil)) (sgml-need-dtd) @@ -2902,7 +2880,7 @@ overrides the entity type in entity look up." ;;;; Parser state -(defstruct (sgml-pstate +(cl-defstruct (sgml-pstate (:constructor sgml-make-pstate (dtd top-tree))) dtd top-tree) @@ -2918,8 +2896,8 @@ overrides the entity type in entity look up." (defun sgml-set-initial-state (dtd) "Set initial state of parsing." - (add-hook 'before-change-functions 'sgml-note-change-at nil 'local) - (add-hook 'after-change-functions 'sgml-set-face-after-change nil 'local) + (add-hook 'before-change-functions #'sgml-note-change-at nil 'local) + (add-hook 'after-change-functions #'sgml-set-face-after-change nil 'local) (let ((top-type ; Fake element type for the top ; node of the parse tree (sgml-make-eltype "#DOC") ; was "Document (no element)" @@ -2964,7 +2942,7 @@ WHERE is `after'." sgml-markup-start (- (point) (sgml-tree-etag-len sgml-current-tree))) (setq sgml-current-tree (sgml-tree-parent sgml-current-tree)))) - (assert sgml-current-state))) + (cl-assert sgml-current-state))) (defsubst sgml-final-p (state) ;; Test if a state/model can be ended @@ -3063,7 +3041,7 @@ entity hierarchy as possible." sgml-current-shortmap newmap sgml-current-tree nt sgml-previous-tree nil) - (assert sgml-current-state) + (cl-assert sgml-current-state) (setq sgml-markup-tree sgml-current-tree) (run-hook-with-args 'sgml-open-element-hook sgml-current-tree asl) (when (sgml-element-empty sgml-current-tree) @@ -3101,7 +3079,7 @@ entity hierarchy as possible." sgml-current-state (sgml-tree-pstate sgml-current-tree) sgml-current-shortmap (sgml-tree-pshortmap sgml-current-tree) sgml-current-tree (sgml-tree-parent sgml-current-tree)) - (assert sgml-current-state)))) + (cl-assert sgml-current-state)))) (defun sgml-fake-close-element (tree) (sgml-tree-parent tree)) @@ -3114,7 +3092,7 @@ entity hierarchy as possible." (when u ;;(message "%d" at) (when (and sgml-xml-p (> at (point-min))) - (when (eq ?/ (char-after (1- at))) + (when (eq ?/ (char-before at)) (setq at (1- at)))) (while (cond @@ -3205,9 +3183,9 @@ Where the latter represents end-tags." (nconc req (delq sgml-pcdata-token (sgml-optional-tokens state)))))) ;; Modify for exceptions - (loop for et in (sgml-tree-includes tree) ;*** Tokens or eltypes? + (cl-loop for et in (sgml-tree-includes tree) ;*** Tokens or eltypes? unless (memq et elems) do (push et elems)) - (loop for et in (sgml-tree-excludes tree) + (cl-loop for et in (sgml-tree-excludes tree) do (setq elems (delq et elems))) ;; Check for omitable start-tags (when (and sgml-omittag-transparent @@ -3234,7 +3212,7 @@ Where the latter represents end-tags." (sgml-element-etag-optional tree)) (setq state (sgml-tree-pstate tree) tree (sgml-tree-parent tree)) - (loop for e in (sgml-eltypes-in-state tree state) do + (cl-loop for e in (sgml-eltypes-in-state tree state) do (when (not (memq e elems)) (setq elems (nconc elems (list e))))))) ;; FIXME: Filter out elements that are undefined? @@ -3267,8 +3245,7 @@ Where the latter represents end-tags." (let ((buf (get-buffer sgml-log-buffer-name))) (when buf (display-buffer buf) - (setq sgml-log-last-size (save-excursion (set-buffer buf) - (point-max)))))) + (setq sgml-log-last-size (with-current-buffer buf (point-max)))))) (defun sgml-log-message (format &rest things) (let ((mess (apply #'format format things)) @@ -3285,8 +3262,7 @@ Where the latter represents end-tags." (let ((buf (get-buffer sgml-log-buffer-name))) (when buf (setq sgml-log-last-size - (save-excursion (set-buffer buf) - (point-max)))))) + (with-current-buffer buf (point-max)))))) (defun sgml-clear-log () (let ((b (get-buffer sgml-log-buffer-name))) @@ -3309,7 +3285,7 @@ clear and remove it if it is showing." (defun sgml-log-entity-stack () (save-excursion - (loop + (cl-loop do (sgml-log-message "%s line %s col %s %s" (or sgml-current-file (buffer-file-name) "-") @@ -3392,9 +3368,9 @@ To avoid clearing message with out showing previous warning.") (defvar sgml-lazy-time 0) (defun sgml-lazy-message (&rest args) - (unless (= sgml-lazy-time (second (current-time))) + (unless (= sgml-lazy-time (cadr (current-time))) (apply #'message args) - (setq sgml-lazy-time (second (current-time))))) + (setq sgml-lazy-time (cadr (current-time))))) ;;;; Shortref maps @@ -3448,7 +3424,7 @@ Where PAIRS is a list of (delim . ename)." (make-vector (1+ (length sgml-shortref-list)) nil)) index) - (loop for p in pairs + (cl-loop for p in pairs for delim = (car p) for name = (cdr p) do @@ -3462,9 +3438,8 @@ Where PAIRS is a list of (delim . ename)." ;; can be used to skip over pcdata (aset map (eval-when-compile (length sgml-shortref-list)) - (if (some (function - (lambda (r) (aref map (sgml-shortref-index r)))) - '("\001B\n" "B\n" " " "BB")) + (if (cl-some (lambda (r) (aref map (sgml-shortref-index r))) + '("\001B\n" "B\n" " " "BB")) "^<]/& \n\t\"#%'()*+,\\-:;=@[]\\^_{|}~" "^<]/&\n\t\"#%'()*+,\\-:;=@[]\\^_{|}~")) map)) @@ -3476,7 +3451,7 @@ Where PAIRS is a list of (delim . ename)." (defconst sgml-shortref-oneassq - (loop for d in sgml-shortref-list + (cl-loop for d in sgml-shortref-list for c = (aref d 0) when (and (= 1 (length d)) (/= 1 c) (/= 10 c)) @@ -3489,7 +3464,7 @@ Where PAIRS is a list of (delim . ename)." "Identify shortref delimiter at point and return entity name. Also move point. Return nil, either if no shortref or undefined." - (macrolet + (cl-macrolet ((delim (x) `(aref map ,(sgml-shortref-index x)))) (let ((i (if nobol 1 0))) (while (numberp i) @@ -3867,9 +3842,9 @@ VALUE is a string. Returns nil or an attdecl." (sgml-cleanup-entities) (when (null sgml-buffer-parse-state) ; first parse in this buffer ;;(sgml-set-initial-state) ; fall back DTD - (add-hook 'pre-command-hook 'sgml-reset-log) - (make-local-variable 'sgml-auto-fill-inhibit-function) - (setq sgml-auto-fill-inhibit-function (function sgml-in-prolog-p)) + (add-hook 'pre-command-hook #'sgml-reset-log) ;FIXME: Why global? + (set (make-local-variable 'sgml-auto-fill-inhibit-function) + (function sgml-in-prolog-p)) (if sgml-default-dtd-file (sgml-load-dtd sgml-default-dtd-file) (sgml-load-doctype))) @@ -3927,7 +3902,7 @@ Either from parent document or by parsing the document prolog." (when (consp (cdr modifier)) ; There are "seen" elements (sgml-open-element et nil (point-min) (point-min)) - (loop for seenel in (cadr modifier) + (cl-loop for seenel in (cadr modifier) do (let ((new-state (sgml-get-move sgml-current-state (sgml-lookup-eltype (sgml-general-case seenel))))) @@ -4043,12 +4018,12 @@ If third argument QUIET is non-nil, no \"Parsing...\" message will be displayed. (defun sgml-parse-continue (goal &optional extra-cond quiet) "Parse until (at least) GOAL." (let ((sgml-goal goal)) - (assert sgml-current-tree) + (cl-assert sgml-current-tree) (unless quiet (sgml-message "Parsing...")) (sgml-debug "Parse continue") (sgml-with-parser-syntax-ro - (set-buffer sgml-last-buffer) + (set-buffer sgml-last-buffer) ;FIXME:Doitbefore sgml-with-parser-syntax-ro! (sgml-parser-loop extra-cond)) (unless quiet (sgml-message "")))) @@ -4067,7 +4042,7 @@ pointing to start of short ref and point pointing to the end." sgml-current-state))) (defun sgml-execute-implied (imps type) - (loop for token in imps do + (cl-loop for token in imps do (if (eq t token) (sgml-implied-end-tag type sgml-markup-start sgml-markup-start) (sgml-move-current-state token) @@ -4118,61 +4093,56 @@ pointing to start of short ref and point pointing to the end." (sgml-set-markup-type nil)) (defvar sgml-parser-loop-hook nil) -(defvar sgml-parse-in-loop nil - "Non-nil means the body of `sgml-parser-loop' is executing. -Thus lower-level functions don't need to use `sgml-with-modification-state'.") + (defun sgml-parser-loop (extra-cond) (let (tem - (sgml-signal-data-function (function sgml-pcdata-move)) - ;; Speed up significantly by effectively hoisting - ;; `sgml-with-modification-state' out of the loop. - (sgml-parse-in-loop t)) - (sgml-with-modification-state - (while (and (eq sgml-current-tree sgml-top-tree) - (or (< (point) sgml-goal) sgml-current-eref) - (progn (setq sgml-markup-start (point) - sgml-markup-type nil) - (or (sgml-parse-s) - (sgml-parse-markup-declaration 'prolog) - (sgml-parse-processing-instruction))))) - (while (and (or (< (point) sgml-goal) sgml-current-eref) - (not (if extra-cond (funcall extra-cond)))) - (assert sgml-current-tree) - (setq sgml-markup-start (point) - sgml-markup-type nil) - (cond - ((eobp) (sgml-pop-entity)) - ((and (or (eq sgml-current-state sgml-cdata) - (eq sgml-current-state sgml-rcdata))) - (if (or (sgml-parse-delim "ETAGO" gi) - (sgml-is-enabled-net)) - (sgml-do-end-tag) - (sgml-do-data sgml-current-state))) - ((and sgml-current-shortmap - (or (setq tem (sgml-deref-shortmap sgml-current-shortmap - (eq (point) - sgml-rs-ignore-pos))) - ;; Restore position, to consider the delim for S+ or data - (progn (goto-char sgml-markup-start) - nil))) - (setq sgml-rs-ignore-pos sgml-markup-start) ; don't reconsider RS - (funcall sgml-shortref-handler tem)) - ((and (not (sgml-current-mixed-p)) - (sgml-parse-s sgml-current-shortmap))) - ((or (sgml-parse-delim "ETAGO" gi) - (sgml-is-enabled-net)) - (sgml-do-end-tag)) - ((sgml-parse-delim "STAGO" gi) - (sgml-do-start-tag)) - ((sgml-parse-general-entity-ref)) - ((sgml-parse-markup-declaration nil)) - ((sgml-parse-delim "MS-END") ; end of marked section - (sgml-set-markup-type 'ms-end)) - ((sgml-parse-processing-instruction)) - ((and sgml-parser-loop-hook - (run-hook-with-args-until-success 'sgml-parser-loop-hook))) - (t - (sgml-do-pcdata))))))) + (sgml-signal-data-function (function sgml-pcdata-move))) + (with-silent-modifications + (while (and (eq sgml-current-tree sgml-top-tree) + (or (< (point) sgml-goal) sgml-current-eref) + (progn (setq sgml-markup-start (point) + sgml-markup-type nil) + (or (sgml-parse-s) + (sgml-parse-markup-declaration 'prolog) + (sgml-parse-processing-instruction))))) + (while (and (or (< (point) sgml-goal) sgml-current-eref) + (not (if extra-cond (funcall extra-cond)))) + (cl-assert sgml-current-tree) + (setq sgml-markup-start (point) + sgml-markup-type nil) + (cond + ((eobp) (sgml-pop-entity)) + ((and (or (eq sgml-current-state sgml-cdata) + (eq sgml-current-state sgml-rcdata))) + (if (or (sgml-parse-delim "ETAGO" gi) + (sgml-is-enabled-net)) + (sgml-do-end-tag) + (sgml-do-data sgml-current-state))) + ((and sgml-current-shortmap + (or (setq tem (sgml-deref-shortmap sgml-current-shortmap + (eq (point) + sgml-rs-ignore-pos))) + ;; Restore position, to consider the delim for S+ or data + (progn (goto-char sgml-markup-start) + nil))) + (setq sgml-rs-ignore-pos sgml-markup-start) ; don't reconsider RS + (funcall sgml-shortref-handler tem)) + ((and (not (sgml-current-mixed-p)) + (sgml-parse-s sgml-current-shortmap))) + ((or (sgml-parse-delim "ETAGO" gi) + (sgml-is-enabled-net)) + (sgml-do-end-tag)) + ((sgml-parse-delim "STAGO" gi) + (sgml-do-start-tag)) + ((sgml-parse-general-entity-ref)) + ((sgml-parse-markup-declaration nil)) + ((sgml-parse-delim "MS-END") ; end of marked section + (sgml-set-markup-type 'ms-end)) + ((sgml-parse-processing-instruction)) + ((and sgml-parser-loop-hook + (run-hook-with-args-until-success 'sgml-parser-loop-hook))) + (t + (sgml-do-pcdata))))))) (defun sgml-handle-shortref (name) (sgml-set-markup-type 'shortref) @@ -4230,7 +4200,7 @@ Thus lower-level functions don't need to use `sgml-with-modification-state'.") (sgml-tree-eltype sgml-previous-tree)) ;; No sibling, last closed must be found in enclosing element (t - (loop named outer + (cl-loop named outer for current = sgml-current-tree then (sgml-tree-parent current) for parent = (sgml-tree-parent current) do;; Search for a parent with a child before current @@ -4238,9 +4208,9 @@ Thus lower-level functions don't need to use `sgml-with-modification-state'.") (sgml-error "No previously closed element")) (unless (eq current (sgml-tree-content parent)) ;; Search content of u for element before current - (loop for c = (sgml-tree-content parent) then (sgml-tree-next c) + (cl-loop for c = (sgml-tree-content parent) then (sgml-tree-next c) do (when (eq current (sgml-tree-next c)) - (return-from outer (sgml-tree-eltype c))))))))) + (cl-return-from outer (sgml-tree-eltype c))))))))) (defun sgml-do-end-tag () @@ -4263,7 +4233,7 @@ Thus lower-level functions don't need to use `sgml-with-modification-state'.") (setq gi (sgml-eltype-name et)) (setq found ; check if there is an open element ; with the right eltype - (loop for u = sgml-current-tree then (sgml-tree-parent u) + (cl-loop for u = sgml-current-tree then (sgml-tree-parent u) while u thereis (eq et (sgml-tree-eltype u)))) (unless found @@ -4476,7 +4446,7 @@ Returns parse tree; error if no element after POS." (unless (sgml-tree-etag-epos element) (sgml-debug "Failed to define end of element %s" (sgml-element-gi element))) - (assert (sgml-tree-etag-epos element)) + (cl-assert (sgml-tree-etag-epos element)) (sgml-epos-promote (sgml-tree-etag-epos element))) (defun sgml-element-end (element) diff --git a/psgml-sysdep.el b/psgml-sysdep.el deleted file mode 100644 index 9aa482b..0000000 --- a/psgml-sysdep.el +++ /dev/null @@ -1,9 +0,0 @@ - -(provide 'psgml-sysdep) - -(require 'psgml) -(cond - ((featurep 'xemacs) - (require 'psgml-lucid)) - (t - (require 'psgml-other))) diff --git a/psgml-vars.el b/psgml-vars.el index bf2f12c..8a02db3 100644 --- a/psgml-vars.el +++ b/psgml-vars.el @@ -1,3 +1,22 @@ +;;; psgml-vars.el --- ??? -*- lexical-binding:t -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; 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/>. + +;;; Code: + (require 'custom) (defgroup psgml () @@ -423,3 +442,4 @@ Should return an integer." (provide 'psgml-vars) +;;; psgml-vars.el ends here diff --git a/psgml-xpr.el b/psgml-xpr.el index f75677f..d5e06bd 100644 --- a/psgml-xpr.el +++ b/psgml-xpr.el @@ -1,15 +1,14 @@ -;;; psgml-xpr.el --- Experimental additions for PSGML +;;; psgml-xpr.el --- Experimental additions for PSGML -*- lexical-binding:t -*- ;; $Id: psgml-xpr.el,v 2.3 2005/02/27 17:15:19 lenst Exp $ -;; Copyright (C) 2003 Lennart Staflin +;; Copyright (C) 2003, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> -;; Maintainer: Lennart Staflin <le...@lysator.liu.se> ;; Keywords: languages ;; 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 +;; 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, @@ -18,8 +17,7 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -27,9 +25,8 @@ ;; -;;;; Code: +;;; Code: -(provide 'psgml-xpr) ;;;; Simplistic JSP Support @@ -99,4 +96,5 @@ (insert "</tr>"))))))) +(provide 'psgml-xpr) ;;; psgml-xpr.el ends here diff --git a/psgml.el b/psgml.el index 957e5b5..4020379 100644 --- a/psgml.el +++ b/psgml.el @@ -1,8 +1,6 @@ -;;; psgml.el --- SGML-editing mode with parsing support -;; $Id: psgml.el,v 2.76 2008/06/21 16:13:50 lenst Exp $ +;;; psgml.el --- SGML-editing mode with parsing support -*- lexical-binding:t -*- -;; Copyright (C) 1993-2002 Lennart Staflin -;; Copyright (C) 1992 Free Software Foundation, Inc. +;; Copyright (C) 1992-2002, 2016 Free Software Foundation, Inc. ;; Author: Lennart Staflin <le...@lysator.liu.se> ;; James Clark <j...@clark.com> @@ -10,10 +8,9 @@ ;; Keywords: languages ;; Version: 0 -;; ;; 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 +;; 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, @@ -22,8 +19,7 @@ ;; 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., 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -53,12 +49,9 @@ ;;; Code: -(defconst psgml-version "1.3.3" - "Version of psgml package.") - -(defconst psgml-maintainer-address "le...@lysator.liu.se") +(defconst psgml-maintainer-address "emacs-de...@gnu.org") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'easymenu) (defvar sgml-debug nil) @@ -70,9 +63,8 @@ ;;;; Variables -(defvar sgml-mode-abbrev-table nil +(define-abbrev-table 'sgml-mode-abbrev-table () "Abbrev table in use in SGML mode.") -(define-abbrev-table 'sgml-mode-abbrev-table ()) (eval-and-compile (defconst sgml-have-re-char-clases (string-match "[[:alpha:]]" "x") @@ -210,10 +202,10 @@ Can be changed in the Local variables section of the file.") (put 'sgml-fixed 'face 'underline) ; Face of #FIXED "..." -;;; nsgmls is a free SGML parser in the SP suite available from -;;; ftp.jclark.com:pub/sp -;;; Its error messages can be parsed by next-error. -;;; The -s option suppresses output. +;; nsgmls is a free SGML parser in the SP suite available from +;; ftp.jclark.com:pub/sp +;; Its error messages can be parsed by next-error. +;; The -s option suppresses output. (defvar sgml-validate-command "nsgmls -s %s %s" "*The shell command to validate an SGML document. @@ -267,9 +259,6 @@ See `compilation-error-regexp-alist'.") (defvar sgml-mode-hook nil "A hook or list of hooks to be run when entering sgml-mode") -(defvar sgml-mode-map nil - "Keymap for SGML mode") - (defvar sgml-show-context-function #'sgml-show-context-standard "*Function to called to show context of and element. @@ -341,9 +330,7 @@ Should return a string suitable form printing in the echo area.") (or (get var 'sgml-desc) (let ((desc (symbol-name var))) (if (string= "sgml-" (substring desc 0 5)) - (setq desc (substring desc 5))) - (loop for c across-ref desc - do (if (eq c ?-) (setf c ? ))) + (setq desc (replace-regexp-in-string "-" " " (substring desc 5)))) (capitalize desc)))) (defun sgml-variable-type (var) @@ -407,33 +394,9 @@ Should return a string suitable form printing in the echo area.") (defun sgml-save-options () "Save user options for SGML mode that have buffer local values." (interactive) - (loop for var in sgml-file-options do - (when (sgml-valid-option var) - (sgml-set-local-variable var (symbol-value var))))) - - -;;;; Run hook with args - -(unless (fboundp 'run-hook-with-args) - (defun run-hook-with-args (hook &rest args) - "Run HOOK with the specified arguments ARGS. -HOOK should be a symbol, a hook variable. If HOOK has a non-nil -value, that value may be a function or a list of functions to be -called to run the hook. If the value is a function, it is called with -the given arguments and its return value is returned. If it is a list -of functions, those functions are called, in order, -with the given arguments ARGS. -It is best not to depend on the value return by `run-hook-with-args', -as that may change." - (and (boundp hook) - (symbol-value hook) - (let ((value (symbol-value hook))) - (if (and (listp value) (not (eq (car value) 'lambda))) - (mapcar (lambda (foo) (apply foo args)) - value) - (apply value args)))))) - - + (dolist (var sgml-file-options) + (when (sgml-valid-option var) + (sgml-set-local-variable var (symbol-value var))))) ;;;; SGML mode: template functions @@ -504,7 +467,7 @@ as that may change." (and (y-or-n-p "Do you really want to submit a report on PSGML? ") (reporter-submit-bug-report psgml-maintainer-address - (concat "psgml.el " psgml-version) + (concat "psgml.el <ELPA>") (list 'major-mode 'sgml-always-quote-attributes @@ -545,68 +508,76 @@ as that may change." ;;;; SGML mode: keys and menus -(if sgml-mode-map - () - (setq sgml-mode-map (make-sparse-keymap))) - -(defvar sgml-prefix-f-map (make-sparse-keymap)) -(defvar sgml-prefix-u-map (make-sparse-keymap)) - -(define-key sgml-mode-map "\C-c\C-f" sgml-prefix-f-map) -(define-key sgml-mode-map "\C-c\C-u" sgml-prefix-u-map) - -;;; Key commands - -(define-key sgml-mode-map "\t" 'sgml-indent-or-tab) -;(define-key sgml-mode-map "<" 'sgml-insert-tag) -(define-key sgml-mode-map ">" 'sgml-close-angle) -(define-key sgml-mode-map "/" 'sgml-slash) -(define-key sgml-mode-map "\C-c#" 'sgml-make-character-reference) -(define-key sgml-mode-map "\C-c-" 'sgml-untag-element) -(define-key sgml-mode-map "\C-c+" 'sgml-insert-attribute) -(define-key sgml-mode-map "\C-c/" 'sgml-insert-end-tag) -(define-key sgml-mode-map "\C-c<" 'sgml-insert-tag) -(define-key sgml-mode-map "\C-c=" 'sgml-change-element-name) -(define-key sgml-mode-map "\C-c\C-a" 'sgml-edit-attributes) -(define-key sgml-mode-map "\C-c\C-c" 'sgml-show-context) -(define-key sgml-mode-map "\C-c\C-d" 'sgml-next-data-field) -(define-key sgml-mode-map "\C-c\C-e" 'sgml-insert-element) -(define-key sgml-mode-map "\C-c\C-f\C-e" 'sgml-fold-element) -(define-key sgml-mode-map "\C-c\C-f\C-r" 'sgml-fold-region) -(define-key sgml-mode-map "\C-c\C-f\C-s" 'sgml-fold-subelement) -(define-key sgml-mode-map "\C-c\C-f\C-x" 'sgml-expand-element) -(define-key sgml-mode-map "\C-c\C-i" 'sgml-add-element-to-element) -(define-key sgml-mode-map "\C-c\C-k" 'sgml-kill-markup) -(define-key sgml-mode-map "\C-c\r" 'sgml-split-element) -(define-key sgml-mode-map "\C-c\C-n" 'sgml-up-element) -(define-key sgml-mode-map "\C-c\C-o" 'sgml-next-trouble-spot) -(define-key sgml-mode-map "\C-c\C-p" 'sgml-load-doctype) -(define-key sgml-mode-map "\C-c\C-q" 'sgml-fill-element) -(define-key sgml-mode-map "\C-c\C-r" 'sgml-tag-region) -(define-key sgml-mode-map "\C-c\C-s" 'sgml-show-structure) -;(define-key sgml-mode-map "\C-c\C-t" 'sgml-list-valid-tags) -(define-key sgml-mode-map "\C-c\C-t" 'sgml-show-current-element-type) -(define-key sgml-mode-map "\C-c\C-u\C-a" 'sgml-unfold-all) -(define-key sgml-mode-map "\C-c\C-u\C-d" 'sgml-custom-dtd) -(define-key sgml-mode-map "\C-c\C-u\C-e" 'sgml-unfold-element) -(define-key sgml-mode-map "\C-c\C-u\C-l" 'sgml-unfold-line) -(define-key sgml-mode-map "\C-c\C-u\C-m" 'sgml-custom-markup) -(define-key sgml-mode-map "\C-c\C-v" 'sgml-validate) -(define-key sgml-mode-map "\C-c\C-w" 'sgml-what-element) -(define-key sgml-mode-map "\C-c\C-z" 'sgml-trim-and-leave-element) - -(define-key sgml-mode-map "\e\C-a" 'sgml-beginning-of-element) -(define-key sgml-mode-map "\e\C-e" 'sgml-end-of-element) -(define-key sgml-mode-map "\e\C-f" 'sgml-forward-element) -(define-key sgml-mode-map "\e\C-b" 'sgml-backward-element) -(define-key sgml-mode-map "\e\C-d" 'sgml-down-element) -(define-key sgml-mode-map "\e\C-u" 'sgml-backward-up-element) -(define-key sgml-mode-map "\e\C-k" 'sgml-kill-element) -(define-key sgml-mode-map "\e\C-@" 'sgml-mark-element) -;;(define-key sgml-mode-map [?\M-\C-\ ] 'sgml-mark-element) -(define-key sgml-mode-map [(meta control h)] 'sgml-mark-current-element) -(define-key sgml-mode-map "\e\C-t" 'sgml-transpose-element) -(define-key sgml-mode-map "\M-\t" 'sgml-complete) +(defvar sgml-mode-map + (let ((map (make-sparse-keymap)) + + ;; FIXME: Are these two explicit prefix map settings really needed? + (f-map (make-sparse-keymap)) + (u-map (make-sparse-keymap))) + (define-key map "\C-c\C-f" f-map) + (define-key map "\C-c\C-u" u-map) + + ;; Key commands + (define-key map "\t" 'sgml-indent-or-tab) + ;; (define-key map "<" 'sgml-insert-tag) + (define-key map ">" 'sgml-close-angle) + (define-key map "/" 'sgml-slash) + (define-key map "\C-c#" 'sgml-make-character-reference) + (define-key map "\C-c-" 'sgml-untag-element) + (define-key map "\C-c+" 'sgml-insert-attribute) + (define-key map "\C-c/" 'sgml-insert-end-tag) + (define-key map "\C-c<" 'sgml-insert-tag) + (define-key map "\C-c=" 'sgml-change-element-name) + (define-key map "\C-c\C-a" 'sgml-edit-attributes) + (define-key map "\C-c\C-c" 'sgml-show-context) + (define-key map "\C-c\C-d" 'sgml-next-data-field) + (define-key map "\C-c\C-e" 'sgml-insert-element) + (define-key map "\C-c\C-f\C-e" 'sgml-fold-element) + (define-key map "\C-c\C-f\C-r" 'sgml-fold-region) + (define-key map "\C-c\C-f\C-s" 'sgml-fold-subelement) + (define-key map "\C-c\C-f\C-x" 'sgml-expand-element) + (define-key map "\C-c\C-i" 'sgml-add-element-to-element) + (define-key map "\C-c\C-k" 'sgml-kill-markup) + (define-key map "\C-c\r" 'sgml-split-element) + (define-key map "\C-c\C-n" 'sgml-up-element) + (define-key map "\C-c\C-o" 'sgml-next-trouble-spot) + (define-key map "\C-c\C-p" 'sgml-load-doctype) + (define-key map "\C-c\C-q" 'sgml-fill-element) + (define-key map "\C-c\C-r" 'sgml-tag-region) + (define-key map "\C-c\C-s" 'sgml-show-structure) + ;;(define-key map "\C-c\C-t" 'sgml-list-valid-tags) + (define-key map "\C-c\C-t" 'sgml-show-current-element-type) + (define-key map "\C-c\C-u\C-a" 'sgml-unfold-all) + (define-key map "\C-c\C-u\C-d" 'sgml-custom-dtd) + (define-key map "\C-c\C-u\C-e" 'sgml-unfold-element) + (define-key map "\C-c\C-u\C-l" 'sgml-unfold-line) + (define-key map "\C-c\C-u\C-m" 'sgml-custom-markup) + (define-key map "\C-c\C-v" 'sgml-validate) + (define-key map "\C-c\C-w" 'sgml-what-element) + (define-key map "\C-c\C-z" 'sgml-trim-and-leave-element) + + (define-key map "\e\C-a" 'sgml-beginning-of-element) + (define-key map "\e\C-e" 'sgml-end-of-element) + (define-key map "\e\C-f" 'sgml-forward-element) + (define-key map "\e\C-b" 'sgml-backward-element) + (define-key map "\e\C-d" 'sgml-down-element) + (define-key map "\e\C-u" 'sgml-backward-up-element) + (define-key map "\e\C-k" 'sgml-kill-element) + (define-key map "\e\C-@" 'sgml-mark-element) + ;;(define-key map [?\M-\C-\ ] 'sgml-mark-element) + (define-key map [(meta control h)] 'sgml-mark-current-element) + (define-key map "\e\C-t" 'sgml-transpose-element) + (define-key map "\M-\t" 'sgml-complete) + + (if (featurep 'xemacs) + (define-key map [button3] 'sgml-tags-menu) + (define-key map [?\M-\C-\ ] 'sgml-mark-element) + + ;;(define-key map [S-mouse-3] 'sgml-tags-menu) + (define-key map [S-mouse-3] 'sgml-right-menu)) + + map) + "Main keymap for PSGML mode.") ;;;; Menu bar @@ -623,7 +594,7 @@ as that may change." ["List terminals" sgml-list-terminals t] ["List content elements" sgml-list-content-elements t] ["List occur in elements" sgml-list-occur-in-elements t]) - ("Insert DTD") + ("Insert DTD" :filter sgml-compute-insert-dtd-items) ("Insert Markup" ["Insert Element" sgml-element-menu t] ["Insert Start-Tag" sgml-start-tag-menu t] @@ -633,7 +604,7 @@ as that may change." ["Insert Attribute" sgml-attrib-menu t] ["Insert Entity" sgml-entities-menu t] ["Add Element to Element" sgml-add-element-menu t]) - ("Custom markup" "---") + ("Custom markup" :filter sgml-compute-custom-markup-items) "--" ["Show Context" sgml-show-context t] ["What Element" sgml-what-element t] @@ -725,16 +696,17 @@ as that may change." (defvar sgml-last-options-menu-values ()) (defun sgml-any-option-changed (oldvalues vars) - (not (loop for val in oldvalues - for var in vars - always (eq val (symbol-value var))))) + (not (cl-loop for val in oldvalues + for var in vars + always (eq val (symbol-value var))))) +;; FIXME: Use a keymap filter! (defun sgml-update-options-menu (menuname option-vars &optional save-func) (let ((last-values (assoc menuname sgml-last-options-menu-values))) (when (or (null last-values) (sgml-any-option-changed (cdr last-values) option-vars)) - (condition-case err + (condition-case-unless-debug err (easy-menu-change '("SGML") menuname (nconc (sgml-options-menu-items option-vars) (if save-func @@ -755,31 +727,23 @@ as that may change." (sgml-update-options-menu "User Options" sgml-user-options) nil) -(defun sgml-compute-insert-dtd-items () - (loop for e in sgml-custom-dtd collect - (vector (first e) - `(sgml-doctype-insert ,(cadr e) ',(cddr e)) - t))) - -(defun sgml-compute-custom-markup-items () - (loop for e in sgml-custom-markup collect - (vector (first e) - `(sgml-insert-markup ,(cadr e)) - t))) - -(defun sgml-build-custom-menus () - "Build custom parts of Markup and DTD menus." - (let ((button3 (lookup-key (current-local-map) [button3]))) - (unless (or (null button3) - (numberp button3)) - (local-set-key [button3] button3)) - (when sgml-custom-dtd - (easy-menu-change '("SGML") "Insert DTD" - (sgml-compute-insert-dtd-items))) - (when sgml-custom-markup - (easy-menu-change '("SGML") "Custom markup" - (sgml-compute-custom-markup-items)))) - nil) +(defun sgml-compute-insert-dtd-items (&optional _menu) + (if (null sgml-custom-dtd) + '(["-- No custom entries --" nil :enable nil]) + (mapcar (lambda (e) + (vector (car e) + `(sgml-doctype-insert ,(cadr e) ',(cddr e)) + t)) + sgml-custom-dtd))) + +(defun sgml-compute-custom-markup-items (&optional _menu) + (if (null sgml-custom-markup) + '(["-- No custom entries --" nil :enable nil]) + (mapcar (lambda (e) + (vector (car e) + `(sgml-insert-markup ,(cadr e)) + t)) + sgml-custom-markup))) ;;;; Post command hook @@ -795,11 +759,11 @@ actually only the state that persists between commands.") (make-variable-buffer-local 'sgml-buffer-parse-state) (eval-and-compile ; Interface to psgml-parse - (loop for fun in '(sgml-need-dtd sgml-update-display - sgml-fontify-buffer - sgml-subst-expand - sgml-declaration) - do (autoload fun "psgml-parse"))) + (dolist (fun '(sgml-need-dtd sgml-update-display + sgml-fontify-buffer + sgml-subst-expand + sgml-declaration)) + (autoload fun "psgml-parse"))) (defun sgml-command-post () @@ -809,9 +773,9 @@ actually only the state that persists between commands.") (not (zerop (buffer-size))) (looking-at ".*<")) (setq sgml-auto-activate-dtd-tried t) - (ignore-errors - (sgml-need-dtd) - (sgml-fontify-buffer 0))) + (with-demoted-errors "PSGML post command: %S" + (sgml-need-dtd) + (sgml-fontify-buffer 0))) (when sgml-buffer-parse-state (sgml-update-display))) @@ -821,7 +785,7 @@ actually only the state that persists between commands.") ;;; This section is mostly from sgml-mode by James Clark. ;;;###autoload -(defun sgml-mode () +(define-derived-mode sgml-mode nil "PSGML" "Major mode for editing SGML. \\<sgml-mode-map>Makes > display the matching <. Makes / display matching /. Use \\[sgml-validate] to validate your document with an SGML parser. @@ -889,13 +853,7 @@ sgml-offer-save If non-nil, ask about saving modified buffers before All bindings: \\{sgml-mode-map}" - (interactive) - (kill-all-local-variables) (setq sgml-xml-p nil) - (setq local-abbrev-table sgml-mode-abbrev-table) - (use-local-map sgml-mode-map) - (setq mode-name "SGML") - (setq major-mode 'sgml-mode) ;; A start or end tag by itself on a line separates a paragraph. ;; This is desirable because SGML discards a newline that appears @@ -913,39 +871,31 @@ All bindings: paragraph-separate) (set-syntax-table sgml-mode-syntax-table) - (make-local-variable 'comment-start) - (setq comment-start "<!-- ") - (make-local-variable 'comment-end) - (setq comment-end " -->") - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'sgml-comment-indent) - (make-local-variable 'comment-start-skip) + (set (make-local-variable 'comment-start) "<!-- ") + (set (make-local-variable 'comment-end) " -->") + (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent) ;; This will allow existing comments within declarations to be ;; recognized. [Does not work well with auto-fill, Lst/940205] ;;(setq comment-start-skip "--[ \t]*") - (setq comment-start-skip "<!--[ \t]*") + (set (make-local-variable 'comment-start-skip) "<!--[ \t]*") ;; Added for psgml: - (make-local-variable 'indent-line-function) - (setq indent-line-function 'sgml-indent-line) - (make-local-variable 'sgml-default-dtd-file) - (when (setq sgml-default-dtd-file (sgml-default-dtd-file)) + (set (make-local-variable 'indent-line-function) 'sgml-indent-line) + (when (set (make-local-variable 'sgml-default-dtd-file) + (sgml-default-dtd-file)) (unless (file-exists-p sgml-default-dtd-file) (setq sgml-default-dtd-file nil))) -;;; This doesn't DTRT with Emacs 21.1 newcomment -- intermediate lines -;;; are prefixed by `!--'. -- fx -;;; (set (make-local-variable 'comment-style) 'multi-line) + ;; This doesn't DTRT with Emacs 21.1 newcomment -- intermediate lines + ;; are prefixed by `!--'. -- fx + ;;(set (make-local-variable 'comment-style) 'multi-line) (when sgml-default-nonsticky (make-local-variable 'text-property-default-nonsticky) ;; see `sgml-set-face-for': (add-to-list 'text-property-default-nonsticky '(face . t))) - (add-hook 'post-command-hook 'sgml-command-post 'append 'local) - (add-hook 'activate-menubar-hook 'sgml-update-all-options-menus + (add-hook 'post-command-hook #'sgml-command-post 'append 'local) + (add-hook 'activate-menubar-hook #'sgml-update-all-options-menus nil 'local) - (add-hook 'which-func-functions 'sgml-current-element-name nil t) - (run-hooks 'text-mode-hook 'sgml-mode-hook) - (easy-menu-add sgml-main-menu) - (sgml-build-custom-menus)) - + (add-hook 'which-func-functions #'sgml-current-element-name nil t) + (easy-menu-add sgml-main-menu)) ;; It would be nice to generalize the `auto-mode-interpreter-regexp' ;; machinery so that we could select xml-mode on the basis of the @@ -972,8 +922,7 @@ Note that without a DTD, indenting lines will only work if (setq sgml-minimize-attributes nil) (setq sgml-always-quote-attributes t) (setq sgml-validate-command sgml-xml-validate-command) - (make-local-variable 'sgml-declaration) - (setq sgml-declaration sgml-xml-declaration)) + (set (make-local-variable 'sgml-declaration) sgml-xml-declaration)) (defun sgml-default-dtd-file () @@ -1002,17 +951,15 @@ Note that without a DTD, indenting lines will only work if "Regular expression that matches a non-empty start tag. Any terminating > or / is not matched.") -(defvar sgml-mode-markup-syntax-table nil +(defvar sgml-mode-markup-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?< "(>" st) + (modify-syntax-entry ?> ")<" st) + (modify-syntax-entry ?- "_ 1234" st) + (modify-syntax-entry ?\' "\"" st) + st) "Syntax table used for scanning SGML markup.") -(if sgml-mode-markup-syntax-table - () - (setq sgml-mode-markup-syntax-table (make-syntax-table)) - (modify-syntax-entry ?< "(>" sgml-mode-markup-syntax-table) - (modify-syntax-entry ?> ")<" sgml-mode-markup-syntax-table) - (modify-syntax-entry ?- "_ 1234" sgml-mode-markup-syntax-table) - (modify-syntax-entry ?\' "\"" sgml-mode-markup-syntax-table)) - (defvar sgml-angle-distance 4000 "*If non-nil, is the maximum distance to search for matching <.") @@ -1155,7 +1102,7 @@ start tag, and the second / is the corresponding null end tag." (cons ?s (sgml-declaration)) (cons ?v sgml-declaration) (cons ?d sgml-doctype)))) - (loop for template in sgml-validate-command + (cl-loop for template in sgml-validate-command thereis (sgml-subst-expand template validate-subst)))) (t @@ -1184,10 +1131,6 @@ and move to the line in the SGML document that caused it." nil sgml-validate-error-regexps)) -(defalias 'sgml-restore-buffer-modified-p - (if (fboundp 'restore-buffer-modified-p) - 'restore-buffer-modified-p ; doesn't update mode line - 'set-buffer-modified-p)) ;;;; Autoloads and hooks @@ -1341,7 +1284,4 @@ otherwise it will be added at the first legal position." t) ;;;; Last provisions (provide 'psgml) -(provide 'sgml-mode) - - ;;; psgml.el ends here diff --git a/psgml.texi b/psgml.texi index f7e7b68..7d82bcd 100644 --- a/psgml.texi +++ b/psgml.texi @@ -1569,7 +1569,7 @@ Default: @code{t}. Set the variable @code{sgml-display-char-list-filename} to a file that contains mappings between all characters present in the presentation -character set, and their "standard replacement text" names, e.g. "�" +character set, and their "standard replacement text" names, e.g. "å" -> "[aring ]", e.t.c. The default value for this variable is `iso88591.map'.