speedup for setting faces while parsing

Dave Love <[email protected]>
Newsgroups gmane.emacs.psgml.devel
Message-ID <rzq3bwhntis.fsf@loveshack>
[Sorry if this is a duplicate -- it doesn't seem to have got through
first time.]

I've submitted a patch to the Debian version which you may be
interested in.  It speeds up setting faces during parsing in Emacs by
hoisting stuff out of the loop; it won't have any effect in XEmacs.
See <URL:http://bugs.debian.org/292867>.  The changes are against the
Debian source, but I expect they will apply to 1.3.1 directly.
psgml-1.3.1-debian.diff (text/x-patch, 3.7 KB)
Changes to speed up parsing under Emacs when setting faces.  They're
against the Debian version of psgml-1.3.1, but probably apply generally.
Also avoid warnings.

2005-01-28  Dave Love  <[email protected]>

	* psgml-other.el (sgml-parse-in-loop): Defvar when compiling.
	(sgml-set-face-for): Use sgml-parse-in-loop.

	* psgml-dtd.el (sgml-write-dtd): Don't set file-type (unused).

	* psgml-parse.el (mc-flag, which-func-mode): Defvar when
	compiling.
	(sgml-parse-in-loop): New variable.
	(sgml-parser-loop): Use it and sgml-with-modification-state.

--- psgml-dtd.el	2005/01/28 12:32:58	1.1
+++ psgml-dtd.el	2005/01/28 12:42:54
@@ -1002,7 +1002,6 @@
    "(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)))
 
--- psgml-other.el	2005/01/28 12:29:37	1.1
+++ psgml-other.el	2005/01/28 13:01:11
@@ -139,11 +139,20 @@
 	 (when (not modified)
 	   (sgml-restore-buffer-modified-p nil))))))
 
+(eval-when-compile
+  (defvar sgml-parse-in-loop))
+
 (defun sgml-set-face-for (start end type)
   (let ((face (cdr (assq type sgml-markup-faces))))
     (cond
      (sgml-use-text-properties
-      (sgml-with-modification-state
+      ;; `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))))
 	(put-text-property start end 'face face)
         (when (and sgml-default-nonsticky (< start end))
           (put-text-property (1- end) end 'rear-nonsticky '(face)))))
--- psgml-parse.el	2005/01/28 12:29:37	1.1
+++ psgml-parse.el	2005/01/28 12:56:28
@@ -349,6 +349,8 @@
          (sgml-restore-buffer-modified-p buffer-modified)
          (sgml-debug "Restoring buffer mod: %s" buffer-modified)))))
 
+(eval-when-compile (defvar mc-flag))
+
 (defun sgml-set-buffer-multibyte (flag)
   (cond ((featurep 'xemacs)
          flag)
@@ -357,6 +359,7 @@
           (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
@@ -2854,6 +2857,8 @@
 	 (message "Fontifying...done"))
      (error nil))))
 
+(eval-when-compile (defvar which-func-mode))
+
 (defun sgml-set-active-dtd-indicator (name)
   ;; At least when using the which-func machinery, don't show anything
   ;; unless `sgml-live-element-indicator' is non-nil.
@@ -4044,9 +4049,16 @@
   (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)))
+	(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)
@@ -4091,7 +4103,7 @@
        ((and sgml-parser-loop-hook
              (run-hook-with-args-until-success 'sgml-parser-loop-hook)))
        (t
-	(sgml-do-pcdata))))))
+	(sgml-do-pcdata)))))))
 
 (defun sgml-handle-shortref (name)
   (sgml-set-markup-type 'shortref)
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.