branch: scratch/psgml
commit 9656da68814d753e297a3cd27df3b2523e1fe61d
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Silence some byte-compiler warnings and other minor cleanups
* .gitignore: Add auto-generated ELPA files.
* psgml-api.el (sgml-parse-data): Don't use dyn-bound vars as args.
* psgml-debug.el (sgml-auto-dump, test-sgml): Use with-current-buffer.
* psgml-dtd.el (sgml-reduce-\,): Escape the comma in the name.
(sgml-write-dtd): Don't set obsolete `file-type'.
* 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-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-info.el (sgml-eltype-refrenced-elements): Avoid add-to-list.
* psgml-lucid.el: Explicitly require `cl'.
* psgml-maint.el (psgml-elisp-source): Use (featurep 'xemacs).
(psgml-compile-files): Avoid `interactive-p'.
(psgml-install-elc): Remove unused var `destdir'.
* psgml-other.el: Require` psgml-parse'.
* 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-xpr.el (sgml-delimiters): Avoid `list*'.
* 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.
---
.gitignore | 5 +-
lisp/ChangeLog | 50 +++++++++++++++++++
lisp/psgml-api.el | 9 ++--
lisp/psgml-debug.el | 22 +++------
lisp/psgml-dtd.el | 5 +-
lisp/psgml-edit.el | 111 ++++++++++++++++++++----------------------
lisp/psgml-fs.el | 105 ++++++++++++++++++++--------------------
lisp/psgml-info.el | 10 ++--
lisp/psgml-lucid.el | 1 +
lisp/psgml-maint.el | 18 +++----
lisp/psgml-other.el | 6 +--
lisp/psgml-parse.el | 130 +++++++++++++++++++++++---------------------------
lisp/psgml-sysdep.el | 2 +-
lisp/psgml-xpr.el | 7 ++-
lisp/psgml.el | 29 +++++------
15 files changed, 265 insertions(+), 245 deletions(-)
diff --git a/.gitignore b/.gitignore
index 03c5b77..ff09dd8 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,7 @@
+ChangeLog
+*-autoloads.el
+*-pkg.el
*.elc
*.tgz
-.cvsignore
-CVS/
TAGS
.#*
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 15c01b3..8b1a677 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,53 @@
+2016-10-18 Stefan Monnier <monn...@iro.umontreal.ca>
+
+ * psgml.el: Add dummy `Version:'.
+ (sgml-running-lucid): Remove. Use (featurep 'xemacs) instead.
+ (sgml-parse-colon-path): Don't use dyn-bound vars as args.
+ (sgml-mode): Don't call obsolete make-local-hook.
+
+ * psgml-xpr.el (sgml-delimiters): Avoid `list*'.
+
+ * psgml-parse.el (sgml-set-buffer-multibyte): Remove obsolete code.
+ (sgml-load-dtd, sgml-bdtd-load): Don't bother binding find-file-type.
+ (sgml-delimiters): Use `defvar' since it's sometimes modified.
+ (sgml-try-merge-special-case): Remove unused arg `pubid'.
+ (sgml-set-initial-state): Don't call obsolete make-local-hook.
+ (sgml-parse-until-end-of, sgml-parse-to, sgml-parse-continue):
+ Don't use dyn-bound vars as args.
+
+ * psgml-other.el: Require` psgml-parse'.
+
+ * psgml-maint.el (psgml-elisp-source): Use (featurep 'xemacs).
+ (psgml-compile-files): Avoid `interactive-p'.
+ (psgml-install-elc): Remove unused var `destdir'.
+
+ * psgml-lucid.el: Explicitly require `cl'.
+
+ * psgml-info.el (sgml-eltype-refrenced-elements): Avoid add-to-list.
+
+ * psgml-fs.el (fs-add-output, fs-setup-buffer, fs-wrapper):
+ Use with-current-buffer.
+ (fs-do-style): Don't use dyn-bound vars as args. Use
with-current-buffer.
+
+ * psgml-edit.el (sgml-completion-table): Remove unused arg
+ `avoid-tags-in-cdata'.
+ (sgml-attribute-buffer): Use with-current-buffer.
+ (sgml-make-character-reference): Use match-string and string-to-number.
+ (sgml-edit-external-entity): Remove unused var `buffer'.
+ Use with-current-buffer. Silence spurious warning.
+ (sgml-append-to-help-bufferm, sgml-print-attlist, sgml-show-structure):
+ Use with-current-buffer.
+ (sgml-print-position-in-model): Remove unused arg `element-type'.
+
+ * psgml-dtd.el (sgml-reduce-\,): Escape the comma in the name.
+ (sgml-write-dtd): Don't set obsolete `file-type'.
+
+ * psgml-debug.el (sgml-auto-dump, test-sgml): Use with-current-buffer.
+
+ * .gitignore: Add auto-generated ELPA files.
+
+ * psgml-api.el (sgml-parse-data): Don't use dyn-bound vars as args.
+
2008-12-16 Lennart Staflin <le...@lysator.liu.se>
* psgml-dtd.el (sgml-parse-character-reference): string-to-int ->
diff --git a/lisp/psgml-api.el b/lisp/psgml-api.el
index b3aa8cf..db68062 100644
--- a/lisp/psgml-api.el
+++ b/lisp/psgml-api.el
@@ -86,9 +86,12 @@ Also calling DATA-FUN, if non-nil, with data in content."
(sgml-parse-data main-buffer-max data-fun pi-fun entity-fun)
(setq c (sgml-tree-next c)))))))))
-(defun sgml-parse-data (sgml-goal sgml-data-function sgml-pi-function
- sgml-entity-function)
- (let ((sgml-throw-on-element-change 'el-done))
+(defun sgml-parse-data (goal data-function pi-function entity-function)
+ (let ((sgml-goal goal)
+ (sgml-data-function data-function)
+ (sgml-pi-function pi-function)
+ (sgml-entity-function entity-function)
+ (sgml-throw-on-element-change 'el-done))
(catch sgml-throw-on-element-change
(sgml-parse-continue sgml-goal nil t))))
diff --git a/lisp/psgml-debug.el b/lisp/psgml-debug.el
index a6244bb..1282f4b 100644
--- a/lisp/psgml-debug.el
+++ b/lisp/psgml-debug.el
@@ -42,19 +42,12 @@
(sgml-dump-rec (sgml-pstate-top-tree sgml-buffer-parse-state))))
(defun sgml-auto-dump ()
- (let ((standard-output (get-buffer-create "*Dump*"))
- (cb (current-buffer)))
+ (when sgml-buffer-parse-state
+ (let ((standard-output (get-buffer-create "*Dump*")))
+ (with-current-buffer standard-output
+ (erase-buffer))
- (when sgml-buffer-parse-state
- (unwind-protect
- (progn (set-buffer standard-output)
- (erase-buffer))
- (set-buffer cb))
-
- (sgml-dump-rec (sgml-pstate-top-tree sgml-buffer-parse-state))
-
- ))
- )
+ (sgml-dump-rec (sgml-pstate-top-tree sgml-buffer-parse-state)))))
(defun sgml-start-auto-dump ()
(interactive)
@@ -118,7 +111,7 @@
)
(eval-when (load)
- (unless sgml-running-lucid
+ (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))
@@ -272,8 +265,7 @@
(princ errcode)
(terpri)))
(if (get-buffer sgml-log-buffer-name)
- (princ (save-excursion
- (set-buffer sgml-log-buffer-name)
+ (princ (with-current-buffer sgml-log-buffer-name
(buffer-string))))
(terpri)
(terpri)
diff --git a/lisp/psgml-dtd.el b/lisp/psgml-dtd.el
index 6e84817..bd165b0 100644
--- a/lisp/psgml-dtd.el
+++ b/lisp/psgml-dtd.el
@@ -217,7 +217,7 @@ Syntax: var dfa-expr &body forms"
(defun sgml-make-pcdata ()
(sgml-make-* (sgml-make-primitive-content-token sgml-pcdata-token)))
-(defun sgml-reduce-, (l)
+(defun sgml-reduce-\, (l)
(while (cdr l)
(setcar (cdr l)
(sgml-make-conc (car l) (cadr l)))
@@ -336,7 +336,7 @@ Syntax: var dfa-expr &body forms"
(defsubst sgml-parse-connector ()
(sgml-skip-ps)
(cond ((sgml-parse-delim "SEQ")
- (function sgml-reduce-,))
+ (function sgml-reduce-\,))
((sgml-parse-delim "OR")
(function sgml-reduce-|))
((sgml-parse-delim "AND")
@@ -1007,7 +1007,6 @@ Construct the binary coded DTD (bdtd) in the current
buffer."
"(sgml-saved-dtd-version 7)\n")
(let ((print-escape-multibyte t))
(sgml-code-dtd dtd))
- (set 'file-type 1)
(let ((coding-system-for-write 'no-conversion))
(write-region (point-min) (point-max) file)))
diff --git a/lisp/psgml-edit.el b/lisp/psgml-edit.el
index 212efad..2c6bdc6 100644
--- a/lisp/psgml-edit.el
+++ b/lisp/psgml-edit.el
@@ -257,12 +257,15 @@ a list using attlist TO."
;;;; SGML mode: folding
+;; FIXME: Replace use of `selective-display' with overlays!
+
(defun sgml-fold-region (beg end &optional unhide)
"Hide (or if prefixarg unhide) region.
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)
@@ -580,7 +583,7 @@ Deprecated: ELEMENT"
(sgml-element-context-string el)))))
-(defun sgml-show-context-backslash (el &optional markup-type)
+(defun sgml-show-context-backslash (el &optional _markup-type)
(let ((gis nil))
(while (not (sgml-off-top-p el))
(push (sgml-element-gi el) gis)
@@ -808,7 +811,7 @@ AVL should be a assoc list mapping symbols to strings."
(setq quote "'")))
(concat quote value quote)))
-(defun sgml-completion-table (&optional avoid-tags-in-cdata)
+(defun sgml-completion-table ()
(sgml-parse-to-here)
(when sgml-markup-type
(error "No tags allowed"))
@@ -869,7 +872,7 @@ AVL should be a assoc list mapping symbols to strings."
;; Concoct an attribute specification list using the names of the
;; existing attributes and those ot be changed.
(when (and (not attlist) sgml-dtd-less)
- (dolist (elt (mapcar 'car asl))
+ (dolist (elt (mapcar #'car asl))
(unless (assoc elt attlist) ; avoid duplicates
(push (sgml-make-attdecl elt 'CDATA 'REQUIRED) attlist)))
(setq attlist (nreverse attlist)))
@@ -906,7 +909,7 @@ CURVALUE is nil or a string that will be used as default
value."
(cond ((or tokens notations)
(let ((completion-ignore-case sgml-namecase-general))
(completing-read prompt
- (mapcar 'list (or tokens notations))
+ (mapcar #'list (or tokens notations))
nil t)))
(ids
(let ((completion-ignore-case sgml-namecase-general)
@@ -1449,11 +1452,10 @@ Editing is done in a separate window."
(let ((bname "*Edit attributes*")
(buf nil)
(inhibit-read-only t))
- (save-excursion
- (when (setq buf (get-buffer bname))
- (kill-buffer buf))
- (setq buf (get-buffer-create bname))
- (set-buffer buf)
+ (when (setq buf (get-buffer bname))
+ (kill-buffer buf))
+ (setq buf (get-buffer-create bname))
+ (with-current-buffer buf
(erase-buffer)
(sgml-edit-attrib-mode)
(make-local-variable 'sgml-attlist)
@@ -1902,8 +1904,7 @@ characters in the current coding system."
(invert
(or (looking-at "&#\\([0-9]+\\)[;\n]?")
(error "No character reference after point"))
- (let ((c (string-to-int (buffer-substring (match-beginning 1)
- (match-end 1)))))
+ (let ((c (string-to-number (match-string 1))))
(delete-region (match-beginning 0)
(match-end 0))
(if (fboundp 'decode-char) ; Emacs 21, Mule-UCS
@@ -1965,7 +1966,7 @@ characters in the current coding system."
;; Function contributed by Matthias Clasen <cla...@netzservice.de>
(defun sgml-edit-external-entity ()
- "Open a new window and display the external entity at the point."
+ "Open a new window and display the external entity at the point."
(interactive)
(sgml-need-dtd)
(save-excursion
@@ -1982,7 +1983,6 @@ characters in the current coding system."
(sgml-dtd-entities
(sgml-pstate-dtd
sgml-buffer-parse-state))))
- (buffer nil)
(ppos nil))
(unless entity
(error "Undefined entity %s" ename))
@@ -1996,8 +1996,7 @@ characters in the current coding system."
(progn
(message (format "Using '%s' to handle notation '%s'."
handler notation))
- (save-excursion
- (set-buffer (get-buffer-create "*SGML background*"))
+ (with-current-buffer (get-buffer-create "*SGML background*")
(erase-buffer)
(let* ((file (sgml-external-file
(sgml-entity-text entity)
@@ -2008,7 +2007,8 @@ characters in the current coding system."
nil handler file)))
(if (fboundp 'set-process-query-on-exit-flag)
(set-process-query-on-exit-flag process nil)
- (process-kill-without-query process)))))
+ (with-no-warnings
+ (process-kill-without-query process))))))
(error "Don't know how to handle notation '%s'." notation)))
(text (progn
@@ -2209,8 +2209,7 @@ will reset the variable.")
(force-mode-line-update))
(defun sgml-append-to-help-buffer (string)
- (save-excursion
- (set-buffer "*Help*")
+ (with-current-buffer "*Help*"
(let ((inhibit-read-only t))
(goto-char (point-max))
(insert "\n" string))))
@@ -2327,7 +2326,7 @@ otherwise it will be added at the first legal position."
(princ (if (sgml-eltype-mixed et)
"mixed\n"
"element\n"))
- (sgml-print-position-in-model el et (point) sgml-current-state)
+ (sgml-print-position-in-model el (point) sgml-current-state)
(princ "\n\n")
(sgml-princ-names
(mapcar #'symbol-name (sgml-eltype-refrenced-elements et))
@@ -2357,45 +2356,42 @@ otherwise it will be added at the first legal position."
(when (memq et (sgml-eltype-refrenced-elements cand))
(push cand occurs-in))))
(sgml-pstate-dtd sgml-buffer-parse-state))
- (sgml-princ-names (mapcar 'sgml-eltype-name
+ (sgml-princ-names (mapcar #'sgml-eltype-name
(sort occurs-in (function
string-lessp))))))))
(defun sgml-print-attlist (et)
- (let ((ob (current-buffer)))
- (set-buffer standard-output)
- (unwind-protect
- (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)
- 'NOTATION)
- "#NOTATION (" "(")
- (mapconcat (function identity)
- (second dval)
- "|")
- ")")))
- (indent-to 15 1)
- (princ dval)
- (cond ((sgml-default-value-type-p 'FIXED defl)
- (setq defl (format "#FIXED '%s'"
- (sgml-default-value-attval defl))))
- ((symbolp defl)
- (setq defl (upcase (format "#%s" defl))))
- (t
- (setq defl (format "'%s'"
- (sgml-default-value-attval defl)))))
-
- (indent-to 48 1)
- (princ defl)
- (terpri)))
- (set-buffer ob))))
-
-
-(defun sgml-print-position-in-model (element element-type buffer-pos
parse-state)
+ (with-current-buffer standard-output
+ (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)
+ 'NOTATION)
+ "#NOTATION (" "(")
+ (mapconcat (function identity)
+ (second dval)
+ "|")
+ ")")))
+ (indent-to 15 1)
+ (princ dval)
+ (cond ((sgml-default-value-type-p 'FIXED defl)
+ (setq defl (format "#FIXED '%s'"
+ (sgml-default-value-attval defl))))
+ ((symbolp defl)
+ (setq defl (upcase (format "#%s" defl))))
+ (t
+ (setq defl (format "'%s'"
+ (sgml-default-value-attval defl)))))
+
+ (indent-to 48 1)
+ (princ defl)
+ (terpri)))))
+
+
+(defun sgml-print-position-in-model (element buffer-pos parse-state)
(let ((u (sgml-element-content element))
(names nil))
(while (and u (>= buffer-pos (sgml-element-end u)))
@@ -2412,7 +2408,7 @@ otherwise it will be added at the first legal position."
collect (sgml-eltype-name (car required))
do (setq state (sgml-get-move state (car required)))))
(last-alt
- (mapcar 'sgml-eltype-name
+ (mapcar #'sgml-eltype-name
(append (sgml-optional-tokens state)
(sgml-required-tokens state)))))
(cond
@@ -2445,8 +2441,7 @@ otherwise it will be added at the first legal position."
(occur-mode)
(erase-buffer)
(let ((structure
- (save-excursion
- (set-buffer source)
+ (with-current-buffer source
(sgml-structure-elements (sgml-top-element)))))
(sgml-show-structure-insert structure))
(goto-char (point-min))
diff --git a/lisp/psgml-fs.el b/lisp/psgml-fs.el
index 6c63e04..c5eb7e7 100644
--- a/lisp/psgml-fs.el
+++ b/lisp/psgml-fs.el
@@ -92,8 +92,7 @@
(defvar fs-title)
(defun fs-add-output (str &optional just)
- (save-excursion
- (set-buffer fs-buffer)
+ (with-current-buffer fs-buffer
(goto-char (point-max))
(let ((start (point)))
(insert str)
@@ -213,54 +212,54 @@ The value can be the style-sheet list, or it can be a
file name
(cdr (or (assoc (sgml-element-gi e) fs-style)
(assq t fs-style)))))
-(defun fs-do-style (fs-current-element style)
- (let ((hang-from (eval (plist-get style 'hang-from))))
- (when hang-from
- (setq fs-hang-from
- (format "%s%s "
- (make-string
- (or (fs-char 'hang-left) (fs-char 'left))
- ? )
- hang-from))))
- (let ((fs-char (nconc
- (loop for st on style by 'cddr
- unless (memq (car st) fs-special-styles)
- collect (cons (car st)
- (eval (cadr st))))
- fs-char)))
- (when (plist-get style 'block)
- (fs-para)
- (fs-addvspace (or (plist-get style 'top)
- (fs-char 'default-top))))
- (let ((before (plist-get style 'before)))
- (when before
- (fs-do-style e before)))
- (let ((fs-style
- (append (plist-get style 'sub-style)
- fs-style)))
- (cond ((plist-get style 'text)
- (let ((text (eval (plist-get style 'text))))
- (when (stringp text)
- (fs-paraform-data text))))
- (t
- (sgml-map-content e
- (function fs-engine)
- (function fs-paraform-data)
- nil
- (function fs-paraform-entity)))))
- (let ((title (plist-get style 'title)))
- (when title
- (setq title (eval title))
- (save-excursion
- (set-buffer fs-buffer)
- (setq fs-title title))))
- (let ((after (plist-get style 'after)))
- (when after
- (fs-do-style e after)))
- (when (plist-get style 'block)
- (fs-para)
- (fs-addvspace (or (plist-get style 'bottom)
- (fs-char 'default-bottom))))))
+(defun fs-do-style (e style)
+ (let ((fs-current-element e))
+ (let ((hang-from (eval (plist-get style 'hang-from))))
+ (when hang-from
+ (setq fs-hang-from
+ (format "%s%s "
+ (make-string
+ (or (fs-char 'hang-left) (fs-char 'left))
+ ? )
+ hang-from))))
+ (let ((fs-char (nconc
+ (loop for st on style by 'cddr
+ unless (memq (car st) fs-special-styles)
+ collect (cons (car st)
+ (eval (cadr st))))
+ fs-char)))
+ (when (plist-get style 'block)
+ (fs-para)
+ (fs-addvspace (or (plist-get style 'top)
+ (fs-char 'default-top))))
+ (let ((before (plist-get style 'before)))
+ (when before
+ (fs-do-style e before)))
+ (let ((fs-style
+ (append (plist-get style 'sub-style)
+ fs-style)))
+ (cond ((plist-get style 'text)
+ (let ((text (eval (plist-get style 'text))))
+ (when (stringp text)
+ (fs-paraform-data text))))
+ (t
+ (sgml-map-content e
+ (function fs-engine)
+ (function fs-paraform-data)
+ nil
+ (function fs-paraform-entity)))))
+ (let ((title (plist-get style 'title)))
+ (when title
+ (setq title (eval title))
+ (with-current-buffer fs-buffer
+ (setq fs-title title))))
+ (let ((after (plist-get style 'after)))
+ (when after
+ (fs-do-style e after)))
+ (when (plist-get style 'block)
+ (fs-para)
+ (fs-addvspace (or (plist-get style 'bottom)
+ (fs-char 'default-bottom)))))))
(defun fs-clear ()
@@ -272,9 +271,8 @@ The value can be the style-sheet list, or it can be a file
name
(defun fs-setup-buffer ()
- (save-excursion
(let ((orig-filename (buffer-file-name (current-buffer))))
- (set-buffer fs-buffer)
+ (with-current-buffer fs-buffer
(erase-buffer)
(setq ps-left-header
'(fs-title fs-filename))
@@ -290,8 +288,7 @@ The value can be the style-sheet list, or it can be a file
name
(fs-setup-buffer)
(funcall thunk)
(fs-para)
- (save-excursion
- (set-buffer fs-buffer)
+ (with-current-buffer fs-buffer
(goto-char (point-min)))
fs-buffer))
diff --git a/lisp/psgml-info.el b/lisp/psgml-info.el
index 08c2992..6e160a7 100644
--- a/lisp/psgml-info.el
+++ b/lisp/psgml-info.el
@@ -119,7 +119,7 @@
(loop for m in (append (sgml-state-opts (car agenda))
(sgml-state-reqs (car agenda)))
do
- (add-to-list 'res (sgml-move-token m))
+ (pushnew (sgml-move-token m) res :test #'equal)
(sgml-add-last-unique (sgml-move-dest m) states)))
(t ; &-node
@@ -241,7 +241,7 @@
;;;; Display table
-(defun sgml-display-table (table title col-title1 col-title2
+(defun sgml-display-table (table _title col-title1 col-title2
&optional width nosort dual-table
col1-describe)
(or width
@@ -495,11 +495,11 @@
(fmt "%20s %s\n")
(hdr ""))
- (sgml-map-eltypes (function (lambda (e) (incf elements)))
+ (sgml-map-eltypes (function (lambda (_e) (incf elements)))
sgml-dtd-info)
- (sgml-map-entities (function (lambda (e) (incf entities)))
+ (sgml-map-entities (function (lambda (_e) (incf entities)))
(sgml-dtd-entities sgml-dtd-info))
- (sgml-map-entities (function (lambda (e) (incf parameters)))
+ (sgml-map-entities (function (lambda (_e) (incf parameters)))
(sgml-dtd-parameters sgml-dtd-info))
(with-output-to-temp-buffer (help-buffer)
diff --git a/lisp/psgml-lucid.el b/lisp/psgml-lucid.el
index bf9f000..b1b3f8e 100644
--- a/lisp/psgml-lucid.el
+++ b/lisp/psgml-lucid.el
@@ -36,6 +36,7 @@
(eval-and-compile
(autoload 'sgml-do-set-option "psgml-edit"))
+(eval-when-compile (require 'cl))
(defvar sgml-max-menu-size (/ (* (frame-height) 2) 3)
"*Max number of entries in Tags and Entities menus before they are split
diff --git a/lisp/psgml-maint.el b/lisp/psgml-maint.el
index aebb9e9..89825c9 100644
--- a/lisp/psgml-maint.el
+++ b/lisp/psgml-maint.el
@@ -48,8 +48,7 @@
(defconst psgml-elisp-source
(append psgml-common-files
- (cond ((or (string-match "Lucid" emacs-version)
- (string-match "XEmacs" emacs-version))
+ (cond ((featurep 'xemacs)
psgml-xemacs-files)
(t
psgml-emacs-files))))
@@ -74,14 +73,13 @@
(error "No psgml source in current directory"))))))
-(defun psgml-compile-files ()
+(defun psgml-compile-files (&optional interactive-p)
"Compile the PSGML source files that needs compilation."
- (interactive)
- (psgml-find-source-dir (interactive-p))
+ (interactive (list t))
+ (psgml-find-source-dir interactive-p)
(let ((default-directory psgml-source-dir)
(load-path (cons psgml-source-dir load-path)))
- (mapcar (function psgml-byte-compile-file)
- psgml-elisp-source)
+ (mapc #'psgml-byte-compile-file psgml-elisp-source)
(message "Done compiling")))
@@ -91,10 +89,8 @@
(byte-compile-file file))))
(defun psgml-install-elc ()
- "Print list of elc files to install"
- (let ((destdir (car command-line-args-left)))
- (princ (mapconcat (function byte-compile-dest-file)
- psgml-elisp-source " "))))
+ "Print list of elc files to install."
+ (princ (mapconcat #'byte-compile-dest-file psgml-elisp-source " ")))
;;; psgml-maint.el ends here
diff --git a/lisp/psgml-other.el b/lisp/psgml-other.el
index 8ecead8..8eaa25f 100644
--- a/lisp/psgml-other.el
+++ b/lisp/psgml-other.el
@@ -29,6 +29,7 @@
;;;; Code:
(require 'psgml)
+(require 'psgml-parse)
(require 'easymenu)
(eval-when-compile (require 'cl))
@@ -140,8 +141,7 @@ Overlays are significantly less efficient in large
buffers.")
(when (not modified)
(sgml-restore-buffer-modified-p nil))))))
-(eval-when-compile
- (defvar sgml-parse-in-loop))
+(defvar sgml-parse-in-loop)
(defun sgml-set-face-for (start end type)
(let ((face (cdr (assq type sgml-markup-faces))))
@@ -188,7 +188,7 @@ Overlays are significantly less efficient in large
buffers.")
(overlay-put old-overlay 'sgml-type type)
(overlay-put old-overlay 'face face))))))))
-(defun sgml-set-face-after-change (start end &optional pre-len)
+(defun sgml-set-face-after-change (start end &optional _pre-len)
;; If inserting in front of an markup overlay, move that overlay.
;; this avoids the overlay beeing deleted and recreated by
;; sgml-set-face-for.
diff --git a/lisp/psgml-parse.el b/lisp/psgml-parse.el
index 29337cf..fcbaf49 100644
--- a/lisp/psgml-parse.el
+++ b/lisp/psgml-parse.el
@@ -354,21 +354,16 @@ Applicable to XML.")
(sgml-restore-buffer-modified-p buffer-modified)
(sgml-debug "Restoring buffer mod: %s" buffer-modified))))
-(eval-when-compile (defvar mc-flag))
+(defvar mc-flag)
(defun sgml-set-buffer-multibyte (flag)
(cond ((featurep 'xemacs)
flag)
- ((and (boundp 'emacs-major-version) (>= emacs-major-version 20))
+ (t
(set-buffer-multibyte
(if (eq flag 'default)
- default-enable-multibyte-characters
- flag)))
- ;; I doubt the current code works in old Mule anyway. -- fx
- ((boundp 'MULE)
- (set 'mc-flag flag))
- (t
- flag)))
+ (default-value 'enable-multibyte-characters)
+ flag)))))
;; Probably better. -- fx
;; (eval-and-compile
;; (if (fboundp 'set-buffer-multibyte)
@@ -1173,7 +1168,7 @@ or 2: two octets (n,m) interpreted as (n-t-1)*256+m+t."
(file-name-nondirectory tem)))))
(setq sgml-loaded-dtd nil) ; Allow reloading of DTD
;; Search for 'file' on the sgml-system-path [ndw]
- (let ((real-file (car (apply 'nconc
+ (let ((real-file (car (apply #'nconc
(mapcar (lambda (dir)
(let ((f (expand-file-name file dir)))
(if (file-exists-p f)
@@ -1184,9 +1179,7 @@ or 2: two octets (n,m) interpreted as (n-t-1)*256+m+t."
(let ((cb (current-buffer))
(tem nil)
(dtd nil)
- (l (buffer-list))
- (find-file-type ; Allways binary
- (function (lambda (fname) 1))))
+ (l (buffer-list)))
;; Search loaded buffer for a already loaded DTD
(while (and l (null tem))
(set-buffer (car l))
@@ -1227,9 +1220,7 @@ settings in ENTS."
(sgml-debug "Trying to load compiled DTD from %s..." cfile)
(sgml-set-buffer-multibyte nil)
(or (and (file-readable-p cfile)
- (let ((find-file-type ; Always binary
- (function (lambda (fname) 1)))
- (coding-system-for-read 'binary))
+ (let ((coding-system-for-read 'binary))
;; fifth arg to insert-file-contents is not available in early
;; v19.
(insert-file-contents cfile nil nil nil))
@@ -1354,7 +1345,7 @@ ends at point."
;;;; Parsing delimiters
(eval-and-compile
- (defconst sgml-delimiters
+ (defvar sgml-delimiters
'("AND" "&"
"COM" "--"
"CRO" "&#"
@@ -2473,7 +2464,7 @@ text. Otherwise buffer position will be after entity
reference."
(ents (cdr ce)))
(sgml-debug "Found %s" cfile)
(if (sgml-use-special-case)
- (sgml-try-merge-special-case pubid file cfile ents)
+ (sgml-try-merge-special-case file cfile ents)
(and (sgml-bdtd-load cfile file ents)
(sgml-bdtd-merge)))))))
@@ -2482,7 +2473,7 @@ text. Otherwise buffer position will be after entity
reference."
(sgml-eltype-table-empty (sgml-dtd-eltypes sgml-dtd-info))
(eq 'dtd (sgml-entity-type (sgml-eref-entity sgml-current-eref)))))
-(defun sgml-try-merge-special-case (pubid file cfile ents)
+(defun sgml-try-merge-special-case (file cfile ents)
(let (cdtd)
(sgml-debug "Merging special case")
;; Look for a compiled dtd in some other buffer
@@ -2837,7 +2828,7 @@ overrides the entity type in entity look up."
;;;; Display and Mode-line
-(eval-when-compile (defvar which-func-mode))
+(defvar which-func-mode)
(defun sgml-update-display ()
(when (not (eq this-command 'keyboard-quit))
@@ -2927,8 +2918,6 @@ overrides the entity type in entity look up."
(defun sgml-set-initial-state (dtd)
"Set initial state of parsing."
- (make-local-hook 'before-change-functions)
- (make-local-hook 'after-change-functions)
(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
@@ -3117,7 +3106,7 @@ entity hierarchy as possible."
(defun sgml-fake-close-element (tree)
(sgml-tree-parent tree))
-(defun sgml-note-change-at (at &optional end)
+(defun sgml-note-change-at (at &optional _end)
;; Inform the cache that there have been some changes after AT
(when sgml-buffer-parse-state
(sgml-debug "sgml-note-change-at %s" at)
@@ -3282,7 +3271,7 @@ Where the latter represents end-tags."
(point-max))))))
(defun sgml-log-message (format &rest things)
- (let ((mess (apply 'format format things))
+ (let ((mess (apply #'format format things))
(buf (get-buffer-create sgml-log-buffer-name))
(cb (current-buffer)))
(set-buffer buf)
@@ -3343,10 +3332,10 @@ To avoid clearing message with out showing previous
warning.")
(defun sgml-log-warning (format &rest things)
(when sgml-throw-on-warning
- (apply 'message format things)
+ (apply #'message format things)
(throw sgml-throw-on-warning t))
(when (or sgml-show-warnings sgml-parsing-dtd)
- (apply 'sgml-message format things)
+ (apply #'sgml-message format things)
(setq sgml-warning-message-flag t)))
@@ -3354,7 +3343,7 @@ To avoid clearing message with out showing previous
warning.")
(when sgml-throw-on-error
(throw sgml-throw-on-error nil))
(setq sgml-warning-message-flag nil)
- (error "%s%s" (apply 'format format things )
+ (error "%s%s" (apply #'format format things )
(sgml-entity-stack)))
@@ -3379,11 +3368,11 @@ To avoid clearing message with out showing previous
warning.")
(defun sgml-parse-warning (format &rest things)
- (message "%s%s" (apply 'format format things) (sgml-entity-stack))
+ (message "%s%s" (apply #'format format things) (sgml-entity-stack))
(setq sgml-warning-message-flag t))
(defun sgml-parse-error (format &rest things)
- (apply 'sgml-error
+ (apply #'sgml-error
(concat format "; at: %s")
(append things (list (buffer-substring-no-properties
(point)
@@ -3393,7 +3382,7 @@ To avoid clearing message with out showing previous
warning.")
(unless (and (or (equal format "")
(string-match "\\.\\.done$" format))
sgml-warning-message-flag)
- (apply 'message format things)
+ (apply #'message format things)
(setq sgml-warning-message-flag nil)))
@@ -3404,7 +3393,7 @@ To avoid clearing message with out showing previous
warning.")
(defun sgml-lazy-message (&rest args)
(unless (= sgml-lazy-time (second (current-time)))
- (apply 'message args)
+ (apply #'message args)
(setq sgml-lazy-time (second (current-time)))))
@@ -4016,50 +4005,53 @@ Either from parent document or by parsing the document
prolog."
(sgml-message "Parsing prolog...done"))
-(defun sgml-parse-until-end-of (sgml-close-element-trap &optional
- cont extra-cond quiet)
- "Parse until the SGML-CLOSE-ELEMENT-TRAP has ended.
+(defun sgml-parse-until-end-of (close-element-trap &optional
+ cont extra-cond quiet)
+ "Parse until the CLOSE-ELEMENT-TRAP has ended.
Or if it is t, any additional element has ended,
or if nil, until end of buffer."
- (sgml-debug "-> sgml-parse-until-end-of")
- (cond
- (cont (sgml-parse-continue (point-max)))
- (t (sgml-parse-to (point-max) extra-cond quiet)))
- (when (eobp) ; End of buffer, can imply
+ (let ((sgml-close-element-trap close-element-trap))
+ (sgml-debug "-> sgml-parse-until-end-of")
+ (cond
+ (cont (sgml-parse-continue (point-max)))
+ (t (sgml-parse-to (point-max) extra-cond quiet)))
+ (when (eobp) ; End of buffer, can imply
; end of any open element.
- (while (prog1 (not
- (or (eq sgml-close-element-trap t)
- (eq sgml-close-element-trap sgml-current-tree)
- (eq sgml-current-tree sgml-top-tree)))
- (sgml-implied-end-tag "buffer end" (point) (point)))))
- (sgml-debug "<- sgml-parse-until-end-of"))
-
-(defun sgml-parse-to (sgml-goal &optional extra-cond quiet)
- "Parse until (at least) SGML-GOAL.
+ (while (prog1 (not
+ (or (eq sgml-close-element-trap t)
+ (eq sgml-close-element-trap sgml-current-tree)
+ (eq sgml-current-tree sgml-top-tree)))
+ (sgml-implied-end-tag "buffer end" (point) (point)))))
+ (sgml-debug "<- sgml-parse-until-end-of")))
+
+(defun sgml-parse-to (goal &optional extra-cond quiet)
+ "Parse until (at least) GOAL.
Optional argument EXTRA-COND should be a function. This function is
called in the parser loop, and the loop is exited if the function returns t.
If third argument QUIET is non-nil, no \"Parsing...\" message will be
displayed."
- (sgml-need-dtd)
- (sgml-with-parser-syntax-ro
- (sgml-goto-start-point (min sgml-goal (point-max)))
- (setq quiet (or quiet (< (- sgml-goal (sgml-mainbuf-point)) 500)))
- (unless quiet
- (sgml-message "Parsing..."))
- (sgml-parser-loop extra-cond)
- (unless quiet
- (sgml-message ""))))
-
-(defun sgml-parse-continue (sgml-goal &optional extra-cond quiet)
- "Parse until (at least) SGML-GOAL."
- (assert sgml-current-tree)
- (unless quiet
- (sgml-message "Parsing..."))
- (sgml-debug "Parse continue")
- (sgml-with-parser-syntax-ro
- (set-buffer sgml-last-buffer)
- (sgml-parser-loop extra-cond))
- (unless quiet
- (sgml-message "")))
+ (let ((sgml-goal goal))
+ (sgml-need-dtd)
+ (sgml-with-parser-syntax-ro
+ (sgml-goto-start-point (min sgml-goal (point-max)))
+ (setq quiet (or quiet (< (- sgml-goal (sgml-mainbuf-point)) 500)))
+ (unless quiet
+ (sgml-message "Parsing..."))
+ (sgml-parser-loop extra-cond)
+ (unless quiet
+ (sgml-message "")))))
+
+(defun sgml-parse-continue (goal &optional extra-cond quiet)
+ "Parse until (at least) GOAL."
+ (let ((sgml-goal goal))
+ (assert sgml-current-tree)
+ (unless quiet
+ (sgml-message "Parsing..."))
+ (sgml-debug "Parse continue")
+ (sgml-with-parser-syntax-ro
+ (set-buffer sgml-last-buffer)
+ (sgml-parser-loop extra-cond))
+ (unless quiet
+ (sgml-message ""))))
(defun sgml-reparse-buffer (shortref-fun)
"Reparse the buffer and let SHORTREF-FUN take care of short references.
diff --git a/lisp/psgml-sysdep.el b/lisp/psgml-sysdep.el
index 4fcc2f9..9aa482b 100644
--- a/lisp/psgml-sysdep.el
+++ b/lisp/psgml-sysdep.el
@@ -3,7 +3,7 @@
(require 'psgml)
(cond
- (sgml-running-lucid
+ ((featurep 'xemacs)
(require 'psgml-lucid))
(t
(require 'psgml-other)))
diff --git a/lisp/psgml-xpr.el b/lisp/psgml-xpr.el
index b286d7b..f75677f 100644
--- a/lisp/psgml-xpr.el
+++ b/lisp/psgml-xpr.el
@@ -39,10 +39,9 @@
(eval-when-compile
(unless (member "JSP-STAGO" sgml-delimiters)
(setq sgml-delimiters
- (list*
- "JSP-STAGO" "<%"
- "JSP-TAGC" "%>"
- sgml-delimiters))))
+ `("JSP-STAGO" "<%"
+ "JSP-TAGC" "%>"
+ . ,sgml-delimiters))))
(defun psgml-parse-jps-tag ()
(when (sgml-parse-delim "JSP-STAGO")
diff --git a/lisp/psgml.el b/lisp/psgml.el
index 9bb64e1..957e5b5 100644
--- a/lisp/psgml.el
+++ b/lisp/psgml.el
@@ -8,6 +8,7 @@
;; James Clark <j...@clark.com>
;; Maintainer: Lennart Staflin <le...@lysator.liu.se>
;; Keywords: languages
+;; Version: 0
;;
;; This program is free software; you can redistribute it and/or
@@ -74,7 +75,6 @@
(define-abbrev-table 'sgml-mode-abbrev-table ())
(eval-and-compile
- (defconst sgml-running-lucid (string-match "Lucid" emacs-version))
(defconst sgml-have-re-char-clases (string-match "[[:alpha:]]" "x")
"Non-nil if this Emacs supports regexp character classes.
E.g. `[-.[:alnum:]]'."))
@@ -94,7 +94,7 @@ Otherwise put explicit properties.")
(not (natnump emacs-minor-version))
(and (eq emacs-major-version 19)
(< emacs-minor-version 23)))
- "*If non-nil, work around a bug in subst-char-in-region.
+ "*If non-nil, work around a bug in `subst-char-in-region'.
The bug sets the buffer modified. If this is set, folding commands
will be slower.")
@@ -121,22 +121,22 @@ This may be slow.")
;;; User settable options:
-(defun sgml-parse-colon-path (cd-path)
- "Explode a colon-separated list of paths into a string list."
- (if (null cd-path)
+(defun sgml-parse-colon-path (path)
+ "Explode a colon-separated list of directories PATH into a string list."
+ (if (null path)
nil
(let ((cd-sep ":")
cd-list (cd-start 0) cd-colon)
(if (boundp 'path-separator)
(setq cd-sep path-separator))
- (setq cd-path (concat cd-path cd-sep))
- (while (setq cd-colon (string-match cd-sep cd-path cd-start))
+ (setq path (concat path cd-sep))
+ (while (setq cd-colon (string-match cd-sep path cd-start))
(setq cd-list
(nconc cd-list
(list (if (= cd-start cd-colon)
nil
(substitute-in-file-name
- (substring cd-path cd-start cd-colon))))))
+ (substring path cd-start cd-colon))))))
(setq cd-start (+ cd-colon 1)))
cd-list)))
@@ -271,7 +271,7 @@ See `compilation-error-regexp-alist'.")
"Keymap for SGML mode")
(defvar sgml-show-context-function
- 'sgml-show-context-standard
+ #'sgml-show-context-standard
"*Function to called to show context of and element.
Should return a string suitable form printing in the echo area.")
@@ -429,7 +429,7 @@ as that may change."
(symbol-value hook)
(let ((value (symbol-value hook)))
(if (and (listp value) (not (eq (car value) 'lambda)))
- (mapcar '(lambda (foo) (apply foo args))
+ (mapcar (lambda (foo) (apply foo args))
value)
(apply value args))))))
@@ -464,7 +464,7 @@ as that may change."
(defun sgml-mouse-region ()
(let (start end)
(cond
- (sgml-running-lucid
+ ((featurep 'xemacs)
(cond
((null (mark-marker)) nil)
(t (setq start (region-beginning)
@@ -938,12 +938,7 @@ All bindings:
(make-local-variable 'text-property-default-nonsticky)
;; see `sgml-set-face-for':
(add-to-list 'text-property-default-nonsticky '(face . t)))
- (make-local-hook 'post-command-hook)
(add-hook 'post-command-hook 'sgml-command-post 'append 'local)
- (unless sgml-running-lucid
- ;; XEmacs 20.4 doesn't handle local activate-menubar-hook
- ;; it tries to call the function `t' when using the menubar
- (make-local-hook 'activate-menubar-hook))
(add-hook 'activate-menubar-hook 'sgml-update-all-options-menus
nil 'local)
(add-hook 'which-func-functions 'sgml-current-element-name nil t)
@@ -1164,7 +1159,7 @@ start tag, and the second / is the corresponding null end
tag."
thereis
(sgml-subst-expand template validate-subst))))
(t
- (apply 'format sgml-validate-command
+ (apply #'format sgml-validate-command
(if sgml-validate-files
(funcall sgml-validate-files)
(list (or sgml-declaration "")
