diff -urN psgml-1.2.5/psgml-edit.el psgml-dev/psgml-edit.el --- psgml-1.2.5/psgml-edit.el Fri Apr 19 14:37:46 2002 +++ psgml-dev/psgml-edit.el Thu Sep 19 14:11:46 2002 @@ -184,7 +184,7 @@ (newattlist (sgml-element-attlist newel)) (newasl (sgml-translate-attribute-specification-list attspec oldattlist newattlist))) - (sgml-insert-attributes newasl newattlist)) + (sgml-insert-attributes newasl newattlist newel)) (insert (if (and sgml-xml-p (sgml-element-empty element)) (sgml-delim "XML-TAGCE") (sgml-delim "TAGC"))))) @@ -683,7 +683,7 @@ (setq element (sgml-find-element-of (point))) (sgml-insert-attributes (funcall sgml-new-attribute-list-function element) - (sgml-element-attlist element)) + (sgml-element-attlist element) element) ;; Get element with new attributes (setq element (sgml-find-context-of (point))) (if (and sgml-xml-p (sgml-check-empty name)) @@ -721,7 +721,9 @@ collect (sgml-make-attspec (sgml-attdecl-name attdecl) - (sgml-read-attribute-value attdecl (sgml-element-name element) nil)))) + (sgml-fixed-or-read-attribute-value attdecl + (sgml-element-name element) + nil)))) (defun sgml-tag-region (element start end) "Reads element name from minibuffer and inserts start and end tags." @@ -738,10 +740,12 @@ (goto-char start) (sgml-insert-tag (sgml-start-tag-of element))))) -(defun sgml-insert-attributes (avl attlist) +(defun sgml-insert-attributes (avl attlist &optional element) "Insert the attributes with values AVL and declarations ATTLIST. AVL should be a assoc list mapping symbols to strings." (let (name val dcl def) + ;; DARKNESS: Is this a good default? + (if (null element) (setq element (sgml-find-attribute-element))) (loop for attspec in attlist do (setq name (sgml-attspec-name attspec) val (cdr-safe (sgml-lookup-attspec name avl)) @@ -755,18 +759,21 @@ ((and (or (not (or sgml-xml-p sgml-omittag sgml-shorttag)) sgml-insert-defaulted-attributes) (consp def)) + (setq val (sgml-default-value-attval def))) + ((sgml-is-fixed-insertable-attribute attspec element) (setq val (sgml-default-value-attval def))))) (when val (cond ((eq dcl 'CDATA)) ((eq dcl 'ENTITY) (setq val (sgml-entity-insert-case val))) (t (setq val (sgml-general-insert-case val))))) - (cond + (cond ((null val)) ; Ignore ;; Ignore attributes with default value ((and (consp def) (eq sgml-minimize-attributes 'max) (or sgml-omittag sgml-shorttag) - (equal val (sgml-default-value-attval def)))) + (equal val (sgml-default-value-attval def)) + (not (sgml-default-value-type-p 'FIXED def)))) ;; No attribute name for token groups ((and sgml-minimize-attributes sgml-shorttag (member (sgml-general-case val) @@ -857,6 +864,33 @@ (sgml-element-empty element) (eq t (sgml-element-net-enabled element)))))) +(defun sgml-is-fixed-insertable-attribute (attspec &optional element) + "Returns t if the attribute ATTSPEC is fixed and should be +explicitly inserted, nil otherwise. Currently, if ELEMENT is not +supplied this function will always return nil." + (cond ((or (null sgml-explicit-fixed-attribute-alist) + (null element)) nil) + ((sgml-default-value-type-p 'FIXED + (sgml-attdecl-default-value attspec)) + (let* ((element-name (format "%s" (sgml-element-name element))) + (attribute-name (sgml-attdecl-name attspec)) + (attr-list + (assoc element-name sgml-explicit-fixed-attribute-alist))) + (if (consp attr-list) + (consp (member attribute-name attr-list)) + nil))) + (t nil))) + +(defun sgml-fixed-or-read-attribute-value (attdecl element curvalue) + "Return the attribute value for the attribute. If fixed, +the fixed value is returned. Otherwise sgml-read-attribute-value +is called to read the value from the user." + (assert attdecl) + (let ((def (sgml-attdecl-default-value attdecl))) + (if (sgml-default-value-type-p 'FIXED def) + (sgml-default-value-attval def) + (sgml-read-attribute-value attdecl element curvalue)))) + (defun sgml-read-attribute-value (attdecl element curvalue) "Return the attribute value read from user. ATTDECL is the attribute declaration for the attribute to read. @@ -902,10 +936,10 @@ (completing-read "Attribute name: " (mapcar (function (lambda (a) (list (sgml-attdecl-name a)))) - (sgml-non-fixed-attributes (sgml-element-attlist el))) + (sgml-element-attlist el)) nil t))))) (list name - (sgml-read-attribute-value + (sgml-fixed-or-read-attribute-value (sgml-lookup-attdecl name (sgml-element-attlist el)) (sgml-element-name el) (sgml-element-attval el name))))) @@ -1115,9 +1149,9 @@ (sgml-popup-multi-menu event "Attributes" menu))) (defun sgml-make-attrib-menu (el) - (let ((attlist (sgml-non-fixed-attributes (sgml-element-attlist el)))) + (let ((attlist (sgml-element-attlist el))) (or attlist - (error "No non-fixed attributes for element")) + (error "No attributes for element")) (loop for attdecl in attlist for name = (sgml-attdecl-name attdecl) for defval = (sgml-attdecl-default-value attdecl) @@ -1137,14 +1171,15 @@ (list "Set attribute value" (list 'sgml-insert-attribute (sgml-attdecl-name attdecl) - (list 'sgml-read-attribute-value + (list 'sgml-fixed-or-read-attribute-value (list 'quote attdecl) (list 'quote (sgml-element-name el)) (sgml-element-attval el name)))))) (if (sgml-default-value-type-p 'REQUIRED defval) nil (list "--" - (list (if (sgml-default-value-type-p nil defval) + (list (if (or (sgml-default-value-type-p nil defval) + (sgml-default-value-type-p 'FIXED defval)) (format "Default: %s" (sgml-default-value-attval defval)) "#IMPLIED") @@ -1341,8 +1376,9 @@ '(read-only t category sgml-form) " %s =" aname) (cond ; attribute value ((sgml-default-value-type-p 'FIXED def-value) + (sgml-insert '(read-only t category sgml-form) " ") (sgml-insert '(read-only t category sgml-fixed) - " #FIXED %s" + "%s" (sgml-default-value-attval def-value))) ((and (null cur-value) (or (memq def-value '(IMPLIED CONREF CURRENT)) @@ -1437,15 +1473,20 @@ (al sgml-attlist)) (while (not (eq ?> (following-char))) (sgml-parse-s) - (sgml-check-nametoken) ; attribute name, should match head of al + (sgml-check-nametoken) ; attribute name, should match head of al (forward-char 3) - (unless (memq (get-text-property (point) 'category) - '(sgml-default sgml-fixed)) - (push - (sgml-make-attspec (sgml-attdecl-name (car al)) - (sgml-extract-attribute-value - (sgml-attdecl-declared-value (car al)))) - asl)) + (let ((category (get-text-property (point) 'category))) + (unless (eq category 'sgml-default) + (if (eq category 'sgml-fixed) + (let ((inhibit-read-only t)) + (remove-text-properties + (point) (next-single-property-change (point) 'category) + '(read-only nil category nil)))) + (push + (sgml-make-attspec (sgml-attdecl-name (car al)) + (sgml-extract-attribute-value + (sgml-attdecl-declared-value (car al)))) + asl))) (while (progn (beginning-of-line 2) (or (eolp) (not (get-text-property (point) 'read-only))))) diff -urN psgml-1.2.5/psgml.el psgml-dev/psgml.el --- psgml-1.2.5/psgml.el Fri Apr 19 14:37:46 2002 +++ psgml-dev/psgml.el Thu Sep 19 03:52:15 2002 @@ -85,6 +85,18 @@ "*Controls whether defaulted attributes (not #FIXED) are inserted explicitly or not. nil means don't insert, t means insert.") +(defvar sgml-explicit-fixed-attribute-alist nil + "*Alist of lists of fixed (#FIXED) attributes to be explicitly +output. The list looks like ((ELEMENT-NAME . (ATTRIBUTE-NAME) ...) ...) +where ELEMENT-NAME specifies the name of the element that the attribute +ATTRIBUTE-NAME should be explicitly included for. + +For example, for XHTML 1.0 which has a #FIXED \"xmlns\" attribute to the + element, the following setting could be used: + +(setq sgml-explicit-fixed-attribute-alist + '((\"html\" . (\"xmlns\"))))") + (defvar sgml-insert-missing-element-comment t "*If true, and sgml-auto-insert-required-elements also true, `sgml-insert-element' will insert a comment if there is an element required