[Emacs-diffs] Changes to emacs/lisp/textmodes/sgml-mode.el [lexbind]

[Miles Bader]

Index: emacs/lisp/textmodes/sgml-mode.el
diff -c emacs/lisp/textmodes/sgml-mode.el:1.88.2.1 
emacs/lisp/textmodes/sgml-mode.el:1.88.2.2
*** emacs/lisp/textmodes/sgml-mode.el:1.88.2.1  Fri Apr  4 01:20:40 2003
--- emacs/lisp/textmodes/sgml-mode.el   Tue Oct 14 19:30:22 2003
***************
*** 239,244 ****
--- 239,245 ----
    :type '(choice (const nil) integer)
    :group 'sgml)
  
+ (defconst sgml-namespace-re "[_[:alpha:]][-_.[:alnum:]]*")
  (defconst sgml-name-re "[_:[:alpha:]][-_.:[:alnum:]]*")
  (defconst sgml-tag-name-re (concat "<\\([!/?]?" sgml-name-re "\\)"))
  (defconst sgml-attrs-re "\\(?:[^\"'/><]\\|\"[^\"]*\"\\|'[^']*'\\)*")
***************
*** 246,258 ****
    "Regular expression that matches a non-empty start tag.
  Any terminating `>' or `/' is not matched.")
  
  
  ;; internal
  (defconst sgml-font-lock-keywords-1
    `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
!     (,(concat "<\\(/?" sgml-name-re"\\)") 1 font-lock-function-name-face)
      ;; FIXME: this doesn't cover the variables using a default value.
!     (,(concat "\\(" sgml-name-re "\\)=[\"']") 1 font-lock-variable-name-face)
      (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
  
  (defconst sgml-font-lock-keywords-2
--- 247,270 ----
    "Regular expression that matches a non-empty start tag.
  Any terminating `>' or `/' is not matched.")
  
+ (defface sgml-namespace-face
+   '((t (:inherit font-lock-builtin-face)))
+   "`sgml-mode' face used to highlight the namespace part of identifiers.")
+ (defvar sgml-namespace-face 'sgml-namespace-face)
  
  ;; internal
  (defconst sgml-font-lock-keywords-1
    `((,(concat "<\\([!?]" sgml-name-re "\\)") 1 font-lock-keyword-face)
!     ;; We could use the simpler "\\(" sgml-namespace-re ":\\)?" instead,
!     ;; but it would cause a bit more backtracking in the re-matcher.
!     (,(concat "</?\\(" sgml-namespace-re "\\)\\(?::\\(" sgml-name-re 
"\\)\\)?")
!      (1 (if (match-end 2) sgml-namespace-face font-lock-function-name-face))
!      (2 font-lock-function-name-face nil t))
      ;; FIXME: this doesn't cover the variables using a default value.
!     (,(concat "\\(" sgml-namespace-re "\\)\\(?::\\("
!             sgml-name-re "\\)\\)?=[\"']")
!      (1 (if (match-end 2) sgml-namespace-face font-lock-variable-name-face))
!      (2 font-lock-variable-name-face nil t))
      (,(concat "[&%]" sgml-name-re ";?") . font-lock-variable-name-face)))
  
  (defconst sgml-font-lock-keywords-2
***************
*** 356,363 ****
              (looking-at "\\s-*<\\?xml")
              (when (re-search-forward
                     (eval-when-compile
!                      (mapconcat 'identity
!                                 '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
                                    "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
                                  "\\s-+"))
                     nil t)
--- 368,375 ----
              (looking-at "\\s-*<\\?xml")
              (when (re-search-forward
                     (eval-when-compile
!                (mapconcat 'identity
!                           '("<!DOCTYPE" "\\(\\w+\\)" "\\(\\w+\\)"
                                    "\"\\([^\"]+\\)\"" "\"\\([^\"]+\\)\"")
                                  "\\s-+"))
                     nil t)
***************
*** 448,453 ****
--- 460,466 ----
  
  ;; Some programs (such as Glade 2) generate XML which has
  ;; -*- mode: xml -*-.
+ ;;;###autoload
  (defalias 'xml-mode 'sgml-mode)
  
  (defun sgml-comment-indent ()
***************
*** 1033,1040 ****
  Assume that parsing starts from within a textual context.
  Leave point at the beginning of the tag."
    (let (tag-type tag-start tag-end name)
!     (or (search-backward ">" limit 'move)
          (error "No tag found"))
      (setq tag-end (1+ (point)))
      (cond
       ((sgml-looking-back-at "--")   ; comment
--- 1046,1059 ----
  Assume that parsing starts from within a textual context.
  Leave point at the beginning of the tag."
    (let (tag-type tag-start tag-end name)
!     (or (re-search-backward "[<>]" limit 'move)
          (error "No tag found"))
+     (when (eq (char-after) ?<)
+       ;; Oops!! Looks like we were not in a textual context after all!.
+       ;; Let's try to recover.
+       (with-syntax-table sgml-tag-syntax-table
+       (forward-sexp)
+       (forward-char -1)))
      (setq tag-end (1+ (point)))
      (cond
       ((sgml-looking-back-at "--")   ; comment
***************
*** 1070,1084 ****
      (goto-char tag-start)
      (sgml-make-tag tag-type tag-start tag-end name)))
  
! (defun sgml-get-context (&optional full)
    "Determine the context of the current position.
! If FULL is `empty', return even if the context is empty (i.e.
  we just skipped over some element and got to a beginning of line).
- If FULL is non-nil, parse back to the beginning of the buffer, otherwise
- parse until we find a start-tag as the first thing on a line.
  
  The context is a list of tag-info structures.  The last one is the tag
! immediately enclosing the current position."
    (let ((here (point))
        (ignore nil)
        (context nil)
--- 1089,1105 ----
      (goto-char tag-start)
      (sgml-make-tag tag-type tag-start tag-end name)))
  
! (defun sgml-get-context (&optional until)
    "Determine the context of the current position.
! By default, parse until we find a start-tag as the first thing on a line.
! If UNTIL is `empty', return even if the context is empty (i.e.
  we just skipped over some element and got to a beginning of line).
  
  The context is a list of tag-info structures.  The last one is the tag
! immediately enclosing the current position.
! 
! Point is assumed to be outside of any tag.  If we discover that it's
! not the case, the first tag returned is the one inside which we are."
    (let ((here (point))
        (ignore nil)
        (context nil)
***************
*** 1089,1100 ****
      ;;   enclosing start-tags we'll have to ignore.
      (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
      (while
!       (and (or ignore
!                  (not (if full (eq full 'empty) context))
                 (not (sgml-at-indentation-p))
                 (and context
                      (/= (point) (sgml-tag-start (car context)))
!                       (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
             (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
  
        ;; This tag may enclose things we thought were tags.  If so,
--- 1110,1122 ----
      ;;   enclosing start-tags we'll have to ignore.
      (skip-chars-backward " \t\n")      ; Make sure we're not at indentation.
      (while
!       (and (not (eq until 'now))
!            (or ignore
!                (not (if until (eq until 'empty) context))
                 (not (sgml-at-indentation-p))
                 (and context
                      (/= (point) (sgml-tag-start (car context)))
!                     (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
             (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
  
        ;; This tag may enclose things we thought were tags.  If so,
***************
*** 1105,1110 ****
--- 1127,1136 ----
          (setq context (cdr context)))
  
        (cond
+        ((> (sgml-tag-end tag-info) here)
+       ;; Oops!!  Looks like we were not outside of any tag, after all.
+       (push tag-info context)
+       (setq until 'now))
  
         ;; start-tag
         ((eq (sgml-tag-type tag-info) 'open)
***************
*** 1195,1293 ****
    (and (not sgml-xml-mode)
         (member-ignore-case tag-name sgml-unclosed-tags)))
  
! (defun sgml-calculate-indent ()
!   "Calculate the column to which this line should be indented."
!   (let ((lcon (sgml-lexical-context)))
! 
!     ;; Indent comment-start markers inside <!-- just like comment-end markers.
!     (if (and (eq (car lcon) 'tag)
!            (looking-at "--")
!            (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
!       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
  
!     (case (car lcon)
! 
!       (string
         ;; Go back to previous non-empty line.
         (while (and (> (point) (cdr lcon))
                   (zerop (forward-line -1))
!                  (looking-at "[ \t]*$")))
         (if (> (point) (cdr lcon))
!          ;; Previous line is inside the string.
!          (current-indentation)
         (goto-char (cdr lcon))
!        (1+ (current-column))))
! 
!       (comment
!        (let ((mark (looking-at "--")))
!        ;; Go back to previous non-empty line.
!        (while (and (> (point) (cdr lcon))
!                    (zerop (forward-line -1))
!                    (or (looking-at "[ \t]*$")
!                        (if mark (not (looking-at "[ \t]*--"))))))
!        (if (> (point) (cdr lcon))
!            ;; Previous line is inside the comment.
!            (skip-chars-forward " \t")
!          (goto-char (cdr lcon)))
!        (when (and (not mark) (looking-at "--"))
!          (forward-char 2) (skip-chars-forward " \t"))
!        (current-column)))
! 
!       (cdata
!        (current-column))
! 
!       (tag
         (goto-char (1+ (cdr lcon)))
!        (skip-chars-forward "^ \t\n")  ;Skip tag name.
!        (skip-chars-forward " \t")
!        (if (not (eolp))
!          (current-column)
!        ;; This is the first attribute: indent.
!        (goto-char (1+ (cdr lcon)))
!        (+ (current-column) sgml-basic-offset)))
! 
!       (text
!        (while (looking-at "</")
!        (forward-sexp 1)
!        (skip-chars-forward " \t"))
!        (let* ((here (point))
!             (unclosed (and ;; (not sgml-xml-mode)
!                            (looking-at sgml-tag-name-re)
!                            (member-ignore-case (match-string 1)
!                                                sgml-unclosed-tags)
!                            (match-string 1)))
!             (context
!              ;; If possible, align on the previous non-empty text line.
!              ;; Otherwise, do a more serious parsing to find the
!              ;; tag(s) relative to which we should be indenting.
!              (if (and (not unclosed) (skip-chars-backward " \t")
!                       (< (skip-chars-backward " \t\n") 0)
!                       (back-to-indentation)
!                       (> (point) (cdr lcon)))
!                  nil
!                (goto-char here)
!                (nreverse (sgml-get-context (if unclosed nil 'empty)))))
!             (there (point)))
!        ;; Ignore previous unclosed start-tag in context.
!        (while (and context unclosed
!                    (eq t (compare-strings
!                           (sgml-tag-name (car context)) nil nil
!                           unclosed nil nil t)))
!          (setq context (cdr context)))
!        ;; Indent to reflect nesting.
!        (if (and context
!                 (goto-char (sgml-tag-end (car context)))
!                 (skip-chars-forward " \t\n")
!                 (< (point) here) (sgml-at-indentation-p))
!            (current-column)
!          (goto-char there)
!          (+ (current-column)
!             (* sgml-basic-offset (length context))))))
  
!       (otherwise
!        (error "Unrecognised context %s" (car lcon)))
  
!       )))
  
  (defun sgml-indent-line ()
    "Indent the current line as SGML."
--- 1221,1333 ----
    (and (not sgml-xml-mode)
         (member-ignore-case tag-name sgml-unclosed-tags)))
  
! (defun sgml-calculate-indent (&optional lcon)
!   "Calculate the column to which this line should be indented.
! LCON is the lexical context, if any."
!   (unless lcon (setq lcon (sgml-lexical-context)))
! 
!   ;; Indent comment-start markers inside <!-- just like comment-end markers.
!   (if (and (eq (car lcon) 'tag)
!          (looking-at "--")
!          (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
!       (setq lcon (cons 'comment (+ (cdr lcon) 2))))
! 
!   (case (car lcon)
! 
!     (string
!      ;; Go back to previous non-empty line.
!      (while (and (> (point) (cdr lcon))
!                (zerop (forward-line -1))
!                (looking-at "[ \t]*$")))
!      (if (> (point) (cdr lcon))
!        ;; Previous line is inside the string.
!        (current-indentation)
!        (goto-char (cdr lcon))
!        (1+ (current-column))))
  
!     (comment
!      (let ((mark (looking-at "--")))
         ;; Go back to previous non-empty line.
         (while (and (> (point) (cdr lcon))
                   (zerop (forward-line -1))
!                  (or (looking-at "[ \t]*$")
!                      (if mark (not (looking-at "[ \t]*--"))))))
         (if (> (point) (cdr lcon))
!          ;; Previous line is inside the comment.
!          (skip-chars-forward " \t")
         (goto-char (cdr lcon))
!        ;; Skip `<!' to get to the `--' with which we want to align.
!        (search-forward "--")
!        (goto-char (match-beginning 0)))
!        (when (and (not mark) (looking-at "--"))
!        (forward-char 2) (skip-chars-forward " \t"))
!        (current-column)))
! 
!     ;; We don't know how to indent it.  Let's be honest about it.
!     (cdata nil)
! 
!     (tag
!      (goto-char (1+ (cdr lcon)))
!      (skip-chars-forward "^ \t\n")    ;Skip tag name.
!      (skip-chars-forward " \t")
!      (if (not (eolp))
!        (current-column)
!        ;; This is the first attribute: indent.
         (goto-char (1+ (cdr lcon)))
!        (+ (current-column) sgml-basic-offset)))
! 
!     (text
!      (while (looking-at "</")
!        (forward-sexp 1)
!        (skip-chars-forward " \t"))
!      (let* ((here (point))
!           (unclosed (and ;; (not sgml-xml-mode)
!                      (looking-at sgml-tag-name-re)
!                      (member-ignore-case (match-string 1)
!                                          sgml-unclosed-tags)
!                      (match-string 1)))
!           (context
!            ;; If possible, align on the previous non-empty text line.
!            ;; Otherwise, do a more serious parsing to find the
!            ;; tag(s) relative to which we should be indenting.
!            (if (and (not unclosed) (skip-chars-backward " \t")
!                     (< (skip-chars-backward " \t\n") 0)
!                     (back-to-indentation)
!                     (> (point) (cdr lcon)))
!                nil
!              (goto-char here)
!              (nreverse (sgml-get-context (if unclosed nil 'empty)))))
!           (there (point)))
!        ;; Ignore previous unclosed start-tag in context.
!        (while (and context unclosed
!                  (eq t (compare-strings
!                         (sgml-tag-name (car context)) nil nil
!                         unclosed nil nil t)))
!        (setq context (cdr context)))
!        ;; Indent to reflect nesting.
!        (cond
!       ;; If we were not in a text context after all, let's try again.
!       ((and context (> (sgml-tag-end (car context)) here))
!        (goto-char here)
!        (sgml-calculate-indent
!         (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
!                   (sgml-tag-type (car context)) 'tag)
!               (sgml-tag-start (car context)))))
!       ;; Align on the first element after the nearest open-tag, if any.
!       ((and context
!             (goto-char (sgml-tag-end (car context)))
!             (skip-chars-forward " \t\n")
!             (< (point) here) (sgml-at-indentation-p))
!        (current-column))
!       (t
!        (goto-char there)
!        (+ (current-column)
!           (* sgml-basic-offset (length context)))))))
  
!     (otherwise
!      (error "Unrecognised context %s" (car lcon)))
  
!     ))
  
  (defun sgml-indent-line ()
    "Indent the current line as SGML."
***************
*** 1298,1306 ****
            (back-to-indentation)
            (if (>= (point) savep) (setq savep nil))
            (sgml-calculate-indent))))
!     (if savep
!       (save-excursion (indent-line-to indent-col))
!       (indent-line-to indent-col))))
  
  (defun sgml-guess-indent ()
    "Guess an appropriate value for `sgml-basic-offset'.
--- 1338,1348 ----
            (back-to-indentation)
            (if (>= (point) savep) (setq savep nil))
            (sgml-calculate-indent))))
!     (if (null indent-col)
!       'noindent
!       (if savep
!         (save-excursion (indent-line-to indent-col))
!       (indent-line-to indent-col)))))
  
  (defun sgml-guess-indent ()
    "Guess an appropriate value for `sgml-basic-offset'.
***************
*** 1912,1915 ****
--- 1954,1958 ----
  
  (provide 'sgml-mode)
  
+ ;;; arch-tag: 9675da94-b7f9-4bda-ad19-73ed7b4fb401
  ;;; sgml-mode.el ends here