[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] scratch/psgml 9272d11: General update, cl-lib, lexical-binding, c
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] scratch/psgml 9272d11: General update, cl-lib, lexical-binding, copyright headers |
|
Date: |
Wed, 19 Oct 2016 16:25:27 +0000 (UTC) |
branch: scratch/psgml
commit 9272d11f719d84107229e57dd4d4df3b68e7f75b
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
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 <address@hidden>
-
- * 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 <address@hidden>
* psgml-dtd.el (sgml-parse-character-reference): string-to-int ->
@@ -655,7 +605,7 @@ Tue Jan 4 19:51:03 2000 Lennart Staflin <address@hidden>
Tue Dec 21 20:50:31 1999 Lennart Staflin <address@hidden>
* 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 <address@hidden>
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 <address@hidden>
;; 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 <address@hidden>
;;
;; 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 <address@hidden>
;; 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 <address@hidden>
;; 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 <address@hidden>
-;; 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 address@hidden) 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 <address@hidden>
;; 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 <address@hidden>
;; 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 <address@hidden>
;; William M. Perry <address@hidden>
-;;
;; 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 <address@hidden>
;; 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 address@hidden) 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 <address@hidden>
-;;
;; 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 <address@hidden>
;; 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\"#%'()*+,\\-:;address@hidden|}~"
"^<]/&\n\t\"#%'()*+,\\-:;address@hidden|}~"))
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 <address@hidden>
-;; Maintainer: Lennart Staflin <address@hidden>
;; 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 <address@hidden>
;; James Clark <address@hidden>
@@ -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 "address@hidden")
+(defconst psgml-maintainer-address "address@hidden")
-(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'.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] scratch/psgml 9272d11: General update, cl-lib, lexical-binding, copyright headers,
Stefan Monnier <=