;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
. (cons (concat "<"
(regexp-opt (mapcar 'car sgml-tag-face-alist) t)
"\\([ \t][^>]*\\)?>\\([^<]+\\)</\\1>")
- '(3 (cdr (assoc (downcase (match-string 1))
- sgml-tag-face-alist)) prepend))))))
+ '(3 (cdr (assoc-string (match-string 1) sgml-tag-face-alist t))
+ prepend))))))
;; for font-lock, but must be defvar'ed after
;; sgml-font-lock-keywords-1 and sgml-font-lock-keywords-2 above
"List of tags whose !ELEMENT definition says the end-tag is optional.")
(defun sgml-xml-guess ()
- "Guess whether the current buffer is XML."
+ "Guess whether the current buffer is XML. Return non-nil if so."
(save-excursion
(goto-char (point-min))
- (when (or (string= "xml" (file-name-extension (or buffer-file-name "")))
- (looking-at "\\s-*<\\?xml")
- (when (re-search-forward
- (eval-when-compile
+ (or (string= "xml" (file-name-extension (or buffer-file-name "")))
+ (looking-at "\\s-*<\\?xml")
+ (when (re-search-forward
+ (eval-when-compile
(mapconcat 'identity
'("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
- "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
- "\\s-+"))
- nil t)
- (string-match "X\\(HT\\)?ML" (match-string 3))))
- (set (make-local-variable 'sgml-xml-mode) t))))
+ "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
+ "\\s-+"))
+ nil t)
+ (string-match "X\\(HT\\)?ML" (match-string 3))))))
(defvar v2) ; free for skeleton
(eq (char-before) ?<))))
;;;###autoload
-(define-derived-mode sgml-mode text-mode "SGML"
+(define-derived-mode sgml-mode text-mode '(sgml-xml-mode "XML" "SGML")
"Major mode for editing SGML documents.
Makes > match <.
Keys <, &, SPC within <>, \", / and ' can be electric depending on
. sgml-font-lock-syntactic-keywords)))
(set (make-local-variable 'facemenu-add-face-function)
'sgml-mode-facemenu-add-face-function)
- (sgml-xml-guess)
+ (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess))
(if sgml-xml-mode
- (setq mode-name "XML")
+ ()
(set (make-local-variable 'skeleton-transformation-function)
sgml-transformation-function))
;; This will allow existing comments within declarations to be
(defun sgml-skip-tag-backward (arg)
"Skip to beginning of tag or matching opening tag if present.
-With prefix argument ARG, repeat this ARG times."
+With prefix argument ARG, repeat this ARG times.
+Return non-nil if we skipped over matched tags."
(interactive "p")
;; FIXME: use sgml-get-context or something similar.
- (while (>= arg 1)
- (search-backward "<" nil t)
- (if (looking-at "</\\([^ \n\t>]+\\)")
- ;; end tag, skip any nested pairs
- (let ((case-fold-search t)
- (re (concat "</?" (regexp-quote (match-string 1))
- ;; Ignore empty tags like <foo/>.
- "\\([^>]*[^/>]\\)?>")))
- (while (and (re-search-backward re nil t)
- (eq (char-after (1+ (point))) ?/))
- (forward-char 1)
- (sgml-skip-tag-backward 1))))
- (setq arg (1- arg))))
+ (let ((return t))
+ (while (>= arg 1)
+ (search-backward "<" nil t)
+ (if (looking-at "</\\([^ \n\t>]+\\)")
+ ;; end tag, skip any nested pairs
+ (let ((case-fold-search t)
+ (re (concat "</?" (regexp-quote (match-string 1))
+ ;; Ignore empty tags like <foo/>.
+ "\\([^>]*[^/>]\\)?>")))
+ (while (and (re-search-backward re nil t)
+ (eq (char-after (1+ (point))) ?/))
+ (forward-char 1)
+ (sgml-skip-tag-backward 1)))
+ (setq return nil))
+ (setq arg (1- arg)))
+ return))
+
+(defvar sgml-electric-tag-pair-overlays nil)
+(defvar sgml-electric-tag-pair-timer nil)
+
+(defun sgml-electric-tag-pair-before-change-function (beg end)
+ (condition-case err
+ (save-excursion
+ (goto-char end)
+ (skip-chars-backward "[:alnum:]-_.:")
+ (if (and ;; (<= (point) beg) ; This poses problems for downcase-word.
+ (or (eq (char-before) ?<)
+ (and (eq (char-before) ?/)
+ (eq (char-before (1- (point))) ?<)))
+ (null (get-char-property (point) 'text-clones)))
+ (let* ((endp (eq (char-before) ?/))
+ (cl-start (point))
+ (cl-end (progn (skip-chars-forward "[:alnum:]-_.:") (point)))
+ (match
+ (if endp
+ (when (sgml-skip-tag-backward 1) (forward-char 1) t)
+ (with-syntax-table sgml-tag-syntax-table
+ (up-list -1)
+ (when (sgml-skip-tag-forward 1)
+ (backward-sexp 1)
+ (forward-char 2)
+ t))))
+ (clones (get-char-property (point) 'text-clones)))
+ (when (and match
+ (/= cl-end cl-start)
+ (equal (buffer-substring cl-start cl-end)
+ (buffer-substring (point)
+ (save-excursion
+ (skip-chars-forward "[:alnum:]-_.:")
+ (point))))
+ (or (not endp) (eq (char-after cl-end) ?>)))
+ (when clones
+ (message "sgml-electric-tag-pair-before-change-function: deleting old OLs")
+ (mapc 'delete-overlay clones))
+ (message "sgml-electric-tag-pair-before-change-function: new clone")
+ (text-clone-create cl-start cl-end 'spread "[[:alnum:]-_.:]+")
+ (setq sgml-electric-tag-pair-overlays
+ (append (get-char-property (point) 'text-clones)
+ sgml-electric-tag-pair-overlays))))))
+ (scan-error nil)
+ (error (message "Error in sgml-electric-pair-mode: %s" err))))
+
+(defun sgml-electric-tag-pair-flush-overlays ()
+ (while sgml-electric-tag-pair-overlays
+ (delete-overlay (pop sgml-electric-tag-pair-overlays))))
+
+(define-minor-mode sgml-electric-tag-pair-mode
+ "Automatically update the closing tag when editing the opening one."
+ :lighter "/e"
+ (if sgml-electric-tag-pair-mode
+ (progn
+ (add-hook 'before-change-functions
+ 'sgml-electric-tag-pair-before-change-function
+ nil t)
+ (unless sgml-electric-tag-pair-timer
+ (setq sgml-electric-tag-pair-timer
+ (run-with-idle-timer 5 'repeat 'sgml-electric-tag-pair-flush-overlays))))
+ (remove-hook 'before-change-functions
+ 'sgml-electric-tag-pair-before-change-function
+ t)
+ ;; We leave the timer running for other buffers.
+ ))
+
(defun sgml-skip-tag-forward (arg)
"Skip to end of tag or matching closing tag if present.
With prefix argument ARG, repeat this ARG times.
-Return t iff after a closing tag."
+Return t if after a closing tag."
(interactive "p")
;; FIXME: Use sgml-get-context or something similar.
;; It currently might jump to an unrelated </P> if the <P>
;; Show preceding or following hidden tag, depending of cursor direction.
(let ((inhibit-point-motion-hooks t))
(save-excursion
- (message "Invisible tag: %s"
- ;; Strip properties, otherwise, the text is invisible.
- (buffer-substring-no-properties
- (point)
- (if (or (and (> x y)
- (not (eq (following-char) ?<)))
- (and (< x y)
- (eq (preceding-char) ?>)))
- (backward-list)
- (forward-list)))))))
+ (condition-case nil
+ (message "Invisible tag: %s"
+ ;; Strip properties, otherwise, the text is invisible.
+ (buffer-substring-no-properties
+ (point)
+ (if (or (and (> x y)
+ (not (eq (following-char) ?<)))
+ (and (< x y)
+ (eq (preceding-char) ?>)))
+ (backward-list)
+ (forward-list))))
+ (error nil)))))
+
\f
(defun sgml-validate (command)
((eq (sgml-tag-type tag-info) 'open)
(cond
((null stack)
- (if (member-ignore-case (sgml-tag-name tag-info) ignore)
+ (if (assoc-string (sgml-tag-name tag-info) ignore t)
;; There was an implicit end-tag.
nil
(push tag-info context)
(defun sgml-empty-tag-p (tag-name)
"Return non-nil if TAG-NAME is an implicitly empty tag."
(and (not sgml-xml-mode)
- (member-ignore-case tag-name sgml-empty-tags)))
+ (assoc-string tag-name sgml-empty-tags 'ignore-case)))
(defun sgml-unclosed-tag-p (tag-name)
"Return non-nil if TAG-NAME is a tag for which an end-tag is optional."
(and (not sgml-xml-mode)
- (member-ignore-case tag-name sgml-unclosed-tags)))
+ (assoc-string tag-name sgml-unclosed-tags 'ignore-case)))
+
(defun sgml-calculate-indent (&optional lcon)
"Calculate the column to which this line should be indented.
(let* ((here (point))
(unclosed (and ;; (not sgml-xml-mode)
(looking-at sgml-tag-name-re)
- (member-ignore-case (match-string 1)
- sgml-unclosed-tags)
+ (assoc-string (match-string 1)
+ sgml-unclosed-tags 'ignore-case)
(match-string 1)))
(context
;; If possible, align on the previous non-empty text line.
("ul" . "Unordered list")
("var" . "Math variable face")
("wbr" . "Enable <br> within <nobr>"))
-"*Value of `sgml-tag-help' for HTML mode.")
+ "*Value of `sgml-tag-help' for HTML mode.")
\f
;;;###autoload
-(define-derived-mode html-mode sgml-mode "HTML"
+(define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML")
"Major mode based on SGML mode for editing HTML documents.
This allows inserting skeleton constructs used in hypertext documents with
completion. See below for an introduction to HTML. Use
outline-level (lambda ()
(char-before (match-end 0))))
(setq imenu-create-index-function 'html-imenu-index)
- (when sgml-xml-mode (setq mode-name "XHTML"))
(set (make-local-variable 'sgml-empty-tags)
;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd',
;; plus manual addition of "wbr".
HCoop / bpt / emacs.git / blobdiff