# HG changeset patch # User Stefan Monnier # Date 1182088517 0 # Node ID 2be88db9aeedfa7c0d2f0c0f988b50713da568f5 # Parent c08813c7fc1cf15a0de7ab6dcc8685e3bc02a983 (sgml-xml-guess): Return the result rather than setting sgml-xml-mode. (sgml-mode, html-mode): Set sgml-xml-mode. (sgml-skip-tag-backward): Tell if we skipped over matched tags. (sgml-skip-tag-backward, sgml-electric-tag-pair-overlays): New var. (sgml-electric-tag-pair-before-change-function) (sgml-electric-tag-pair-flush-overlays): New functions. (sgml-electric-tag-pair-mode): New minor mode. (sgml-font-lock-keywords-2, sgml-get-context, sgml-unclosed-tag-p) (sgml-calculate-indent): Use assoc-string. diff -r c08813c7fc1c -r 2be88db9aeed etc/NEWS --- a/etc/NEWS Sun Jun 17 01:48:59 2007 +0000 +++ b/etc/NEWS Sun Jun 17 13:55:17 2007 +0000 @@ -71,6 +71,8 @@ ** VC has some support for Bazaar (bzr). +** sgml-electric-tag-pair-mode lets you simultaneously edit matched tag pairs. + * Changes in Emacs 23.1 on non-free operating systems diff -r c08813c7fc1c -r 2be88db9aeed lisp/ChangeLog --- a/lisp/ChangeLog Sun Jun 17 01:48:59 2007 +0000 +++ b/lisp/ChangeLog Sun Jun 17 13:55:17 2007 +0000 @@ -1,3 +1,16 @@ +2007-06-17 Stefan Monnier + + * textmodes/sgml-mode.el (sgml-xml-guess): Return the result rather + than setting sgml-xml-mode. + (sgml-mode, html-mode): Set sgml-xml-mode. + (sgml-skip-tag-backward): Tell if we skipped over matched tags. + (sgml-skip-tag-backward, sgml-electric-tag-pair-overlays): New var. + (sgml-electric-tag-pair-before-change-function) + (sgml-electric-tag-pair-flush-overlays): New functions. + (sgml-electric-tag-pair-mode): New minor mode. + (sgml-font-lock-keywords-2, sgml-get-context, sgml-unclosed-tag-p) + (sgml-calculate-indent): Use assoc-string. + 2007-06-16 Karl Fogel * thingatpt.el (thing-at-point-email-regexp): Don't require two @@ -11,19 +24,18 @@ (thing-at-point-email-regexp): New variable. (`email'): Put `bounds-of-thing-at-point' and `thing-at-point' properties on this symbol, with lambda forms for values. - + 2007-06-15 Masatake YAMATO - * vc-bzr.el (vc-bzr-root): Cache the output of shell command - execution. + * vc-bzr.el (vc-bzr-root): Cache the output of shell command execution. - * vc.el (vc-dired-hook): Check the backend returned from + * vc.el (vc-dired-hook): Check the backend returned from `vc-responsible-backend' can really handle `subdir'. 2007-06-15 Chong Yidong - * wid-edit.el (widget-add-documentation-string-button): Fix - handling of documentation indent. + * wid-edit.el (widget-add-documentation-string-button): + Fix handling of documentation indent. 2007-06-15 Miles Bader @@ -47,8 +59,8 @@ (custom-variable-value-create, custom-face-value-create) (custom-visibility): New widget. (custom-visibility): New face. - (custom-group-value-create): Call - widget-add-documentation-string-button, using `custom-visibility'. + (custom-group-value-create): + Call widget-add-documentation-string-button, using `custom-visibility'. 2007-06-14 Stefan Monnier diff -r c08813c7fc1c -r 2be88db9aeed lisp/textmodes/sgml-mode.el --- a/lisp/textmodes/sgml-mode.el Sun Jun 17 01:48:59 2007 +0000 +++ b/lisp/textmodes/sgml-mode.el Sun Jun 17 13:55:17 2007 +0000 @@ -281,8 +281,8 @@ . (cons (concat "<" (regexp-opt (mapcar 'car sgml-tag-face-alist) t) "\\([ \t][^>]*\\)?>\\([^<]+\\)") - '(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 @@ -368,20 +368,19 @@ "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 '(" match <. Keys <, &, SPC within <>, \", / and ' can be electric depending on @@ -461,9 +460,9 @@ . 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 @@ -736,22 +735,93 @@ (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 "]+\\)") - ;; end tag, skip any nested pairs - (let ((case-fold-search t) - (re (concat ". - "\\([^>]*[^/>]\\)?>"))) - (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 "]+\\)") + ;; end tag, skip any nested pairs + (let ((case-fold-search t) + (re (concat ". + "\\([^>]*[^/>]\\)?>"))) + (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. @@ -1220,7 +1290,7 @@ ((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) @@ -1305,12 +1375,13 @@ (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. @@ -1376,8 +1447,8 @@ (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. @@ -1815,11 +1886,11 @@ ("ul" . "Unordered list") ("var" . "Math variable face") ("wbr" . "Enable
within ")) -"*Value of `sgml-tag-help' for HTML mode.") + "*Value of `sgml-tag-help' for HTML mode.") ;;;###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 @@ -1873,7 +1944,6 @@ 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".