Mercurial > emacs
changeset 83176:d5674d957cdc
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-447
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-448
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-449
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-216
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Sun, 11 Jul 2004 02:28:46 +0000 |
| parents | 257f5492d958 (current diff) e97dd6ea9f71 (diff) |
| children | 91cf385601e5 |
| files | lisp/ChangeLog lisp/simple.el |
| diffstat | 14 files changed, 521 insertions(+), 247 deletions(-) [+] |
line wrap: on
line diff
--- a/etc/NEWS Sat Jul 10 22:37:50 2004 +0000 +++ b/etc/NEWS Sun Jul 11 02:28:46 2004 +0000 @@ -2179,7 +2179,10 @@ * Lisp Changes in Emacs 21.4 ** If a command sets transient-mark-mode to `only', that -enables Transient Mark mode for the following command, only. +enables Transient Mark mode for the following command only. +During that following command, the value of transient-mark-mode +is `identity'. If it is still `identity' at the end of the command, +it changes to nil. +++ ** Cleaner way to enter key sequences.
--- a/lisp/ChangeLog Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/ChangeLog Sun Jul 11 02:28:46 2004 +0000 @@ -1,3 +1,60 @@ +2004-07-10 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * printing.el: Doc fix. Now it uses call-process instead of + shell-command for low command execution. + (pr-version): New version number (6.8). + (pr-shell-file-name): Option removed. + (pr-shell-command): Fun removed. + (pr-call-process): New fun. Replace pr-shell-command. + (pr-standard-path, pr-remove-nil-from-list): New funs. + (zmacs-region-stays, current-mouse-event, current-menubar): New var. + (pr-ps-file-preview, pr-ps-file-using-ghostscript, pr-ps-file-print) + (pr-setup, pr-ps-set-printer, pr-txt-set-printer) + (pr-ps-utility-process, pr-txt-print): Code fix. + +2004-07-10 Stephan Stahl <stahl@eos.franken.de> (tiny change) + + * ediff-mult.el (ediff-meta-truncate-filenames): Change type to + boolean. + +2004-07-09 Lars Hansen <larsh@math.ku.dk> + + * wid-edit.el (widget-field-buffer): Doc fix. + +2004-07-09 John Paul Wallington <jpw@gnu.org> + + * emacs-lisp/re-builder.el (reb-update-overlays): Distinguish + between one and several matches in message. + +2004-07-09 Richard M. Stallman <rms@gnu.org> + + * mouse.el (mouse-set-region-1): If transient-mark-mode + is `identity', change it to `only'. + + * simple.el (current-word): Doc fix. + +2004-07-09 Mark A. Hershberger <mah@everybody.org> + + * progmodes/cperl-mode.el (cperl-mode): Adapt defun-prompt-regexp + so that it is more understanding of whitespace. + + * xml.el (xml-maybe-do-ns, xml-parse-tag): Produce elements in the + form + (("ns" . "element") (attr-list) children) instead of + ((:ns . "element") (attr-list) children) in order to reduce the + number of symbols used. + (xml-skip-dtd): Change to use xml-parse-dtd but set + xml-validating-parsing to nil. + (xml-parse-dtd): Parse entity deleclarations in DOCTYPEs. + (xml-substitute-entity): Remove in favor of new entity substitution. + (xml-substitute-special): Rewrite in to substitute complex + entities from DOCTYPE declarations. + (xml-parse-fragment): Parse fragments from entity deleclarations. + (xml-parse-region, xml-parse-tag, xml-parse-attlist) + (xml-parse-dtd, xml-substitute-special): Make validity checks + conditioned on xml-validating-parser. Add "Not Well Formed" to + error messages about well-formedness. + 2004-07-08 Steven Tamm <steventamm@mac.com> * term/mac-win.el (mac-scroll-ignore-events, mac-scroll-down)
--- a/lisp/ediff-mult.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/ediff-mult.el Sun Jul 11 02:28:46 2004 +0000 @@ -200,7 +200,7 @@ (defcustom ediff-meta-truncate-filenames t "*If non-nil, truncate long file names in the session group buffers. This can be toggled with `ediff-toggle-filename-truncation'." - :type 'hook + :type 'boolean :group 'ediff-mult) (defcustom ediff-registry-setup-hook nil "*Hooks run just after the registry control panel is set up."
--- a/lisp/emacs-lisp/re-builder.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/emacs-lisp/re-builder.el Sun Jul 11 02:28:46 2004 +0000 @@ -670,9 +670,10 @@ (overlay-put overlay 'priority i))) (setq i (1+ i)))))) (let ((count (if subexp submatches matches))) - (message"%s %smatch(es)%s" + (message"%s %smatch%s%s" (if (= 0 count) "No" (int-to-string count)) (if subexp "subexpression " "") + (if (= 1 count) "" "es") (if (and reb-auto-match-limit (= reb-auto-match-limit count)) " (limit reached)" "")))
--- a/lisp/mouse.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/mouse.el Sun Jul 11 02:28:46 2004 +0000 @@ -625,7 +625,8 @@ (defun mouse-set-region-1 () ;; Set transient-mark-mode for a little while. - (setq transient-mark-mode (or transient-mark-mode 'only)) + (if (memq transient-mark-mode '(nil identity)) + (setq transient-mark-mode 'only)) (setq mouse-last-region-beg (region-beginning)) (setq mouse-last-region-end (region-end)) (setq mouse-last-region-tick (buffer-modified-tick)))
--- a/lisp/printing.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/printing.el Sun Jul 11 02:28:46 2004 +0000 @@ -3,18 +3,18 @@ ;; Copyright (C) 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. -;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> -;; Time-stamp: <2004/04/05 23:41:49 vinicius> +;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> +;; Time-stamp: <2004/07/10 18:48:24 vinicius> ;; Keywords: wp, print, PostScript -;; Version: 6.7.4 +;; Version: 6.8 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst pr-version "6.7.4" - "printing.el, v 6.7.4 <2004/03/31 vinicius> +(defconst pr-version "6.8" + "printing.el, v 6.8 <2004/07/10 vinicius> Please send all bug fixes and enhancements to - Vinicius Jose Latorre <vinicius@cpqd.com.br> + Vinicius Jose Latorre <viniciusjl@ig.com.br> ") ;; This file is part of GNU Emacs. @@ -40,10 +40,23 @@ ;; Introduction ;; ------------ ;; -;; This package provides some printing utilities that includes -;; previewing/printing a PostScript file, printing a text file and +;; This package provides an user interface to some printing utilities that +;; includes previewing/printing a PostScript file, printing a text file and ;; previewing/printing some major modes (like mh-folder-mode, -;; rmail-summary-mode, gnus-summary-mode, etc). +;; rmail-summary-mode, gnus-summary-mode, etc). It also includes a +;; PostScript/text printer database. +;; +;; Indeed, there are two user interfaces: +;; +;; * one is via menubar: +;; When `printing' is loaded, the menubar is modified to use `printing' +;; menu instead of the print options in menubar. +;; This is the default user interface. +;; +;; * other is via buffer interface: +;; It is an option of `printing' menu, but it can be binded into another +;; key, so user can activate the buffer interface directly without using +;; a menu. See `pr-interface' command. ;; ;; `printing' was inspired on: ;; @@ -172,7 +185,7 @@ ;; Tips ;; ---- ;; -;; 1. If your have a local printer, that is, a printer which is connected +;; 1. If you have a local printer, that is, a printer which is connected ;; directly to your computer, don't forget to connect the printer to your ;; computer before printing. ;; @@ -187,16 +200,26 @@ ;; another buffer and, then, print the file or the new static buffer. ;; An example of dynamic buffer is the *Messages* buffer. ;; -;; 4. When running Emacs on Windows with cygwin, check if the -;; `pr-shell-file-name' variable is set to the proper shell. This shell -;; will execute the commands to preview/print the buffer, file or directory. -;; Also check the setting of `pr-path-style' variable. -;; Probably, you should use: -;; -;; (setq pr-shell-file-name "bash") -;; (setq pr-path-style 'unix) -;; -;; And use / instead of \ when specifying a directory. +;; 4. When running Emacs on Windows (with or without cygwin), check if your +;; printer is a text printer or not by typing in a DOS window: +;; +;; print /D:\\host\printer somefile.txt +;; +;; Where, `host' is the machine where your printer is directly connected, +;; `printer' is the printer name and `somefile.txt' is a text file. +;; +;; If the printer `\\host\printer' doesn't print the content of +;; `somefile.txt' or, instead, it returns the following message: +;; +;; PostScript Error Handler +;; Offending Command = CCC +;; Stack = +;; +;; Where `CCC' is whatever is at the beginning of the text to be printed. +;; +;; Therefore, the printer `\\host\printer' is not a text printer, but a +;; PostScript printer. So, please, don't include this printer in +;; `pr-txt-printer-alist' (which see). ;; ;; ;; Using `printing' @@ -479,9 +502,6 @@ ;; `pr-buffer-verbose' Non-nil means to be verbose when editing a ;; field in interface buffer. ;; -;; `pr-shell-file-name' Specify file name to load inferior shells -;; from. -;; ;; To set the above options you may: ;; ;; a) insert the code in your ~/.emacs, like: @@ -912,8 +932,8 @@ (require 'ps-print) -(and (string< ps-print-version "6.5.7") - (error "`printing' requires `ps-print' package version 6.5.7 or later.")) +(and (string< ps-print-version "6.6.4") + (error "`printing' requires `ps-print' package version 6.6.4 or later.")) (eval-and-compile @@ -1064,6 +1084,15 @@ path)) +(defun pr-standard-path (path) + "Ensure the proper directory separator depending on the OS. +That is, if Emacs is running on DOS/Windows, ensure dos/windows-style directory +separator; otherwise, ensure unix-style directory separator." + (if (or pr-cygwin-system ps-windows-system) + (subst-char-in-string ?/ ?\\ path) + (subst-char-in-string ?\\ ?/ path))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; User Interface (II) @@ -2314,16 +2343,6 @@ :group 'printing) -(defcustom pr-shell-file-name - (if (and (not pr-cygwin-system) - ps-windows-system) - "cmdproxy.exe" - shell-file-name) - "*Specify file name to load inferior shells from." - :type 'string - :group 'printing) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Internal Variables @@ -2410,6 +2429,7 @@ (and pr-auto-region transient-mark-mode mark-active))) ((eq ps-print-emacs-type 'xemacs) ; XEmacs + (defvar zmacs-region-stays nil) ; to avoid compilation gripes (defsubst pr-region-active-p () (and pr-auto-region (not zmacs-region-stays) (ps-mark-active-p))))) @@ -3792,9 +3812,7 @@ "Preview PostScript file FILENAME." (interactive (list (pr-ps-infile-preprint "Preview "))) (and (stringp filename) (file-exists-p filename) - (let ((shell-file-name pr-shell-file-name)) - (start-process-shell-command "PREVIEW" "*Messages*" - (pr-command pr-gv-command) filename)))) + (pr-call-process pr-gv-command filename))) ;;;###autoload @@ -3815,12 +3833,13 @@ (let* ((file (pr-expand-file-name filename)) (tempfile (pr-dosify-path (make-temp-name file)))) ;; gs use - (pr-shell-command - (concat (pr-command pr-gs-command) - " -sDEVICE=" pr-gs-device - " -r" (int-to-string pr-gs-resolution) - " " (pr-switches-string pr-gs-switches "pr-gs-switches") - " -sOutputFile=" tempfile " " file " -c quit")) + (pr-call-process pr-gs-command + (format "-sDEVICE=%s" pr-gs-device) + (format "-r%d" pr-gs-resolution) + (pr-switches-string pr-gs-switches "pr-gs-switches") + (format "-sOutputFile=\"%s\"" tempfile) + file + "-c quit") ;; printing (pr-ps-file-print tempfile) ;; deleting @@ -3841,16 +3860,16 @@ (erase-buffer) (insert-file-contents-literally file)) (pr-despool-print)) - (pr-shell-command - (concat (pr-command pr-ps-command) " " - (pr-switches-string pr-ps-switches "pr-gs-switches") " " - (if (string-match "cp" pr-ps-command) - ;; for "cp" (cmd in out) - (concat "\"" file "\" " - pr-ps-printer-switch pr-ps-printer) - ;; else, for others (cmd out in) - (concat pr-ps-printer-switch pr-ps-printer - " \"" file "\"")))))))) + (apply 'pr-call-process + pr-ps-command + (pr-switches-string pr-ps-switches "pr-gs-switches") + (if (string-match "cp" pr-ps-command) + ;; for "cp" (cmd in out) + (list file + (concat pr-ps-printer-switch pr-ps-printer)) + ;; else, for others (cmd out in) + (list (concat pr-ps-printer-switch pr-ps-printer) + file))))))) ;;;###autoload @@ -4252,9 +4271,22 @@ #'ps-print-quote (list (concat "\n;;; printing.el version " pr-version "\n") - '(19 . pr-shell-file-name) - '(19 . pr-path-style) - '(19 . pr-path-alist) + ";; internal vars" + (ps-comment-string "pr-txt-command " pr-txt-command) + (ps-comment-string "pr-txt-switches " + (pr-switches-string pr-txt-switches "pr-txt-switches")) + (ps-comment-string "pr-txt-printer " pr-txt-printer) + (ps-comment-string "pr-ps-command " pr-ps-command) + (ps-comment-string "pr-ps-switches " + (pr-switches-string pr-ps-switches "pr-ps-switches")) + (ps-comment-string "pr-ps-printer-switch" pr-ps-printer-switch) + (ps-comment-string "pr-ps-printer " pr-ps-printer) + (ps-comment-string "pr-cygwin-system " pr-cygwin-system) + (ps-comment-string "ps-windows-system " ps-windows-system) + (ps-comment-string "ps-lp-system " ps-lp-system) + nil + '(14 . pr-path-style) + '(14 . pr-path-alist) nil '(21 . pr-txt-name) '(21 . pr-txt-printer-alist) @@ -4570,6 +4602,7 @@ (cond ((eq ps-print-emacs-type 'xemacs) ;; XEmacs + (defvar current-mouse-event nil) ; to avoid compilation gripes (defun pr-menu-position (entry index horizontal) (pr-x-make-event 'button-release @@ -4633,6 +4666,7 @@ ((eq ps-print-emacs-type 'xemacs) ;; XEmacs + (defvar current-menubar nil) ; to avoid compilation gripes (defun pr-menu-lookup (path) (car (pr-x-find-menu-item current-menubar (cons "Printing" path)))) @@ -4973,7 +5007,7 @@ pr-ps-command (pr-dosify-path (nth 0 ps)) pr-ps-switches (nth 1 ps) pr-ps-printer-switch (nth 2 ps) - pr-ps-printer (pr-dosify-path (nth 3 ps))) + pr-ps-printer (nth 3 ps)) (or (stringp pr-ps-command) (setq pr-ps-command (cond (ps-windows-system "print") @@ -4998,7 +5032,7 @@ (setq pr-txt-name value pr-txt-command (pr-dosify-path (nth 0 txt)) pr-txt-switches (nth 1 txt) - pr-txt-printer (pr-dosify-path (nth 2 txt)))) + pr-txt-printer (nth 2 txt))) (or (stringp pr-txt-command) (setq pr-txt-command (cond (ps-windows-system "print") @@ -5211,32 +5245,54 @@ (let (item) (and (stringp infile) (file-exists-p infile) (setq item (cdr (assq pr-ps-utility pr-ps-utility-alist))) - (pr-shell-command - (concat (pr-command (nth 0 item)) " " - (pr-switches-string (nth 1 item) - "pr-ps-utility-alist entry") - " " - (pr-switches-string (nth 8 item) - "pr-ps-utility-alist entry") - " " - (and (nth 2 item) - (format (nth 2 item) ps-paper-type)) - " " (format (nth 3 item) n-up) " " - (and pr-file-landscape (nth 4 item)) " " - (and pr-file-duplex (nth 5 item)) " " - (and pr-file-tumble (nth 6 item)) - " \"" (pr-expand-file-name infile) "\" " - (nth 7 item) - " \"" (pr-expand-file-name outfile) "\""))))) - - -(defun pr-shell-command (command) - (let ((shell-file-name pr-shell-file-name)) - (shell-command command))) + (pr-call-process (nth 0 item) + (pr-switches-string (nth 1 item) + "pr-ps-utility-alist entry") + (pr-switches-string (nth 8 item) + "pr-ps-utility-alist entry") + (and (nth 2 item) + (format (nth 2 item) ps-paper-type)) + (format (nth 3 item) n-up) + (and pr-file-landscape (nth 4 item)) + (and pr-file-duplex (nth 5 item)) + (and pr-file-tumble (nth 6 item)) + (pr-expand-file-name infile) + (nth 7 item) + (pr-expand-file-name outfile))))) + + +(defun pr-remove-nil-from-list (lst) + (while (and lst (null (car lst))) + (setq lst (cdr lst))) + (let ((b lst) + (l (cdr lst))) + (while l + (if (car l) + (setq b l + l (cdr l)) + (setq l (cdr l)) + (setcdr b l)))) + lst) + + +(defun pr-call-process (command &rest args) + (let ((buffer (get-buffer-create "*Printing Command Output*")) + (cmd (pr-command command)) + status) + (setq args (pr-remove-nil-from-list args)) + (save-excursion + (set-buffer buffer) + (goto-char (point-max)) + (insert (format "%s %S\n" cmd args))) + (setq status (apply 'call-process cmd nil buffer nil args)) + (save-excursion + (set-buffer buffer) + (goto-char (point-max)) + (insert (format "Exit status: %s\n" status))))) (defun pr-txt-print (from to) - (let ((lpr-command (pr-command pr-txt-command)) + (let ((lpr-command (pr-standard-path (pr-command pr-txt-command))) (lpr-switches (pr-switches pr-txt-switches "pr-txt-switches")) (printer-name pr-txt-printer)) (lpr-region from to)))
--- a/lisp/progmodes/cperl-mode.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/progmodes/cperl-mode.el Sun Jul 11 02:28:46 2004 +0000 @@ -1472,7 +1472,7 @@ (make-local-variable 'comment-start-skip) (setq comment-start-skip "#+ *") (make-local-variable 'defun-prompt-regexp) - (setq defun-prompt-regexp "^[ \t]*sub[ \t]+\\([^ \t\n{(;]+\\)\\([ \t]*([^()]*)[ \t]*\\)?[ \t]*") + (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*)") (make-local-variable 'comment-indent-function) (setq comment-indent-function 'cperl-comment-indent) (make-local-variable 'parse-sexp-ignore-comments)
--- a/lisp/simple.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/simple.el Sun Jul 11 02:28:46 2004 +0000 @@ -3368,7 +3368,8 @@ "Return the symbol or word that point is on (or a nearby one) as a string. The return value includes no text properties. If optional arg STRICT is non-nil, return nil unless point is within -or adjacent to a symbol or word. +or adjacent to a symbol or word. In all cases the value can be nil +if there is no word nearby. The function, belying its name, normally finds a symbol. If optional arg REALLY-WORD is non-nil, it finds just a word." (save-excursion
--- a/lisp/wid-edit.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/wid-edit.el Sun Jul 11 02:28:46 2004 +0000 @@ -1144,7 +1144,7 @@ field))) (defun widget-field-buffer (widget) - "Return the start of WIDGET's editing field." + "Return the buffer of WIDGET's editing field." (let ((overlay (widget-get widget :field-overlay))) (cond ((overlayp overlay) (overlay-buffer overlay))
--- a/lisp/xml.el Sat Jul 10 22:37:50 2004 +0000 +++ b/lisp/xml.el Sun Jul 11 02:28:46 2004 +0000 @@ -84,6 +84,20 @@ ;;** ;;******************************************************************* +(defvar xml-entity-alist + '(("lt" . "<") + ("gt" . ">") + ("apos" . "'") + ("quot" . "\"") + ("amp" . "&")) + "The defined entities. Entities are added to this when the DTD is parsed.") + +(defvar xml-sub-parser nil + "Dynamically set this to a non-nil value if you want to parse an XML fragment.") + +(defvar xml-validating-parser nil + "Set to non-nil to get validity checking.") + (defsubst xml-node-name (node) "Return the tag associated with NODE. Without namespace-aware parsing, the tag is a symbol. @@ -164,6 +178,48 @@ (kill-buffer (current-buffer))) xml))) + +(let* ((start-chars (concat ":[:alpha:]_")) + (name-chars (concat "-[:digit:]." start-chars)) +;;[3] S ::= (#x20 | #x9 | #xD | #xA)+ + (whitespace "[ \t\n\r]")) +;;[4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] +;; | [#xD8-#xF6] | [#xF8-#x2FF] | [#x370-#x37D] | [#x37F-#x1FFF] +;; | [#x200C-#x200D] | [#x2070-#x218F] | [#x2C00-#x2FEF] | [#x3001-#xD7FF] +;; | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] | [#x10000-#xEFFFF] + (defvar xml-name-start-char-re (concat "[" start-chars "]")) +;;[4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 | [#x0300-#x036F] | [#x203F-#x2040] + (defvar xml-name-char-re (concat "[" name-chars "]")) +;;[5] Name ::= NameStartChar (NameChar)* + (defvar xml-name-re (concat xml-name-start-char-re xml-name-char-re "*")) +;;[6] Names ::= Name (#x20 Name)* + (defvar xml-names-re (concat xml-name-re "\\(?: " xml-name-re "\\)*")) +;;[7] Nmtoken ::= (NameChar)+ + (defvar xml-nmtoken-re (concat xml-name-char-re "+")) +;;[8] Nmtokens ::= Nmtoken (#x20 Nmtoken)* + (defvar xml-nmtokens-re (concat xml-nmtoken-re "\\(?: " xml-name-re "\\)*")) +;;[66] CharRef ::= '&#' [0-9]+ ';' | '&#x' [0-9a-fA-F]+ ';' + (defvar xml-char-ref-re "\\(?:&#[0-9]+;\\|&#x[0-9a-fA-F]+;\\)") +;;[68] EntityRef ::= '&' Name ';' + (defvar xml-entity-ref (concat "&" xml-name-re ";")) +;;[69] PEReference ::= '%' Name ';' + (defvar xml-pe-reference-re (concat "%" xml-name-re ";")) +;;[67] Reference ::= EntityRef | CharRef + (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)")) +;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' +;; | "'" ([^%&'] | PEReference | Reference)* "'" + (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re + "\\|" xml-reference-re "\\)*\"\\|'\\(?:[^%&']\\|" + xml-pe-reference-re "\\|" xml-reference-re "\\)*'\\)"))) +;;[75] ExternalID ::= 'SYSTEM' S SystemLiteral +;; | 'PUBLIC' S PubidLiteral S SystemLiteral +;;[76] NDataDecl ::= S 'NDATA' S +;;[73] EntityDef ::= EntityValue| (ExternalID NDataDecl?) +;;[71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>' +;;[74] PEDef ::= EntityValue | ExternalID +;;[72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>' +;;[70] EntityDecl ::= GEDecl | PEDecl + ;; Note that this is setup so that we can do whitespace-skipping with ;; `(skip-syntax-forward " ")', inter alia. Previously this was slow ;; compared with `re-search-forward', but that has been fixed. Also @@ -229,9 +285,9 @@ (progn (forward-char -1) (setq result (xml-parse-tag parse-dtd parse-ns)) - (if (and xml result) + (if (and xml result (not xml-sub-parser)) ;; translation of rule [1] of XML specifications - (error "XML files can have only one toplevel tag") + (error "XML: (Not Well-Formed) Only one root tag allowed") (cond ((null result)) ((and (listp (car result)) @@ -265,10 +321,24 @@ ;; matching cons in xml-ns. In which case we (ns (or (cdr (assoc (if special "xmlns" prefix) xml-ns)) - :))) + ""))) (cons ns (if special "" lname))) (intern name))) +(defun xml-parse-fragment (&optional parse-dtd parse-ns) + "Parse xml-like fragments." + (let ((xml-sub-parser t) + children) + (while (not (eobp)) + (let ((bit (xml-parse-tag + parse-dtd parse-ns))) + (if children + (setq children (append (list bit) children)) + (if (stringp bit) + (setq children (list bit)) + (setq children bit))))) + (reverse children))) + (defun xml-parse-tag (&optional parse-dtd parse-ns) "Parse the tag at point. If PARSE-DTD is non-nil, the DTD of the document, if any, is parsed and @@ -278,16 +348,17 @@ - a list : the matching node - nil : the point is not looking at a tag. - a pair : the first element is the DTD, the second is the node." - (let ((xml-ns (if (consp parse-ns) + (let ((xml-validating-parser (or parse-dtd xml-validating-parser)) + (xml-ns (if (consp parse-ns) parse-ns (if parse-ns (list ;; Default for empty prefix is no namespace - (cons "" :) + (cons "" "") ;; "xml" namespace - (cons "xml" :http://www.w3.org/XML/1998/namespace) + (cons "xml" "http://www.w3.org/XML/1998/namespace") ;; We need to seed the xmlns namespace - (cons "xmlns" :http://www.w3.org/2000/xmlns/)))))) + (cons "xmlns" "http://www.w3.org/2000/xmlns/")))))) (cond ;; Processing instructions (like the <?xml version="1.0"?> tag at the ;; beginning of a document). @@ -299,18 +370,15 @@ ((looking-at "<!\\[CDATA\\[") (let ((pos (match-end 0))) (unless (search-forward "]]>" nil t) - (error "CDATA section does not end anywhere in the document")) + (error "XML: (Not Well Formed) CDATA section does not end anywhere in the document")) (buffer-substring pos (match-beginning 0)))) ;; DTD for the document ((looking-at "<!DOCTYPE") - (let (dtd) - (if parse-dtd - (setq dtd (xml-parse-dtd)) - (xml-skip-dtd)) - (skip-syntax-forward " ") - (if dtd - (cons dtd (xml-parse-tag nil xml-ns)) - (xml-parse-tag nil xml-ns)))) + (let ((dtd (xml-parse-dtd parse-ns))) + (skip-syntax-forward " ") + (if xml-validating-parser + (cons dtd (xml-parse-tag nil xml-ns)) + (xml-parse-tag nil xml-ns)))) ;; skip comments ((looking-at "<!--") (search-forward "-->") @@ -332,65 +400,76 @@ (when (consp xml-ns) (dolist (attr attrs) (when (and (consp (car attr)) - (eq :http://www.w3.org/2000/xmlns/ - (caar attr))) - (push (cons (cdar attr) (intern (concat ":" (cdr attr)))) + (equal "http://www.w3.org/2000/xmlns/" + (caar attr))) + (push (cons (cdar attr) (cdr attr)) xml-ns)))) (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns))) ;; is this an empty element ? (if (looking-at "/>") - (progn - (forward-char 2) - (nreverse children)) + (progn + (forward-char 2) + (nreverse children)) + + ;; is this a valid start tag ? + (if (eq (char-after) ?>) + (progn + (forward-char 1) + ;; Now check that we have the right end-tag. Note that this + ;; one might contain spaces after the tag name + (let ((end (concat "</" node-name "\\s-*>"))) + (while (not (looking-at end)) + (cond + ((looking-at "</") + (error "XML: (Not Well-Formed) Invalid end tag (expecting %s) at pos %d" + node-name (point))) + ((= (char-after) ?<) + (let ((tag (xml-parse-tag nil xml-ns))) + (when tag + (push tag children)))) + (t + (let ((expansion (xml-parse-string))) + (setq children + (if (stringp expansion) + (if (stringp (car children)) + ;; The two strings were separated by a comment. + (setq children (append (concat (car children) expansion) + (cdr children))) + (setq children (append (list expansion) children))) + (setq children (append expansion children)))))))) - ;; is this a valid start tag ? - (if (eq (char-after) ?>) - (progn - (forward-char 1) - ;; Now check that we have the right end-tag. Note that this - ;; one might contain spaces after the tag name - (let ((end (concat "</" node-name "\\s-*>"))) - (while (not (looking-at end)) - (cond - ((looking-at "</") - (error "XML: Invalid end tag (expecting %s) at pos %d" - node-name (point))) - ((= (char-after) ?<) - (let ((tag (xml-parse-tag nil xml-ns))) - (when tag - (push tag children)))) - (t - (setq pos (point)) - (search-forward "<") - (forward-char -1) - (let ((string (buffer-substring pos (point))) - (pos 0)) + (goto-char (match-end 0)) + (nreverse children))) + ;; This was an invalid start tag (Expected ">", but didn't see it.) + (error "XML: (Well-Formed) Couldn't parse tag: %s" + (buffer-substring (- (point) 10) (+ (point) 1))))))) + (t ;; (Not one of PI, CDATA, Comment, End tag, or Start tag) + (unless xml-sub-parser ; Usually, we error out. + (error "XML: (Well-Formed) Invalid character")) + + ;; However, if we're parsing incrementally, then we need to deal + ;; with stray CDATA. + (xml-parse-string))))) - ;; Clean up the string. As per XML - ;; specifications, the XML processor should - ;; always pass the whole string to the - ;; application. But \r's should be replaced: - ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends - (while (string-match "\r\n?" string pos) - (setq string (replace-match "\n" t t string)) - (setq pos (1+ (match-beginning 0)))) +(defun xml-parse-string () + "Parse the next whatever. Could be a string, or an element." + (let* ((pos (point)) + (string (progn (if (search-forward "<" nil t) + (forward-char -1) + (goto-char (point-max))) + (buffer-substring pos (point))))) + ;; Clean up the string. As per XML specifications, the XML + ;; processor should always pass the whole string to the + ;; application. But \r's should be replaced: + ;; http://www.w3.org/TR/2000/REC-xml-20001006#sec-line-ends + (setq pos 0) + (while (string-match "\r\n?" string pos) + (setq string (replace-match "\n" t t string)) + (setq pos (1+ (match-beginning 0)))) - (setq string (xml-substitute-special string)) - (setq children - (if (stringp (car children)) - ;; The two strings were separated by a comment. - (cons (concat (car children) string) - (cdr children)) - (cons string children)))))))) - - (goto-char (match-end 0)) - (nreverse children)) - ;; This was an invalid start tag - (error "XML: Invalid attribute list"))))) - (t ;; This is not a tag. - (error "XML: Invalid character"))))) + (xml-substitute-special string))) (defun xml-parse-attlist (&optional xml-ns) "Return the attribute-list after point. @@ -412,18 +491,23 @@ (setq end-pos (match-end 0)) (if (looking-at "'\\([^']*\\)'") (setq end-pos (match-end 0)) - (error "XML: Attribute values must be given between quotes"))) + (error "XML: (Not Well-Formed) Attribute values must be given between quotes"))) ;; Each attribute must be unique within a given element (if (assoc name attlist) - (error "XML: each attribute must be unique within an element")) + (error "XML: (Not Well-Formed) Each attribute must be unique within an element")) ;; Multiple whitespace characters should be replaced with a single one ;; in the attributes (let ((string (match-string 1)) (pos 0)) (replace-regexp-in-string "\\s-\\{2,\\}" " " string) - (push (cons name (xml-substitute-special string)) attlist)) + (let ((expansion (xml-substitute-special string))) + (unless (stringp expansion) + ; We say this is the constraint. It is acctually that + ; external entities nor "<" can be in an attribute value. + (error "XML: (Not Well-Formed) Entities in attributes cannot expand into elements")) + (push (cons name expansion) attlist))) (goto-char end-pos) (skip-syntax-forward " ")) @@ -442,24 +526,16 @@ (defun xml-skip-dtd () "Skip the DTD at point. This follows the rule [28] in the XML specifications." - (forward-char (length "<!DOCTYPE")) - (if (looking-at "\\s-*>") - (error "XML: invalid DTD (excepting name of the document)")) - (condition-case nil - (progn - (forward-sexp) - (skip-syntax-forward " ") - (if (looking-at "\\[") - (re-search-forward "]\\s-*>") - (search-forward ">"))) - (error (error "XML: No end to the DTD")))) + (let ((xml-validating-parser nil)) + (xml-parse-dtd))) -(defun xml-parse-dtd () +(defun xml-parse-dtd (&optional parse-ns) "Parse the DTD at point." (forward-char (eval-when-compile (length "<!DOCTYPE"))) (skip-syntax-forward " ") - (if (looking-at ">") - (error "XML: invalid DTD (excepting name of the document)")) + (if (and (looking-at ">") + xml-validating-parser) + (error "XML: (Validity) Invalid DTD (expecting name of the document)")) ;; Get the name of the document (looking-at xml-name-regexp) @@ -477,27 +553,27 @@ (re-search-forward "\\='\\([[:space:][:alnum:]-()+,./:=?;!*#@$_%]*\\)'" nil t)) - (error "XML: missing public id")) + (error "XML: Missing Public ID")) (let ((pubid (match-string 1))) + (skip-syntax-forward " ") (unless (or (re-search-forward "\\='\\([^']*\\)'" nil t) (re-search-forward "\\=\"\\([^\"]*\\)\"" nil t)) - (error "XML: missing system id")) + (error "XML: Missing System ID")) (push (list pubid (match-string 1) 'public) dtd))) ((looking-at "SYSTEM\\s-+") (goto-char (match-end 0)) (unless (or (re-search-forward "\\='\\([^']*\\)'" nil t) (re-search-forward "\\=\"\\([^\"]*\\)\"" nil t)) - (error "XML: missing system id")) + (error "XML: Missing System ID")) (push (list (match-string 1) 'system) dtd))) (skip-syntax-forward " ") (if (eq ?> (char-after)) (forward-char) - (skip-syntax-forward " ") (if (not (eq (char-after) ?\[)) - (error "XML: bad DTD") + (error "XML: Bad DTD") (forward-char) ;; Parse the rest of the DTD - ;; Fixme: Deal with ENTITY, ATTLIST, NOTATION, PIs. + ;; Fixme: Deal with ATTLIST, NOTATION, PIs. (while (not (looking-at "\\s-*\\]")) (skip-syntax-forward " ") (cond @@ -521,11 +597,13 @@ ((string-match "^%[^;]+;[ \t\n\r]*$" type) ;; substitution nil) (t - (error "XML: Invalid element type in the DTD"))) + (if xml-validating-parser + error "XML: (Validity) Invalid element type in the DTD"))) ;; rule [45]: the element declaration must be unique - (if (assoc element dtd) - (error "XML: element declarations must be unique in a DTD (<%s>)" + (if (and (assoc element dtd) + xml-validating-parser) + (error "XML: (Validity) Element declarations must be unique in a DTD (<%s>)" element)) ;; Store the element in the DTD @@ -533,12 +611,49 @@ (goto-char end-pos)) ((looking-at "<!--") (search-forward "-->")) - + ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re + "\\)[ \t\n\r]*\\(" xml-entity-value-re + "\\)[ \t\n\r]*>")) + (let ((name (buffer-substring (nth 2 (match-data)) + (nth 3 (match-data)))) + (value (buffer-substring (+ (nth 4 (match-data)) 1) + (- (nth 5 (match-data)) 1)))) + (goto-char (nth 1 (match-data))) + (setq xml-entity-alist + (append xml-entity-alist + (list (cons name + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (xml-parse-fragment + xml-validating-parser + parse-ns)))))))) + ((or (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re + "\\)[ \t\n\r]+SYSTEM[ \t\n\r]+" + "\\(\"[^\"]*\"\\|'[^']*'\\)[ \t\n\r]*>")) + (looking-at (concat "<!ENTITY[ \t\n\r]+\\(" xml-name-re + "\\)[ \t\n\r]+PUBLIC[ \t\n\r]+" + "\"[- \r\na-zA-Z0-9'()+,./:=?;!*#@$_%]*\"" + "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'" + "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)" + "[ \t\n\r]*>"))) + (let ((name (buffer-substring (nth 2 (match-data)) + (nth 3 (match-data)))) + (file (buffer-substring (+ (nth 4 (match-data)) 1) + (- (nth 5 (match-data)) 1)))) + (goto-char (nth 1 (match-data))) + (setq xml-entity-alist + (append xml-entity-alist + (list (cons name (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (xml-parse-fragment + xml-validating-parser + parse-ns)))))))) (t - (error "XML: Invalid DTD item"))) - - ;; Skip the end of the DTD - (search-forward ">")))) + (error "XML: (Validity) Invalid DTD item"))))) + (if (looking-at "\\s-*]>") + (goto-char (nth 1 (match-data))))) (nreverse dtd))) (defun xml-parse-elem-type (string) @@ -580,41 +695,72 @@ ;;** ;;******************************************************************* -(eval-when-compile - (defvar str)) ; dynamic from replace-regexp-in-string - -;; Fixme: Take declared entities from the DTD when they're available. -(defun xml-substitute-entity (match) - "Subroutine of `xml-substitute-special'." - (save-match-data - (let ((match1 (match-string 1 str))) - (cond ((string= match1 "lt") "<") - ((string= match1 "gt") ">") - ((string= match1 "apos") "'") - ((string= match1 "quot") "\"") - ((string= match1 "amp") "&") - ((and (string-match "#\\([0-9]+\\)" match1) - (let ((c (decode-char - 'ucs - (string-to-number (match-string 1 match1))))) - (if c (string c))))) ; else unrepresentable - ((and (string-match "#x\\([[:xdigit:]]+\\)" match1) - (let ((c (decode-char - 'ucs - (string-to-number (match-string 1 match1) 16)))) - (if c (string c))))) - ;; Default to asis. Arguably, unrepresentable code points - ;; might be best replaced with U+FFFD. - (t match))))) - (defun xml-substitute-special (string) "Return STRING, after subsituting entity references." ;; This originally made repeated passes through the string from the ;; beginning, which isn't correct, since then either "&amp;" or ;; "&amp;" won't DTRT. - (replace-regexp-in-string "&\\([^;]+\\);" - #'xml-substitute-entity string t t)) + + (let ((point 0) + children end-point) + (while (string-match "&\\([^;]+\\);" string point) + (setq end-point (match-end 0)) + (let* ((this-part (match-string 1 string)) + (prev-part (substring string point (match-beginning 0))) + (entity (assoc this-part xml-entity-alist)) + (expansion + (cond ((string-match "#\\([0-9]+\\)" this-part) + (let ((c (decode-char + 'ucs + (string-to-number (match-string 1 this-part))))) + (if c (string c)))) + ((string-match "#x\\([[:xdigit:]]+\\)" this-part) + (let ((c (decode-char + 'ucs + (string-to-number (match-string 1 this-part) 16)))) + (if c (string c)))) + (entity + (cdr entity)) + (t + (if xml-validating-parser + (error "XML: (Validity) Undefined entity `%s'" + (match-string 1 this-part))))))) + (cond ((null children) + (if (stringp expansion) + (setq children (concat prev-part expansion)) + (if (stringp (car (last expansion))) + (progn + (setq children + (list (concat prev-part (car expansion)) + (cdr expansion)))) + (setq children (append expansion prev-part))))) + ((stringp children) + (if (stringp expansion) + (setq children (concat children prev-part expansion)) + (setq children (list expansion (concat prev-part children))))) + ((and (stringp expansion) + (stringp (car children))) + (setcar children (concat prev-part expansion (car children)))) + ((stringp expansion) + (setq children (append (concat prev-part expansion) + children))) + ((stringp (car children)) + (setcar children (concat (car children) prev-part)) + (setq children (append expansion children))) + (t + (setq children (list expansion + prev-part + children)))) + (setq point end-point))) + (cond ((stringp children) + (concat children (substring string point))) + ((stringp (car (last children))) + (concat (car children) (substring string point))) + ((null children) + string) + (t + (nreverse children))))) ;;******************************************************************* ;;** ;;** Printing a tree.
--- a/lispref/ChangeLog Sat Jul 10 22:37:50 2004 +0000 +++ b/lispref/ChangeLog Sun Jul 11 02:28:46 2004 +0000 @@ -1,3 +1,7 @@ +2004-07-09 Richard M. Stallman <rms@gnu.org> + + * frames.texi (Input Focus): Minor fix. + 2004-07-07 Luc Teirlinck <teirllm@auburn.edu> * frames.texi (Input Focus): Clarify descriptions of
--- a/lispref/frames.texi Sat Jul 10 22:37:50 2004 +0000 +++ b/lispref/frames.texi Sun Jul 11 02:28:46 2004 +0000 @@ -1008,7 +1008,7 @@ When using a text-only terminal, only one frame can be displayed at a time on the terminal, so after a call to @code{select-frame}, the next redisplay actually displays the newly selected frame. This frame -remains displayed until a subsequent call to @code{select-frame} or +remains selected until a subsequent call to @code{select-frame} or @code{select-frame-set-input-focus}. Each terminal frame has a number which appears in the mode line before the buffer name (@pxref{Mode Line Variables}).
--- a/src/ChangeLog Sat Jul 10 22:37:50 2004 +0000 +++ b/src/ChangeLog Sun Jul 11 02:28:46 2004 +0000 @@ -1,3 +1,9 @@ +2004-07-09 Luc Teirlinck <teirllm@auburn.edu> + + * editfns.c (Ffloat_time, Fformat_time_string, Fdecode_time) + (Fcurrent_time_string, Fcurrent_time_zone): Mention in docstrings + that time values of the type (HIGH . LOW) are considered obsolete. + 2004-07-06 Luc Teirlinck <teirllm@auburn.edu> * keyboard.c (syms_of_keyboard): Fix `keyboard-translate-table'
--- a/src/editfns.c Sat Jul 10 22:37:50 2004 +0000 +++ b/src/editfns.c Sun Jul 11 02:28:46 2004 +0000 @@ -1431,10 +1431,10 @@ DEFUN ("float-time", Ffloat_time, Sfloat_time, 0, 1, 0, doc: /* Return the current time, as a float number of seconds since the epoch. If SPECIFIED-TIME is given, it is the time to convert to float -instead of the current time. The argument should have the forms: - (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC). -Thus, you can use times obtained from `current-time' -and from `file-attributes'. +instead of the current time. The argument should have the form +(HIGH LOW . IGNORED). Thus, you can use times obtained from +`current-time' and from `file-attributes'. SPECIFIED-TIME can also +have the form (HIGH . LOW), but this is considered obsolete. WARNING: Since the result is floating point, it may not be exact. Do not use this function if precise time stamps are required. */) @@ -1506,8 +1506,9 @@ DEFUN ("format-time-string", Fformat_time_string, Sformat_time_string, 1, 3, 0, doc: /* Use FORMAT-STRING to format the time TIME, or now if omitted. -TIME is specified as (HIGH LOW . IGNORED) or (HIGH . LOW), as returned by -`current-time' or `file-attributes'. +TIME is specified as (HIGH LOW . IGNORED), as returned by +`current-time' or `file-attributes'. The obsolete form (HIGH . LOW) +is also still accepted. The third, optional, argument UNIVERSAL, if non-nil, means describe TIME as Universal Time; nil means describe TIME in the local time zone. The value is a copy of FORMAT-STRING, but with certain constructs replaced @@ -1603,17 +1604,19 @@ DEFUN ("decode-time", Fdecode_time, Sdecode_time, 0, 1, 0, doc: /* Decode a time value as (SEC MINUTE HOUR DAY MONTH YEAR DOW DST ZONE). -The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED) -or (HIGH . LOW), as from `current-time' and `file-attributes', or `nil' -to use the current time. The list has the following nine members: -SEC is an integer between 0 and 60; SEC is 60 for a leap second, which -only some operating systems support. MINUTE is an integer between 0 and 59. -HOUR is an integer between 0 and 23. DAY is an integer between 1 and 31. -MONTH is an integer between 1 and 12. YEAR is an integer indicating the -four-digit year. DOW is the day of week, an integer between 0 and 6, where -0 is Sunday. DST is t if daylight savings time is effect, otherwise nil. -ZONE is an integer indicating the number of seconds east of Greenwich. -(Note that Common Lisp has different meanings for DOW and ZONE.) */) +The optional SPECIFIED-TIME should be a list of (HIGH LOW . IGNORED), +as from `current-time' and `file-attributes', or `nil' to use the +current time. The obsolete form (HIGH . LOW) is also still accepted. +The list has the following nine members: SEC is an integer between 0 +and 60; SEC is 60 for a leap second, which only some operating systems +support. MINUTE is an integer between 0 and 59. HOUR is an integer +between 0 and 23. DAY is an integer between 1 and 31. MONTH is an +integer between 1 and 12. YEAR is an integer indicating the +four-digit year. DOW is the day of week, an integer between 0 and 6, +where 0 is Sunday. DST is t if daylight savings time is effect, +otherwise nil. ZONE is an integer indicating the number of seconds +east of Greenwich. (Note that Common Lisp has different meanings for +DOW and ZONE.) */) (specified_time) Lisp_Object specified_time; { @@ -1745,13 +1748,11 @@ However, see also the functions `decode-time' and `format-time-string' which provide a much more powerful and general facility. -If SPECIFIED-TIME is given, it is a time to format instead -of the current time. The argument should have the form: - (HIGH . LOW) -or the form: - (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' -and from `file-attributes'. */) +If SPECIFIED-TIME is given, it is a time to format instead of the +current time. The argument should have the form (HIGH LOW . IGNORED). +Thus, you can use times obtained from `current-time' and from +`file-attributes'. SPECIFIED-TIME can also have the form (HIGH . LOW), +but this is considered obsolete. */) (specified_time) Lisp_Object specified_time; { @@ -1802,12 +1803,10 @@ A negative value means west of Greenwich. NAME is a string giving the name of the time zone. If SPECIFIED-TIME is given, the time zone offset is determined from it -instead of using the current time. The argument should have the form: - (HIGH . LOW) -or the form: - (HIGH LOW . IGNORED). -Thus, you can use times obtained from `current-time' -and from `file-attributes'. +instead of using the current time. The argument should have the form +(HIGH LOW . IGNORED). Thus, you can use times obtained from +`current-time' and from `file-attributes'. SPECIFIED-TIME can also +have the form (HIGH . LOW), but this is considered obsolete. Some operating systems cannot provide all this information to Emacs; in this case, `current-time-zone' returns a list containing nil for