adamc@350: ;;; urweb-mode.el --- Major mode for editing (Standard) ML adamc@350: adamc@350: ;; Based on sml-mode: adamc@350: ;; Copyright (C) 1999,2000,2004 Stefan Monnier adamc@350: ;; Copyright (C) 1994-1997 Matthew J. Morley adamc@350: ;; Copyright (C) 1989 Lars Bo Nielsen adamc@350: ;; adamc@350: ;; Modified for urweb-mode: adamc@350: ;; Copyright (C) 2008 Adam Chlipala adamc@350: adamc@350: ;; Author: Lars Bo Nielsen adamc@350: ;; Olin Shivers adamc@350: ;; Fritz Knabe (?) adamc@350: ;; Steven Gilmore (?) adamc@350: ;; Matthew Morley (aka ) adamc@350: ;; Matthias Blume (aka ) adamc@350: ;; (Stefan Monnier) monnier@cs.yale.edu adamc@350: ;; Adam Chlipala adamc@350: adamc@350: ;; This file is not part of GNU Emacs, but it is distributed under the adamc@350: ;; same conditions. adamc@350: adamc@350: ;; This program is free software; you can redistribute it and/or adamc@350: ;; modify it under the terms of the GNU General Public License as adamc@350: ;; published by the Free Software Foundation; either version 2, or (at adamc@350: ;; your option) any later version. adamc@350: adamc@350: ;; This program is distributed in the hope that it will be useful, but adamc@350: ;; WITHOUT ANY WARRANTY; without even the implied warranty of adamc@350: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU adamc@350: ;; General Public License for more details. adamc@350: adamc@350: ;; You should have received a copy of the GNU General Public License adamc@350: ;; along with GNU Emacs; see the file COPYING. If not, write to the adamc@350: ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. adamc@350: adamc@350: ;;; Commentary: adamc@350: adamc@350: ;;; HISTORY adamc@350: adamc@350: ;; Still under construction: History obscure, needs a biographer as adamc@350: ;; well as a M-x doctor. Change Log on request. adamc@350: adamc@358: ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el. adamc@350: adamc@350: ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and adamc@350: ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus, adamc@350: ;; and numerous bugs and bug-fixes. adamc@350: adamc@350: ;;; DESCRIPTION adamc@350: adamc@350: ;; See accompanying info file: urweb-mode.info adamc@350: adamc@350: ;;; FOR YOUR .EMACS FILE adamc@350: adamc@350: ;; If urweb-mode.el lives in some non-standard directory, you must tell adamc@350: ;; emacs where to get it. This may or may not be necessary: adamc@350: adamc@350: ;; (add-to-list 'load-path "~jones/lib/emacs/") adamc@350: adamc@350: ;; Then to access the commands autoload urweb-mode with that command: adamc@350: adamc@350: ;; (load "urweb-mode-startup") adamc@350: adamc@350: ;; urweb-mode-hook is run whenever a new urweb-mode buffer is created. adamc@350: adamc@350: ;;; Code: adamc@350: adamc@350: (eval-when-compile (require 'cl)) adam@1747: (require 'compile) adamc@350: (require 'urweb-util) adamc@350: (require 'urweb-move) adamc@350: (require 'urweb-defs) adamc@350: (condition-case nil (require 'skeleton) (error nil)) adamc@350: adamc@350: ;;; VARIABLES CONTROLLING INDENTATION adamc@350: adamc@350: (defcustom urweb-indent-level 4 adamc@350: "*Indentation of blocks in Ur/Web (see also `urweb-structure-indent')." adamc@350: :group 'urweb adamc@350: :type '(integer)) adamc@350: adamc@350: (defcustom urweb-indent-args urweb-indent-level adamc@350: "*Indentation of args placed on a separate line." adamc@350: :group 'urweb adamc@350: :type '(integer)) adamc@350: adamc@350: (defcustom urweb-electric-semi-mode nil adamc@350: "*If non-nil, `\;' will self insert, reindent the line, and do a newline. adamc@350: If nil, just insert a `\;'. (To insert while t, do: \\[quoted-insert] \;)." adamc@350: :group 'urweb adamc@350: :type 'boolean) adamc@350: adamc@350: (defcustom urweb-rightalign-and t adamc@350: "If non-nil, right-align `and' with its leader. adamc@350: If nil: If t: adamc@350: datatype a = A datatype a = A adamc@350: and b = B and b = B" adamc@350: :group 'urweb adamc@350: :type 'boolean) adamc@350: adamc@350: ;;; OTHER GENERIC MODE VARIABLES adamc@350: adamc@350: (defvar urweb-mode-info "urweb-mode" adamc@350: "*Where to find Info file for `urweb-mode'. adamc@350: The default assumes the info file \"urweb-mode.info\" is on Emacs' info adamc@350: directory path. If it is not, either put the file on the standard path adamc@350: or set the variable `urweb-mode-info' to the exact location of this file adamc@350: adamc@350: (setq urweb-mode-info \"/usr/me/lib/info/urweb-mode\") adamc@350: adamc@350: in your .emacs file. You can always set it interactively with the adamc@350: set-variable command.") adamc@350: adamc@350: (defvar urweb-mode-hook nil adamc@350: "*Run upon entering `urweb-mode'. adamc@350: This is a good place to put your preferred key bindings.") adamc@350: adamc@350: ;;; CODE FOR Ur/Web-MODE adamc@350: adamc@350: (defun urweb-mode-info () adamc@350: "Command to access the TeXinfo documentation for `urweb-mode'. adamc@350: See doc for the variable `urweb-mode-info'." adamc@350: (interactive) adamc@350: (require 'info) adamc@350: (condition-case nil adamc@350: (info urweb-mode-info) adamc@350: (error (progn adamc@350: (describe-variable 'urweb-mode-info) adamc@350: (message "Can't find it... set this variable first!"))))) adamc@350: adamc@350: adamc@350: ;; font-lock setup adamc@350: adamc@350: (defconst urweb-keywords-regexp adamc@350: (urweb-syms-re "and" "case" "class" "con" "constraint" "constraints" adamc@621: "datatype" "else" "end" "extern" "fn" "map" adamc@350: "fun" "functor" "if" "include" adamc@446: "of" "open" "let" "in" adamc@1199: "rec" "sequence" "sig" "signature" "cookie" "style" "task" "policy" adamc@754: "struct" "structure" "table" "view" "then" "type" "val" "where" adam@2010: "with" "ffi" adamc@350: adamc@350: "Name" "Type" "Unit") adamc@350: "A regexp that matches any non-SQL keywords of Ur/Web.") adamc@350: adamc@350: (defconst urweb-sql-keywords-regexp adamc@993: (urweb-syms-re "SELECT" "DISTINCT" "FROM" "AS" "WHERE" "SQL" "GROUP" "ORDER" "BY" adamc@350: "HAVING" "LIMIT" "OFFSET" "ALL" "UNION" "INTERSECT" "EXCEPT" adamc@350: "TRUE" "FALSE" "AND" "OR" "NOT" "COUNT" "AVG" "SUM" "MIN" "MAX" adamc@708: "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE" adamc@714: "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK" adamc@749: "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL" kkallio@1572: "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1" adam@1682: "IF" "THEN" "ELSE" "COALESCE" "LIKE" "RANDOM") adamc@350: "A regexp that matches SQL keywords.") adamc@350: adamc@351: (defconst urweb-lident-regexp "\\<[a-z_][A-Za-z0-9_']*\\>" adamc@351: "A regexp that matches lowercase Ur/Web identifiers.") adamc@351: adamc@351: (defconst urweb-cident-regexp "\\<[A-Z][A-Za-z0-9_']*\\>" adamc@351: "A regexp that matches uppercase Ur/Web identifiers.") adamc@351: adamc@350: ;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; adamc@350: adamc@350: ;; The font lock regular expressions. adamc@350: adamc@363: (defun urweb-in-xml () adamc@360: (save-excursion adamc@360: (let ( adamc@360: (depth 0) adamc@360: (finished nil) adamc@360: (answer nil) adam@2115: (bound (max 0 (- (point) 1024))) adamc@360: ) adam@2115: (while (and (not finished) adam@2115: (re-search-backward "\\(\\([-{}]\\)\\|<\\(/?xml\\)?\\)" adam@2115: bound t)) adam@2115: (let ((xml-tag (length (or (match-string 3) ""))) adam@2115: (ch (match-string 2))) adam@2115: (cond julian@2142: ((equal ch "{") adam@2115: (if (> depth 0) adam@2115: (decf depth) adam@2115: (setq finished t))) julian@2142: ((equal ch "}") adam@2115: (incf depth)) adam@2115: ((= xml-tag 3) adam@2115: (if (> depth 0) adam@2115: (decf depth) adam@2115: (progn adam@2115: (setq answer t) adam@2115: (setq finished t)))) adam@2115: ((= xml-tag 4) adam@2115: (incf depth)) vshabanoff@1565: julian@2142: ((equal ch "-") adam@2115: (if (looking-at "->") adam@2115: (setq finished (= depth 0)))) vshabanoff@1566: adam@2115: ((and (= depth 0) adam@2115: (not (looking-at " julian@2142: (let ((face (get-text-property (point) 'face))) julian@2142: (funcall (if (listp face) #'member #'equal) 'font-lock-tag-face face))) adam@2115: ;; previous code was highlighted as tag, seems we are in xml adam@2115: (progn adam@2115: (setq answer t) adam@2115: (setq finished t))) vshabanoff@1565: adam@2115: ((= depth 0) adam@2115: ;; previous thing was a tag like, but not tag adam@2115: ;; seems we are in usual code or comment adam@2115: (setq finished t)) adam@2115: ))) adamc@360: answer))) adamc@360: adamc@360: (defun amAttribute (face) adamc@360: (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<"))) adamc@360: nil adamc@360: face)) adamc@358: adamc@350: (defconst urweb-font-lock-keywords adamc@350: `(;;(urweb-font-comments-and-strings) adamc@362: ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*\\(/?>\\)" adamc@359: (1 font-lock-tag-face) adamc@359: (3 font-lock-tag-face)) adamc@359: ("\\(\\)" adamc@359: (1 font-lock-tag-face)) adamc@359: ("\\([^<>{}]+\\)" adamc@363: (1 (if (urweb-in-xml) adamc@359: font-lock-string-face adamc@359: nil))) adamc@359: adamc@357: ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]" adamc@350: (1 font-lock-keyword-face) adamc@360: (2 (amAttribute font-lock-function-name-face))) adamc@357: ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)" adamc@350: (1 font-lock-keyword-face) adamc@360: (3 (amAttribute font-lock-type-def-face))) adamc@1199: ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\|task\\|policy\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]" adamc@350: (1 font-lock-keyword-face) adamc@360: (3 (amAttribute font-lock-variable-name-face))) adamc@350: ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)" adamc@350: (1 font-lock-keyword-face) adamc@360: (2 (amAttribute font-lock-module-def-face))) adamc@350: ("\\<\\(signature\\)\\s-+\\(\\sw+\\)" adamc@350: (1 font-lock-keyword-face) adamc@360: (2 (amAttribute font-lock-interface-def-face))) adam@2175: adamc@350: (,urweb-keywords-regexp . font-lock-keyword-face) adamc@351: (,urweb-sql-keywords-regexp . font-lock-sql-face) adamc@351: (,urweb-cident-regexp . font-lock-cvariable-face)) adamc@350: "Regexps matching standard Ur/Web keywords.") adamc@350: adamc@350: (defface font-lock-type-def-face adamc@350: '((t (:bold t))) adamc@350: "Font Lock mode face used to highlight type definitions." adamc@350: :group 'font-lock-highlighting-faces) adamc@350: (defvar font-lock-type-def-face 'font-lock-type-def-face adamc@350: "Face name to use for type definitions.") adamc@350: adamc@350: (defface font-lock-module-def-face adamc@350: '((t (:bold t))) adamc@350: "Font Lock mode face used to highlight module definitions." adamc@350: :group 'font-lock-highlighting-faces) adamc@350: (defvar font-lock-module-def-face 'font-lock-module-def-face adamc@350: "Face name to use for module definitions.") adamc@350: adamc@350: (defface font-lock-interface-def-face adamc@350: '((t (:bold t))) adamc@350: "Font Lock mode face used to highlight interface definitions." adamc@350: :group 'font-lock-highlighting-faces) adamc@350: (defvar font-lock-interface-def-face 'font-lock-interface-def-face adamc@350: "Face name to use for interface definitions.") adamc@350: adamc@350: (defface font-lock-sql-face adamc@350: '((t (:bold t))) adamc@350: "Font Lock mode face used to highlight SQL keywords." adamc@350: :group 'font-lock-highlighting-faces) adamc@350: (defvar font-lock-sql-face 'font-lock-sql-face adamc@350: "Face name to use for SQL keywords.") adamc@350: adamc@351: (defface font-lock-cvariable-face adamc@351: '((t (:foreground "dark blue"))) adamc@351: "Font Lock mode face used to highlight capitalized identifiers." adamc@351: :group 'font-lock-highlighting-faces) adamc@351: (defvar font-lock-cvariable-face 'font-lock-cvariable-face adamc@351: "Face name to use for capitalized identifiers.") adamc@351: adamc@357: (defface font-lock-tag-face adamc@357: '((t (:bold t))) adamc@357: "Font Lock mode face used to highlight XML tags." adamc@357: :group 'font-lock-highlighting-faces) adamc@357: (defvar font-lock-tag-face 'font-lock-tag-face adamc@357: "Face name to use for XML tags.") adamc@357: adamc@358: (defface font-lock-attr-face adamc@358: '((t (:bold t))) adamc@358: "Font Lock mode face used to highlight XML attributes." adamc@358: :group 'font-lock-highlighting-faces) adamc@358: (defvar font-lock-attr-face 'font-lock-attr-face adamc@358: "Face name to use for XML attributes.") adamc@358: adamc@350: ;; adamc@350: ;; Code to handle nested comments and unusual string escape sequences adamc@350: ;; adamc@350: adamc@350: (defsyntax urweb-syntax-prop-table adamc@350: '((?\\ . ".") (?* . ".")) adamc@350: "Syntax table for text-properties") adamc@350: adamc@350: ;; For Emacsen that have no built-in support for nested comments adamc@350: (defun urweb-get-depth-st () adamc@350: (save-excursion adamc@350: (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil)) adamc@350: (_ (backward-char)) adamc@350: (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp)) adamc@350: (pt (point))) adamc@350: (when disp adamc@350: (let* ((depth adamc@350: (save-match-data adamc@350: (if (re-search-backward "\\*)\\|(\\*" nil t) adamc@350: (+ (or (get-char-property (point) 'comment-depth) 0) adamc@350: (case (char-after) (?\( 1) (?* 0)) adamc@350: disp) adamc@350: 0))) adamc@350: (depth (if (> depth 0) depth))) adamc@350: (put-text-property pt (1+ pt) 'comment-depth depth) adamc@350: (when depth urweb-syntax-prop-table)))))) adamc@350: adamc@350: (defconst urweb-font-lock-syntactic-keywords adamc@350: `(("^\\s-*\\(\\\\\\)" (1 ',urweb-syntax-prop-table)) adamc@350: ,@(unless urweb-builtin-nested-comments-flag adamc@350: '(("(?\\(\\*\\))?" (1 (urweb-get-depth-st))))))) adamc@350: adamc@350: (defconst urweb-font-lock-defaults adamc@350: '(urweb-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil adamc@350: (font-lock-syntactic-keywords . urweb-font-lock-syntactic-keywords))) adamc@350: adamc@350: ;;;; adamc@350: ;;;; Imenu support adamc@350: ;;;; adamc@350: adamc@350: (defvar urweb-imenu-regexp adamc@350: (concat "^[ \t]*\\(let[ \t]+\\)?" adamc@350: (regexp-opt (append urweb-module-head-syms adamc@350: '("and" "fun" "datatype" "type")) t) adamc@350: "\\>")) adamc@350: adamc@350: (defun urweb-imenu-create-index () adamc@350: (let (alist) adamc@350: (goto-char (point-max)) adamc@350: (while (re-search-backward urweb-imenu-regexp nil t) adamc@350: (save-excursion adamc@350: (let ((kind (match-string 2)) adamc@350: (column (progn (goto-char (match-beginning 2)) (current-column))) adamc@350: (location adamc@350: (progn (goto-char (match-end 0)) adamc@350: (urweb-forward-spaces) adamc@350: (when (looking-at urweb-tyvarseq-re) adamc@350: (goto-char (match-end 0))) adamc@350: (point))) adamc@350: (name (urweb-forward-sym))) adamc@350: ;; Eliminate trivial renamings. adamc@350: (when (or (not (member kind '("structure" "signature"))) adamc@350: (progn (search-forward "=") adamc@350: (urweb-forward-spaces) adamc@350: (looking-at "sig\\|struct"))) adamc@350: (push (cons (concat (make-string (/ column 2) ?\ ) name) location) adamc@350: alist))))) adamc@350: alist)) adamc@350: adamc@350: ;;; MORE CODE FOR URWEB-MODE adamc@350: adamc@350: ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name)) adamc@350: ;;;###autoload adamc@362: (add-to-list 'auto-mode-alist '("\\.urs?\\'" . urweb-mode)) adamc@350: adamc@350: ;;;###autoload adam@2175: (define-derived-mode urweb-mode prog-mode "Ur/Web" adamc@350: "\\Major mode for editing Ur/Web code. adamc@350: This mode runs `urweb-mode-hook' just before exiting. adamc@350: \\{urweb-mode-map}" adamc@350: (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults) adamc@358: (set (make-local-variable 'font-lock-multiline) 'undecided) adamc@350: (set (make-local-variable 'outline-regexp) urweb-outline-regexp) adamc@350: (set (make-local-variable 'imenu-create-index-function) adamc@350: 'urweb-imenu-create-index) adamc@350: (set (make-local-variable 'add-log-current-defun-function) adamc@350: 'urweb-current-fun-name) adamc@350: ;; Treat paragraph-separators in comments as paragraph-separators. adamc@350: (set (make-local-variable 'paragraph-separate) adamc@350: (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)")) adamc@350: (set (make-local-variable 'require-final-newline) t) adamc@350: ;; forward-sexp-function is an experimental variable in my hacked Emacs. adamc@350: (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp) adamc@350: ;; For XEmacs adamc@350: (easy-menu-add urweb-mode-menu) adamc@358: adamc@350: ;; Compatibility. FIXME: we should use `-' in Emacs-CVS. adamc@350: (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil)) adamc@358: adam@1747: (local-set-key (kbd "C-c C-c") 'compile) julian@2140: (local-set-key (kbd "C-c /") 'urweb-close-matching-tag) adam@1747: adamc@360: (urweb-mode-variables)) adamc@350: adamc@350: (defun urweb-mode-variables () adamc@350: (set-syntax-table urweb-mode-syntax-table) adamc@350: (setq local-abbrev-table urweb-mode-abbrev-table) adamc@350: ;; A paragraph is separated by blank lines or ^L only. adam@2175: adamc@350: (set (make-local-variable 'indent-line-function) 'urweb-indent-line) adamc@350: (set (make-local-variable 'comment-start) "(* ") adamc@350: (set (make-local-variable 'comment-end) " *)") adamc@350: (set (make-local-variable 'comment-nested) t) adamc@350: ;;(set (make-local-variable 'block-comment-start) "* ") adamc@350: ;;(set (make-local-variable 'block-comment-end) "") adamc@350: ;; (set (make-local-variable 'comment-column) 40) adamc@350: (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*")) adamc@350: adamc@350: (defun urweb-funname-of-and () adamc@350: "Name of the function this `and' defines, or nil if not a function. adamc@350: Point has to be right after the `and' symbol and is not preserved." adamc@350: (urweb-forward-spaces) adamc@350: (if (looking-at urweb-tyvarseq-re) (goto-char (match-end 0))) adamc@350: (let ((sym (urweb-forward-sym))) adamc@350: (urweb-forward-spaces) adamc@350: (unless (or (member sym '(nil "d=")) adamc@350: (member (urweb-forward-sym) '("d="))) adamc@350: sym))) adamc@350: adamc@350: ;;; INDENTATION !!! adamc@350: adamc@350: (defun urweb-mark-function () adamc@350: "Synonym for `mark-paragraph' -- sorry. adamc@350: If anyone has a good algorithm for this..." adamc@350: (interactive) adamc@350: (mark-paragraph)) adamc@350: adamc@350: (defun urweb-indent-line () adamc@350: "Indent current line of Ur/Web code." adamc@350: (interactive) adamc@350: (let ((savep (> (current-column) (current-indentation))) adamc@350: (indent (max (or (ignore-errors (urweb-calculate-indentation)) 0) 0))) adamc@350: (if savep adamc@350: (save-excursion (indent-line-to indent)) adamc@350: (indent-line-to indent)))) adamc@350: adamc@350: (defun urweb-back-to-outer-indent () adamc@350: "Unindents to the next outer level of indentation." adamc@350: (interactive) adamc@350: (save-excursion adamc@350: (beginning-of-line) adamc@350: (skip-chars-forward "\t ") adamc@350: (let ((start-column (current-column)) adamc@350: (indent (current-column))) adamc@350: (if (> start-column 0) adamc@350: (progn adamc@350: (save-excursion adamc@350: (while (>= indent start-column) adamc@350: (if (re-search-backward "^[^\n]" nil t) adamc@350: (setq indent (current-indentation)) adamc@350: (setq indent 0)))) adamc@350: (backward-delete-char-untabify (- start-column indent))))))) adamc@350: adamc@350: (defun urweb-find-comment-indent () adamc@350: (save-excursion adamc@350: (let ((depth 1)) adamc@350: (while (> depth 0) adamc@350: (if (re-search-backward "(\\*\\|\\*)" nil t) adamc@350: (cond adamc@350: ;; FIXME: That's just a stop-gap. adamc@350: ((eq (get-text-property (point) 'face) 'font-lock-string-face)) adamc@350: ((looking-at "*)") (incf depth)) adamc@350: ((looking-at comment-start-skip) (decf depth))) adamc@350: (setq depth -1))) adamc@350: (if (= depth 0) adamc@350: (1+ (current-column)) adamc@350: nil)))) adamc@350: adamc@369: (defun urweb-empty-line () adamc@365: (save-excursion adamc@369: (beginning-of-line) adamc@365: (let ((start-pos (point))) adamc@369: (end-of-line) adamc@369: (not (re-search-backward "[^\n \t]" start-pos t))))) adamc@365: adamc@369: (defun urweb-seek-back () adamc@369: (while (urweb-empty-line) (previous-line 1))) adamc@363: adamc@369: (defun urweb-skip-matching-braces () adamc@367: "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code" adamc@367: (beginning-of-line) adamc@367: (let ((start-pos (point)) adamc@367: (depth 0)) adamc@367: (end-of-line) adamc@367: (while (re-search-backward "[{}]" start-pos t) adamc@367: (cond adamc@367: ((looking-at "}") adamc@367: (incf depth)) adamc@367: ((looking-at "{") adamc@367: (decf depth)))) adamc@367: (while (and (> depth 0) (re-search-backward "[{}]" nil t) adamc@367: (cond adamc@367: ((looking-at "}") adamc@367: (incf depth)) adamc@367: ((looking-at "{") adamc@367: (decf depth))))))) adamc@367: adamc@369: (defun urweb-new-tags () adamc@369: "Decide if the previous line of XML introduced unclosed tags" adamc@369: (save-excursion adamc@369: (let ((start-pos (point)) adamc@369: (depth 0) adamc@369: (done nil)) adamc@369: (previous-line 1) adamc@369: (urweb-seek-back) adamc@369: (urweb-skip-matching-braces) adamc@369: (urweb-seek-back) adamc@369: (beginning-of-line) adamc@369: (while (and (not done) (search-forward "<" start-pos t)) adamc@396: (cond adamc@396: ((or (looking-at " ") (looking-at "=")) adamc@396: nil) adamc@396: ((looking-at "/") adamc@396: (if (re-search-forward "[^\\sw]>" start-pos t) adamc@369: (when (> depth 0) (decf depth)) adamc@396: (setq done t))) adamc@396: (t adamc@396: (if (re-search-forward "[^\\sw]>" start-pos t) adamc@369: (if (not (save-excursion (backward-char 2) (looking-at "/"))) adamc@369: (incf depth)) adamc@396: (setq done t))))) adamc@369: (and (not done) (> depth 0))))) adamc@369: adamc@363: (defun urweb-tag-matching-indent () adamc@363: "Seek back to a matching opener tag and get its line's indent" adamc@363: (save-excursion adamc@369: (end-of-line) adamc@369: (search-backward "]+\\)" nil t)) julian@2140: (let ((tag (match-string-no-properties 1))) julian@2140: (insert ""))) julian@2140: adamc@373: (defconst urweb-sql-main-starters adamc@1071: '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE" "FROM" "SELECT1" "WHERE")) adamc@373: adamc@372: (defconst urweb-sql-starters adamc@373: (append urweb-sql-main-starters adamc@373: '("^\\s-+FROM" "WHERE" "GROUP" "ORDER" "HAVING" "LIMIT" "OFFSET" adamc@373: "VALUES" "SET"))) adamc@372: adamc@373: (defconst urweb-sql-main-starters-re adamc@373: (urweb-syms-re urweb-sql-main-starters)) adamc@372: (defconst urweb-sql-starters-re adamc@372: (urweb-syms-re urweb-sql-starters)) adamc@372: adamc@374: (defconst urweb-sql-main-starters-paren-re adamc@374: (concat "(" urweb-sql-main-starters-re)) adamc@374: adamc@374: (defun urweb-in-sql () adamc@374: "Check if the point is in a block of SQL syntax." adamc@374: (save-excursion adamc@375: (let ((start-pos (point)) adamc@375: (depth 0) adamc@375: done adamc@375: (good t)) adamc@375: (when (re-search-backward urweb-sql-main-starters-paren-re nil t) adamc@375: (forward-char) adamc@375: (while (and (not done) (re-search-forward "[()]" start-pos t)) adamc@375: (save-excursion adamc@375: (backward-char) adamc@375: (cond adamc@375: ((looking-at ")") adamc@375: (cond adamc@375: ((= depth 0) (setq done t) (setq good nil)) adamc@375: (t (decf depth)))) adamc@375: ((looking-at "(") adamc@375: (incf depth))))) adamc@375: good)))) adamc@374: adamc@374: (defun urweb-sql-depth () adamc@374: "Check if the point is in a block of SQL syntax. adamc@374: Returns the paren nesting depth if so, and nil otherwise." adamc@374: (save-excursion adamc@374: (let ((depth 0) adamc@374: done) adamc@374: (while (and (not done) adamc@374: (re-search-backward "[()]" nil t)) adamc@374: (cond adamc@374: ((looking-at ")") adamc@374: (decf depth)) adamc@374: ((looking-at "(") adamc@374: (if (looking-at urweb-sql-main-starters-paren-re) adamc@374: (setq done t) adamc@374: (incf depth))))) adamc@374: (max 0 depth)))) adamc@374: adamc@350: (defun urweb-calculate-indentation () adamc@350: (save-excursion adamc@350: (beginning-of-line) (skip-chars-forward "\t ") adamc@350: (urweb-with-ist adamc@350: ;; Indentation for comments alone on a line, matches the adamc@350: ;; proper indentation of the next line. adamc@350: (when (looking-at "(\\*") (urweb-forward-spaces)) adamc@350: (let (data adamc@350: (sym (save-excursion (urweb-forward-sym)))) adamc@350: (or adamc@350: ;; Allow the user to override the indentation. adamc@350: (when (looking-at (concat ".*" (regexp-quote comment-start) adamc@350: "[ \t]*fixindent[ \t]*" adamc@350: (regexp-quote comment-end))) adamc@350: (current-indentation)) adamc@350: adamc@350: ;; Continued comment. adamc@350: (and (looking-at "\\*") (urweb-find-comment-indent)) adamc@350: adamc@363: (and (urweb-in-xml) adamc@363: (let ((prev-indent (save-excursion adamc@363: (previous-line 1) adamc@369: (urweb-seek-back) adamc@369: (urweb-skip-matching-braces) adamc@369: (urweb-seek-back) adamc@363: (current-indentation)))) adamc@363: (cond adamc@363: ((looking-at " count 0) adamc@350: (setq name (urweb-beginning-of-defun))) adamc@350: (decf count) adamc@350: (setq fullname (if fullname (concat name "." fullname) name)) adamc@350: ;; Skip all other declarations that we find at the same level. adamc@350: (urweb-skip-siblings)) adamc@350: fullname))) adamc@350: adamc@350: (provide 'urweb-mode) adamc@350: adamc@350: ;;; urweb-mode.el ends here