/[emacs]/emacs/lisp/textmodes/sgml-mode.el
ViewVC logotype

Diff of /emacs/lisp/textmodes/sgml-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.69 by monnier, Fri Mar 29 19:38:22 2002 UTC revision 1.70 by monnier, Fri Mar 29 22:20:15 2002 UTC
# Line 846  and move to the line in the SGML documen Line 846  and move to the line in the SGML documen
846  (defun sgml-lexical-context (&optional limit)  (defun sgml-lexical-context (&optional limit)
847    "Return the lexical context at point as (TYPE . START).    "Return the lexical context at point as (TYPE . START).
848  START is the location of the start of the lexical element.  START is the location of the start of the lexical element.
849  TYPE is one of `string', `comment', `tag', `cdata', ....  TYPE is one of `string', `comment', `tag', or `text'.
 Return nil if we are inside text (i.e. outside of any kind of tag).  
850    
851  If non-nil LIMIT is a nearby position before point outside of any tag."  If non-nil LIMIT is a nearby position before point outside of any tag."
852    ;; As usual, it's difficult to get a reliable answer without parsing the    ;; As usual, it's difficult to get a reliable answer without parsing the
# Line 855  If non-nil LIMIT is a nearby position be Line 854  If non-nil LIMIT is a nearby position be
854    ;; any string or tag or comment or ...    ;; any string or tag or comment or ...
855    (save-excursion    (save-excursion
856      (let ((pos (point))      (let ((pos (point))
857            (state nil))            (state nil)
858              textstart)
859        (if limit (goto-char limit)        (if limit (goto-char limit)
860          ;; Hopefully this regexp will match something that's not inside          ;; Hopefully this regexp will match something that's not inside
861          ;; a tag and also hopefully the match is nearby.          ;; a tag and also hopefully the match is nearby.
862          (re-search-backward "^[ \t]*<[_:[:alpha:]/%!?#]" nil 'move))          (re-search-backward "^[ \t]*<[_:[:alpha:]/%!?#]" nil 'move))
863          (setq textstart (point))
864        (with-syntax-table sgml-tag-syntax-table        (with-syntax-table sgml-tag-syntax-table
865          (while (< (point) pos)          (while (< (point) pos)
866            ;; When entering this loop we're inside text.            ;; When entering this loop we're inside text.
867              (setq textstart (point))
868            (skip-chars-forward "^<" pos)            (skip-chars-forward "^<" pos)
869            ;; We skipped text and reached a tag.  Parse it.            ;; We skipped text and reached a tag.  Parse it.
870            ;; FIXME: this does not handle CDATA and funny stuff yet.            ;; FIXME: Handle net-enabling start-tags and <![CDATA[ ...]]>.
871            (setq state (parse-partial-sexp (point) pos 0)))            (setq state (parse-partial-sexp (point) pos 0)))
872          (cond          (cond
873           ((nth 3 state) (cons 'string (nth 8 state)))           ((nth 3 state) (cons 'string (nth 8 state)))
874           ((nth 4 state) (cons 'comment (nth 8 state)))           ((nth 4 state) (cons 'comment (nth 8 state)))
875           ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))           ((and state (> (nth 0 state) 0)) (cons 'tag (nth 1 state)))
876           (t nil))))))           (t (cons 'text textstart)))))))
877    
878  (defun sgml-beginning-of-tag (&optional top-level)  (defun sgml-beginning-of-tag (&optional top-level)
879    "Skip to beginning of tag and return its name.    "Skip to beginning of tag and return its name.
# Line 883  If this can't be done, return nil." Line 885  If this can't be done, return nil."
885            (when (looking-at sgml-tag-name-re)            (when (looking-at sgml-tag-name-re)
886              (match-string-no-properties 1)))              (match-string-no-properties 1)))
887        (if top-level nil        (if top-level nil
888          (when context          (when (not (eq (car context) 'text))
889            (goto-char (cdr context))            (goto-char (cdr context))
890            (sgml-beginning-of-tag t))))))            (sgml-beginning-of-tag t))))))
891    
# Line 968  With prefix argument, unquote the region Line 970  With prefix argument, unquote the region
970           (goto-char (1+ (cdr lcon)))           (goto-char (1+ (cdr lcon)))
971           (+ (current-column) sgml-basic-offset)))           (+ (current-column) sgml-basic-offset)))
972    
973        (t        (t ;; text
974         (while (looking-at "</")         (while (looking-at "</")
975           (forward-sexp 1)           (forward-sexp 1)
976           (skip-chars-forward " \t"))           (skip-chars-forward " \t"))
977         (let ((context (xml-lite-get-context)))         (let* ((here (point))
978           (cond                (unclosed (and ;; (not sgml-xml-mode)
979            ((null context) 0)            ; no context                               (looking-at sgml-tag-name-re)
980            (t                               (member-ignore-case (match-string 1)
981             (let ((here (point)))                                                   sgml-unclosed-tags)
982               (goto-char (xml-lite-tag-end (car context)))                               (match-string 1)))
983               (skip-chars-forward " \t\n")                (context
984               (if (and (< (point) here) (xml-lite-at-indentation-p))                 ;; If possible, align on the previous non-empty text line.
985                   (current-column)                 ;; Otherwise, do a more serious parsing to find the
986                 (goto-char (xml-lite-tag-start (car context)))                 ;; tag(s) relative to which we should be indenting.
987                 (+ (current-column)                 (if (and (not unclosed) (skip-chars-backward " \t")
988                    (* sgml-basic-offset (length context))))))))))))                          (< (skip-chars-backward " \t\n") 0)
989                            (back-to-indentation)
990                            (> (point) (cdr lcon)))
991                       nil
992                     (goto-char here)
993                     (nreverse (xml-lite-get-context (if unclosed nil 'empty)))))
994                  (there (point)))
995             ;; Ignore previous unclosed start-tag in context.
996             (while (and context unclosed
997                         (eq t (compare-strings
998                                (xml-lite-tag-name (car context)) nil nil
999                                unclosed nil nil t)))
1000               (setq context (cdr context)))
1001             ;; Indent to reflect nesting.
1002             (if (and context
1003                      (goto-char (xml-lite-tag-end (car context)))
1004                      (skip-chars-forward " \t\n")
1005                      (< (point) here) (xml-lite-at-indentation-p))
1006                 (current-column)
1007               (goto-char there)
1008               (+ (current-column)
1009                  (* sgml-basic-offset (length context)))))))))
1010    
1011  (defun sgml-indent-line ()  (defun sgml-indent-line ()
1012    "Indent the current line as SGML."    "Indent the current line as SGML."

Legend:
Removed from v.1.69  
changed lines
  Added in v.1.70

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26