Mercurial > urweb

annotate src/elisp/urweb-mode.el @ 709:0406e9cccb72

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
FOREIGN KEY, without ability to link NULL to NOT NULL (and with some lingering problems in row inference)
author Adam Chlipala <adamc@hcoop.net>
date Tue, 07 Apr 2009 18:47:47 -0400
parents 1a317a707d71
children 0f42461273cf
rev   line source
adamc@350 1 ;;; urweb-mode.el --- Major mode for editing (Standard) ML
adamc@350 2
adamc@350 3 ;; Based on sml-mode:
adamc@350 4 ;; Copyright (C) 1999,2000,2004 Stefan Monnier
adamc@350 5 ;; Copyright (C) 1994-1997 Matthew J. Morley
adamc@350 6 ;; Copyright (C) 1989 Lars Bo Nielsen
adamc@350 7 ;;
adamc@350 8 ;; Modified for urweb-mode:
adamc@350 9 ;; Copyright (C) 2008 Adam Chlipala <adamc@hcoop.net>
adamc@350 10
adamc@350 11 ;; Author: Lars Bo Nielsen
adamc@350 12 ;; Olin Shivers
adamc@350 13 ;; Fritz Knabe (?)
adamc@350 14 ;; Steven Gilmore (?)
adamc@350 15 ;; Matthew Morley <mjm@scs.leeds.ac.uk> (aka <matthew@verisity.com>)
adamc@350 16 ;; Matthias Blume <blume@cs.princeton.edu> (aka <blume@kurims.kyoto-u.ac.jp>)
adamc@350 17 ;; (Stefan Monnier) monnier@cs.yale.edu
adamc@350 18 ;; Adam Chlipala
adamc@350 19
adamc@350 20 ;; This file is not part of GNU Emacs, but it is distributed under the
adamc@350 21 ;; same conditions.
adamc@350 22
adamc@350 23 ;; This program is free software; you can redistribute it and/or
adamc@350 24 ;; modify it under the terms of the GNU General Public License as
adamc@350 25 ;; published by the Free Software Foundation; either version 2, or (at
adamc@350 26 ;; your option) any later version.
adamc@350 27
adamc@350 28 ;; This program is distributed in the hope that it will be useful, but
adamc@350 29 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
adamc@350 30 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
adamc@350 31 ;; General Public License for more details.
adamc@350 32
adamc@350 33 ;; You should have received a copy of the GNU General Public License
adamc@350 34 ;; along with GNU Emacs; see the file COPYING. If not, write to the
adamc@350 35 ;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
adamc@350 36
adamc@350 37 ;;; Commentary:
adamc@350 38
adamc@350 39 ;;; HISTORY
adamc@350 40
adamc@350 41 ;; Still under construction: History obscure, needs a biographer as
adamc@350 42 ;; well as a M-x doctor. Change Log on request.
adamc@350 43
adamc@358 44 ;; Hacked by Olin Shivers for comint from Lars Bo Nielsen's sml.el.
adamc@350 45
adamc@350 46 ;; Hacked by Matthew Morley to incorporate Fritz Knabe's hilite and
adamc@350 47 ;; font-lock patterns, some of Steven Gilmore's (reduced) easy-menus,
adamc@350 48 ;; and numerous bugs and bug-fixes.
adamc@350 49
adamc@350 50 ;;; DESCRIPTION
adamc@350 51
adamc@350 52 ;; See accompanying info file: urweb-mode.info
adamc@350 53
adamc@350 54 ;;; FOR YOUR .EMACS FILE
adamc@350 55
adamc@350 56 ;; If urweb-mode.el lives in some non-standard directory, you must tell
adamc@350 57 ;; emacs where to get it. This may or may not be necessary:
adamc@350 58
adamc@350 59 ;; (add-to-list 'load-path "~jones/lib/emacs/")
adamc@350 60
adamc@350 61 ;; Then to access the commands autoload urweb-mode with that command:
adamc@350 62
adamc@350 63 ;; (load "urweb-mode-startup")
adamc@350 64
adamc@350 65 ;; urweb-mode-hook is run whenever a new urweb-mode buffer is created.
adamc@350 66
adamc@350 67 ;;; Code:
adamc@350 68
adamc@350 69 (eval-when-compile (require 'cl))
adamc@350 70 (require 'urweb-util)
adamc@350 71 (require 'urweb-move)
adamc@350 72 (require 'urweb-defs)
adamc@350 73 (condition-case nil (require 'skeleton) (error nil))
adamc@350 74
adamc@350 75 ;;; VARIABLES CONTROLLING INDENTATION
adamc@350 76
adamc@350 77 (defcustom urweb-indent-level 4
adamc@350 78 "*Indentation of blocks in Ur/Web (see also `urweb-structure-indent')."
adamc@350 79 :group 'urweb
adamc@350 80 :type '(integer))
adamc@350 81
adamc@350 82 (defcustom urweb-indent-args urweb-indent-level
adamc@350 83 "*Indentation of args placed on a separate line."
adamc@350 84 :group 'urweb
adamc@350 85 :type '(integer))
adamc@350 86
adamc@350 87 (defcustom urweb-electric-semi-mode nil
adamc@350 88 "*If non-nil, `\;' will self insert, reindent the line, and do a newline.
adamc@350 89 If nil, just insert a `\;'. (To insert while t, do: \\[quoted-insert] \;)."
adamc@350 90 :group 'urweb
adamc@350 91 :type 'boolean)
adamc@350 92
adamc@350 93 (defcustom urweb-rightalign-and t
adamc@350 94 "If non-nil, right-align `and' with its leader.
adamc@350 95 If nil: If t:
adamc@350 96 datatype a = A datatype a = A
adamc@350 97 and b = B and b = B"
adamc@350 98 :group 'urweb
adamc@350 99 :type 'boolean)
adamc@350 100
adamc@350 101 ;;; OTHER GENERIC MODE VARIABLES
adamc@350 102
adamc@350 103 (defvar urweb-mode-info "urweb-mode"
adamc@350 104 "*Where to find Info file for `urweb-mode'.
adamc@350 105 The default assumes the info file \"urweb-mode.info\" is on Emacs' info
adamc@350 106 directory path. If it is not, either put the file on the standard path
adamc@350 107 or set the variable `urweb-mode-info' to the exact location of this file
adamc@350 108
adamc@350 109 (setq urweb-mode-info \"/usr/me/lib/info/urweb-mode\")
adamc@350 110
adamc@350 111 in your .emacs file. You can always set it interactively with the
adamc@350 112 set-variable command.")
adamc@350 113
adamc@350 114 (defvar urweb-mode-hook nil
adamc@350 115 "*Run upon entering `urweb-mode'.
adamc@350 116 This is a good place to put your preferred key bindings.")
adamc@350 117
adamc@350 118 ;;; CODE FOR Ur/Web-MODE
adamc@350 119
adamc@350 120 (defun urweb-mode-info ()
adamc@350 121 "Command to access the TeXinfo documentation for `urweb-mode'.
adamc@350 122 See doc for the variable `urweb-mode-info'."
adamc@350 123 (interactive)
adamc@350 124 (require 'info)
adamc@350 125 (condition-case nil
adamc@350 126 (info urweb-mode-info)
adamc@350 127 (error (progn
adamc@350 128 (describe-variable 'urweb-mode-info)
adamc@350 129 (message "Can't find it... set this variable first!")))))
adamc@350 130
adamc@350 131
adamc@350 132 ;; font-lock setup
adamc@350 133
adamc@350 134 (defconst urweb-keywords-regexp
adamc@350 135 (urweb-syms-re "and" "case" "class" "con" "constraint" "constraints"
adamc@621 136 "datatype" "else" "end" "extern" "fn" "map"
adamc@350 137 "fun" "functor" "if" "include"
adamc@446 138 "of" "open" "let" "in"
adamc@459 139 "rec" "sequence" "sig" "signature" "cookie"
adamc@350 140 "struct" "structure" "table" "then" "type" "val" "where"
adamc@350 141 "with"
adamc@350 142
adamc@350 143 "Name" "Type" "Unit")
adamc@350 144 "A regexp that matches any non-SQL keywords of Ur/Web.")
adamc@350 145
adamc@350 146 (defconst urweb-sql-keywords-regexp
adamc@350 147 (urweb-syms-re "SELECT" "FROM" "AS" "WHERE" "SQL" "GROUP" "ORDER" "BY"
adamc@350 148 "HAVING" "LIMIT" "OFFSET" "ALL" "UNION" "INTERSECT" "EXCEPT"
adamc@350 149 "TRUE" "FALSE" "AND" "OR" "NOT" "COUNT" "AVG" "SUM" "MIN" "MAX"
adamc@708 150 "ASC" "DESC" "INSERT" "INTO" "VALUES" "UPDATE" "SET" "DELETE"
adamc@709 151 "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE"
adamc@709 152 "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL")
adamc@350 153 "A regexp that matches SQL keywords.")
adamc@350 154
adamc@351 155 (defconst urweb-lident-regexp "\\<[a-z_][A-Za-z0-9_']*\\>"
adamc@351 156 "A regexp that matches lowercase Ur/Web identifiers.")
adamc@351 157
adamc@351 158 (defconst urweb-cident-regexp "\\<[A-Z][A-Za-z0-9_']*\\>"
adamc@351 159 "A regexp that matches uppercase Ur/Web identifiers.")
adamc@351 160
adamc@350 161 ;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
adamc@350 162
adamc@350 163 ;; The font lock regular expressions.
adamc@350 164
adamc@363 165 (defun urweb-in-xml ()
adamc@360 166 (save-excursion
adamc@360 167 (let (
adamc@360 168 (depth 0)
adamc@360 169 (finished nil)
adamc@360 170 (answer nil)
adamc@360 171 )
adamc@360 172 (while (and (not finished) (re-search-backward "[<>{}]" nil t))
adamc@360 173 (cond
adamc@360 174 ((looking-at "{")
adamc@360 175 (if (> depth 0)
adamc@363 176 (decf depth)
adamc@360 177 (setq finished t)))
adamc@360 178 ((looking-at "}")
adamc@363 179 (incf depth))
adamc@374 180 ((save-excursion (backward-char 1) (or (looking-at "=>")
adamc@374 181 (looking-at "->")
adamc@374 182 (looking-at "<>")))
adamc@360 183 nil)
adamc@393 184 ((or (looking-at "< ") (looking-at "<="))
adamc@393 185 nil)
adamc@360 186 ((looking-at "<")
adamc@360 187 (setq finished t))
adamc@393 188 ((save-excursion (backward-char 1) (looking-at " >"))
adamc@393 189 nil)
adamc@360 190 ((looking-at ">")
adamc@374 191 (cond
adamc@374 192 ((> depth 0)
adamc@374 193 (if (not (re-search-backward "<" nil t))
adamc@374 194 (setq finished t)))
adamc@393 195 ((save-excursion (backward-char 1) (looking-at " "))
adamc@393 196 (setq finished t))
adamc@374 197 (t
adamc@360 198 (progn (backward-char 4)
adamc@360 199 (setq answer (not (or
adamc@360 200 (looking-at "/xml")
adamc@360 201 (looking-at "xml/"))))
adamc@374 202 (setq finished t)))))))
adamc@360 203 answer)))
adamc@360 204
adamc@360 205 (defun amAttribute (face)
adamc@360 206 (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<")))
adamc@360 207 nil
adamc@360 208 face))
adamc@358 209
adamc@350 210 (defconst urweb-font-lock-keywords
adamc@350 211 `(;;(urweb-font-comments-and-strings)
adamc@362 212 ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*\\(/?>\\)"
adamc@359 213 (1 font-lock-tag-face)
adamc@359 214 (3 font-lock-tag-face))
adamc@359 215 ("\\(</\\sw+>\\)"
adamc@359 216 (1 font-lock-tag-face))
adamc@359 217 ("\\([^<>{}]+\\)"
adamc@363 218 (1 (if (urweb-in-xml)
adamc@359 219 font-lock-string-face
adamc@359 220 nil)))
adamc@359 221
adamc@357 222 ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]"
adamc@350 223 (1 font-lock-keyword-face)
adamc@360 224 (2 (amAttribute font-lock-function-name-face)))
adamc@357 225 ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)"
adamc@350 226 (1 font-lock-keyword-face)
adamc@360 227 (3 (amAttribute font-lock-type-def-face)))
adamc@459 228 ("\\<\\(val\\|table\\|sequence\\|cookie\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
adamc@350 229 (1 font-lock-keyword-face)
adamc@360 230 (3 (amAttribute font-lock-variable-name-face)))
adamc@350 231 ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
adamc@350 232 (1 font-lock-keyword-face)
adamc@360 233 (2 (amAttribute font-lock-module-def-face)))
adamc@350 234 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
adamc@350 235 (1 font-lock-keyword-face)
adamc@360 236 (2 (amAttribute font-lock-interface-def-face)))
adamc@350 237
adamc@350 238 (,urweb-keywords-regexp . font-lock-keyword-face)
adamc@351 239 (,urweb-sql-keywords-regexp . font-lock-sql-face)
adamc@351 240 (,urweb-cident-regexp . font-lock-cvariable-face))
adamc@350 241 "Regexps matching standard Ur/Web keywords.")
adamc@350 242
adamc@350 243 (defface font-lock-type-def-face
adamc@350 244 '((t (:bold t)))
adamc@350 245 "Font Lock mode face used to highlight type definitions."
adamc@350 246 :group 'font-lock-highlighting-faces)
adamc@350 247 (defvar font-lock-type-def-face 'font-lock-type-def-face
adamc@350 248 "Face name to use for type definitions.")
adamc@350 249
adamc@350 250 (defface font-lock-module-def-face
adamc@350 251 '((t (:bold t)))
adamc@350 252 "Font Lock mode face used to highlight module definitions."
adamc@350 253 :group 'font-lock-highlighting-faces)
adamc@350 254 (defvar font-lock-module-def-face 'font-lock-module-def-face
adamc@350 255 "Face name to use for module definitions.")
adamc@350 256
adamc@350 257 (defface font-lock-interface-def-face
adamc@350 258 '((t (:bold t)))
adamc@350 259 "Font Lock mode face used to highlight interface definitions."
adamc@350 260 :group 'font-lock-highlighting-faces)
adamc@350 261 (defvar font-lock-interface-def-face 'font-lock-interface-def-face
adamc@350 262 "Face name to use for interface definitions.")
adamc@350 263
adamc@350 264 (defface font-lock-sql-face
adamc@350 265 '((t (:bold t)))
adamc@350 266 "Font Lock mode face used to highlight SQL keywords."
adamc@350 267 :group 'font-lock-highlighting-faces)
adamc@350 268 (defvar font-lock-sql-face 'font-lock-sql-face
adamc@350 269 "Face name to use for SQL keywords.")
adamc@350 270
adamc@351 271 (defface font-lock-cvariable-face
adamc@351 272 '((t (:foreground "dark blue")))
adamc@351 273 "Font Lock mode face used to highlight capitalized identifiers."
adamc@351 274 :group 'font-lock-highlighting-faces)
adamc@351 275 (defvar font-lock-cvariable-face 'font-lock-cvariable-face
adamc@351 276 "Face name to use for capitalized identifiers.")
adamc@351 277
adamc@357 278 (defface font-lock-tag-face
adamc@357 279 '((t (:bold t)))
adamc@357 280 "Font Lock mode face used to highlight XML tags."
adamc@357 281 :group 'font-lock-highlighting-faces)
adamc@357 282 (defvar font-lock-tag-face 'font-lock-tag-face
adamc@357 283 "Face name to use for XML tags.")
adamc@357 284
adamc@358 285 (defface font-lock-attr-face
adamc@358 286 '((t (:bold t)))
adamc@358 287 "Font Lock mode face used to highlight XML attributes."
adamc@358 288 :group 'font-lock-highlighting-faces)
adamc@358 289 (defvar font-lock-attr-face 'font-lock-attr-face
adamc@358 290 "Face name to use for XML attributes.")
adamc@358 291
adamc@350 292 ;;
adamc@350 293 ;; Code to handle nested comments and unusual string escape sequences
adamc@350 294 ;;
adamc@350 295
adamc@350 296 (defsyntax urweb-syntax-prop-table
adamc@350 297 '((?\\ . ".") (?* . "."))
adamc@350 298 "Syntax table for text-properties")
adamc@350 299
adamc@350 300 ;; For Emacsen that have no built-in support for nested comments
adamc@350 301 (defun urweb-get-depth-st ()
adamc@350 302 (save-excursion
adamc@350 303 (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
adamc@350 304 (_ (backward-char))
adamc@350 305 (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
adamc@350 306 (pt (point)))
adamc@350 307 (when disp
adamc@350 308 (let* ((depth
adamc@350 309 (save-match-data
adamc@350 310 (if (re-search-backward "\\*)\\|(\\*" nil t)
adamc@350 311 (+ (or (get-char-property (point) 'comment-depth) 0)
adamc@350 312 (case (char-after) (?\( 1) (?* 0))
adamc@350 313 disp)
adamc@350 314 0)))
adamc@350 315 (depth (if (> depth 0) depth)))
adamc@350 316 (put-text-property pt (1+ pt) 'comment-depth depth)
adamc@350 317 (when depth urweb-syntax-prop-table))))))
adamc@350 318
adamc@350 319 (defconst urweb-font-lock-syntactic-keywords
adamc@350 320 `(("^\\s-*\\(\\\\\\)" (1 ',urweb-syntax-prop-table))
adamc@350 321 ,@(unless urweb-builtin-nested-comments-flag
adamc@350 322 '(("(?\\(\\*\\))?" (1 (urweb-get-depth-st)))))))
adamc@350 323
adamc@350 324 (defconst urweb-font-lock-defaults
adamc@350 325 '(urweb-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
adamc@350 326 (font-lock-syntactic-keywords . urweb-font-lock-syntactic-keywords)))
adamc@350 327
adamc@350 328 ;;;;
adamc@350 329 ;;;; Imenu support
adamc@350 330 ;;;;
adamc@350 331
adamc@350 332 (defvar urweb-imenu-regexp
adamc@350 333 (concat "^[ \t]*\\(let[ \t]+\\)?"
adamc@350 334 (regexp-opt (append urweb-module-head-syms
adamc@350 335 '("and" "fun" "datatype" "type")) t)
adamc@350 336 "\\>"))
adamc@350 337
adamc@350 338 (defun urweb-imenu-create-index ()
adamc@350 339 (let (alist)
adamc@350 340 (goto-char (point-max))
adamc@350 341 (while (re-search-backward urweb-imenu-regexp nil t)
adamc@350 342 (save-excursion
adamc@350 343 (let ((kind (match-string 2))
adamc@350 344 (column (progn (goto-char (match-beginning 2)) (current-column)))
adamc@350 345 (location
adamc@350 346 (progn (goto-char (match-end 0))
adamc@350 347 (urweb-forward-spaces)
adamc@350 348 (when (looking-at urweb-tyvarseq-re)
adamc@350 349 (goto-char (match-end 0)))
adamc@350 350 (point)))
adamc@350 351 (name (urweb-forward-sym)))
adamc@350 352 ;; Eliminate trivial renamings.
adamc@350 353 (when (or (not (member kind '("structure" "signature")))
adamc@350 354 (progn (search-forward "=")
adamc@350 355 (urweb-forward-spaces)
adamc@350 356 (looking-at "sig\\|struct")))
adamc@350 357 (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
adamc@350 358 alist)))))
adamc@350 359 alist))
adamc@350 360
adamc@350 361 ;;; MORE CODE FOR URWEB-MODE
adamc@350 362
adamc@350 363 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
adamc@350 364 ;;;###autoload
adamc@362 365 (add-to-list 'auto-mode-alist '("\\.urs?\\'" . urweb-mode))
adamc@350 366
adamc@350 367 ;;;###autoload
adamc@350 368 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
adamc@350 369 "\\<urweb-mode-map>Major mode for editing Ur/Web code.
adamc@350 370 This mode runs `urweb-mode-hook' just before exiting.
adamc@350 371 \\{urweb-mode-map}"
adamc@350 372 (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults)
adamc@358 373 (set (make-local-variable 'font-lock-multiline) 'undecided)
adamc@350 374 (set (make-local-variable 'outline-regexp) urweb-outline-regexp)
adamc@350 375 (set (make-local-variable 'imenu-create-index-function)
adamc@350 376 'urweb-imenu-create-index)
adamc@350 377 (set (make-local-variable 'add-log-current-defun-function)
adamc@350 378 'urweb-current-fun-name)
adamc@350 379 ;; Treat paragraph-separators in comments as paragraph-separators.
adamc@350 380 (set (make-local-variable 'paragraph-separate)
adamc@350 381 (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
adamc@350 382 (set (make-local-variable 'require-final-newline) t)
adamc@350 383 ;; forward-sexp-function is an experimental variable in my hacked Emacs.
adamc@350 384 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
adamc@350 385 ;; For XEmacs
adamc@350 386 (easy-menu-add urweb-mode-menu)
adamc@358 387
adamc@350 388 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS.
adamc@350 389 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
adamc@358 390
adamc@360 391 (urweb-mode-variables))
adamc@350 392
adamc@350 393 (defun urweb-mode-variables ()
adamc@350 394 (set-syntax-table urweb-mode-syntax-table)
adamc@350 395 (setq local-abbrev-table urweb-mode-abbrev-table)
adamc@350 396 ;; A paragraph is separated by blank lines or ^L only.
adamc@350 397
adamc@350 398 (set (make-local-variable 'indent-line-function) 'urweb-indent-line)
adamc@350 399 (set (make-local-variable 'comment-start) "(* ")
adamc@350 400 (set (make-local-variable 'comment-end) " *)")
adamc@350 401 (set (make-local-variable 'comment-nested) t)
adamc@350 402 ;;(set (make-local-variable 'block-comment-start) "* ")
adamc@350 403 ;;(set (make-local-variable 'block-comment-end) "")
adamc@350 404 ;; (set (make-local-variable 'comment-column) 40)
adamc@350 405 (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))
adamc@350 406
adamc@350 407 (defun urweb-funname-of-and ()
adamc@350 408 "Name of the function this `and' defines, or nil if not a function.
adamc@350 409 Point has to be right after the `and' symbol and is not preserved."
adamc@350 410 (urweb-forward-spaces)
adamc@350 411 (if (looking-at urweb-tyvarseq-re) (goto-char (match-end 0)))
adamc@350 412 (let ((sym (urweb-forward-sym)))
adamc@350 413 (urweb-forward-spaces)
adamc@350 414 (unless (or (member sym '(nil "d="))
adamc@350 415 (member (urweb-forward-sym) '("d=")))
adamc@350 416 sym)))
adamc@350 417
adamc@350 418 ;;; INDENTATION !!!
adamc@350 419
adamc@350 420 (defun urweb-mark-function ()
adamc@350 421 "Synonym for `mark-paragraph' -- sorry.
adamc@350 422 If anyone has a good algorithm for this..."
adamc@350 423 (interactive)
adamc@350 424 (mark-paragraph))
adamc@350 425
adamc@350 426 (defun urweb-indent-line ()
adamc@350 427 "Indent current line of Ur/Web code."
adamc@350 428 (interactive)
adamc@350 429 (let ((savep (> (current-column) (current-indentation)))
adamc@350 430 (indent (max (or (ignore-errors (urweb-calculate-indentation)) 0) 0)))
adamc@350 431 (if savep
adamc@350 432 (save-excursion (indent-line-to indent))
adamc@350 433 (indent-line-to indent))))
adamc@350 434
adamc@350 435 (defun urweb-back-to-outer-indent ()
adamc@350 436 "Unindents to the next outer level of indentation."
adamc@350 437 (interactive)
adamc@350 438 (save-excursion
adamc@350 439 (beginning-of-line)
adamc@350 440 (skip-chars-forward "\t ")
adamc@350 441 (let ((start-column (current-column))
adamc@350 442 (indent (current-column)))
adamc@350 443 (if (> start-column 0)
adamc@350 444 (progn
adamc@350 445 (save-excursion
adamc@350 446 (while (>= indent start-column)
adamc@350 447 (if (re-search-backward "^[^\n]" nil t)
adamc@350 448 (setq indent (current-indentation))
adamc@350 449 (setq indent 0))))
adamc@350 450 (backward-delete-char-untabify (- start-column indent)))))))
adamc@350 451
adamc@350 452 (defun urweb-find-comment-indent ()
adamc@350 453 (save-excursion
adamc@350 454 (let ((depth 1))
adamc@350 455 (while (> depth 0)
adamc@350 456 (if (re-search-backward "(\\*\\|\\*)" nil t)
adamc@350 457 (cond
adamc@350 458 ;; FIXME: That's just a stop-gap.
adamc@350 459 ((eq (get-text-property (point) 'face) 'font-lock-string-face))
adamc@350 460 ((looking-at "*)") (incf depth))
adamc@350 461 ((looking-at comment-start-skip) (decf depth)))
adamc@350 462 (setq depth -1)))
adamc@350 463 (if (= depth 0)
adamc@350 464 (1+ (current-column))
adamc@350 465 nil))))
adamc@350 466
adamc@369 467 (defun urweb-empty-line ()
adamc@365 468 (save-excursion
adamc@369 469 (beginning-of-line)
adamc@365 470 (let ((start-pos (point)))
adamc@369 471 (end-of-line)
adamc@369 472 (not (re-search-backward "[^\n \t]" start-pos t)))))
adamc@365 473
adamc@369 474 (defun urweb-seek-back ()
adamc@369 475 (while (urweb-empty-line) (previous-line 1)))
adamc@363 476
adamc@369 477 (defun urweb-skip-matching-braces ()
adamc@367 478 "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code"
adamc@367 479 (beginning-of-line)
adamc@367 480 (let ((start-pos (point))
adamc@367 481 (depth 0))
adamc@367 482 (end-of-line)
adamc@367 483 (while (re-search-backward "[{}]" start-pos t)
adamc@367 484 (cond
adamc@367 485 ((looking-at "}")
adamc@367 486 (incf depth))
adamc@367 487 ((looking-at "{")
adamc@367 488 (decf depth))))
adamc@367 489 (while (and (> depth 0) (re-search-backward "[{}]" nil t)
adamc@367 490 (cond
adamc@367 491 ((looking-at "}")
adamc@367 492 (incf depth))
adamc@367 493 ((looking-at "{")
adamc@367 494 (decf depth)))))))
adamc@367 495
adamc@369 496 (defun urweb-new-tags ()
adamc@369 497 "Decide if the previous line of XML introduced unclosed tags"
adamc@369 498 (save-excursion
adamc@369 499 (let ((start-pos (point))
adamc@369 500 (depth 0)
adamc@369 501 (done nil))
adamc@369 502 (previous-line 1)
adamc@369 503 (urweb-seek-back)
adamc@369 504 (urweb-skip-matching-braces)
adamc@369 505 (urweb-seek-back)
adamc@369 506 (beginning-of-line)
adamc@369 507 (while (and (not done) (search-forward "<" start-pos t))
adamc@396 508 (cond
adamc@396 509 ((or (looking-at " ") (looking-at "="))
adamc@396 510 nil)
adamc@396 511 ((looking-at "/")
adamc@396 512 (if (re-search-forward "[^\\sw]>" start-pos t)
adamc@369 513 (when (> depth 0) (decf depth))
adamc@396 514 (setq done t)))
adamc@396 515 (t
adamc@396 516 (if (re-search-forward "[^\\sw]>" start-pos t)
adamc@369 517 (if (not (save-excursion (backward-char 2) (looking-at "/")))
adamc@369 518 (incf depth))
adamc@396 519 (setq done t)))))
adamc@369 520 (and (not done) (> depth 0)))))
adamc@369 521
adamc@363 522 (defun urweb-tag-matching-indent ()
adamc@363 523 "Seek back to a matching opener tag and get its line's indent"
adamc@363 524 (save-excursion
adamc@369 525 (end-of-line)
adamc@369 526 (search-backward "</" nil t)
adamc@368 527 (urweb-tag-matcher)
adamc@369 528 (beginning-of-line)
adamc@369 529 (current-indentation)))
adamc@363 530
adamc@373 531 (defconst urweb-sql-main-starters
adamc@374 532 '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE"))
adamc@373 533
adamc@372 534 (defconst urweb-sql-starters
adamc@373 535 (append urweb-sql-main-starters
adamc@373 536 '("^\\s-+FROM" "WHERE" "GROUP" "ORDER" "HAVING" "LIMIT" "OFFSET"
adamc@373 537 "VALUES" "SET")))
adamc@372 538
adamc@373 539 (defconst urweb-sql-main-starters-re
adamc@373 540 (urweb-syms-re urweb-sql-main-starters))
adamc@372 541 (defconst urweb-sql-starters-re
adamc@372 542 (urweb-syms-re urweb-sql-starters))
adamc@372 543
adamc@374 544 (defconst urweb-sql-main-starters-paren-re
adamc@374 545 (concat "(" urweb-sql-main-starters-re))
adamc@374 546
adamc@374 547 (defun urweb-in-sql ()
adamc@374 548 "Check if the point is in a block of SQL syntax."
adamc@374 549 (save-excursion
adamc@375 550 (let ((start-pos (point))
adamc@375 551 (depth 0)
adamc@375 552 done
adamc@375 553 (good t))
adamc@375 554 (when (re-search-backward urweb-sql-main-starters-paren-re nil t)
adamc@375 555 (forward-char)
adamc@375 556 (while (and (not done) (re-search-forward "[()]" start-pos t))
adamc@375 557 (save-excursion
adamc@375 558 (backward-char)
adamc@375 559 (cond
adamc@375 560 ((looking-at ")")
adamc@375 561 (cond
adamc@375 562 ((= depth 0) (setq done t) (setq good nil))
adamc@375 563 (t (decf depth))))
adamc@375 564 ((looking-at "(")
adamc@375 565 (incf depth)))))
adamc@375 566 good))))
adamc@374 567
adamc@374 568 (defun urweb-sql-depth ()
adamc@374 569 "Check if the point is in a block of SQL syntax.
adamc@374 570 Returns the paren nesting depth if so, and nil otherwise."
adamc@374 571 (save-excursion
adamc@374 572 (let ((depth 0)
adamc@374 573 done)
adamc@374 574 (while (and (not done)
adamc@374 575 (re-search-backward "[()]" nil t))
adamc@374 576 (cond
adamc@374 577 ((looking-at ")")
adamc@374 578 (decf depth))
adamc@374 579 ((looking-at "(")
adamc@374 580 (if (looking-at urweb-sql-main-starters-paren-re)
adamc@374 581 (setq done t)
adamc@374 582 (incf depth)))))
adamc@374 583 (max 0 depth))))
adamc@374 584
adamc@350 585 (defun urweb-calculate-indentation ()
adamc@350 586 (save-excursion
adamc@350 587 (beginning-of-line) (skip-chars-forward "\t ")
adamc@350 588 (urweb-with-ist
adamc@350 589 ;; Indentation for comments alone on a line, matches the
adamc@350 590 ;; proper indentation of the next line.
adamc@350 591 (when (looking-at "(\\*") (urweb-forward-spaces))
adamc@350 592 (let (data
adamc@350 593 (sym (save-excursion (urweb-forward-sym))))
adamc@350 594 (or
adamc@350 595 ;; Allow the user to override the indentation.
adamc@350 596 (when (looking-at (concat ".*" (regexp-quote comment-start)
adamc@350 597 "[ \t]*fixindent[ \t]*"
adamc@350 598 (regexp-quote comment-end)))
adamc@350 599 (current-indentation))
adamc@350 600
adamc@350 601 ;; Continued comment.
adamc@350 602 (and (looking-at "\\*") (urweb-find-comment-indent))
adamc@350 603
adamc@363 604 (and (urweb-in-xml)
adamc@363 605 (let ((prev-indent (save-excursion
adamc@363 606 (previous-line 1)
adamc@369 607 (urweb-seek-back)
adamc@369 608 (urweb-skip-matching-braces)
adamc@369 609 (urweb-seek-back)
adamc@363 610 (current-indentation))))
adamc@363 611 (cond
adamc@363 612 ((looking-at "</")
adamc@363 613 (urweb-tag-matching-indent))
adamc@363 614 ((urweb-new-tags)
adamc@363 615 (+ prev-indent 2))
adamc@363 616 (t
adamc@363 617 prev-indent))))
adamc@363 618
adamc@350 619 ;; Continued string ? (Added 890113 lbn)
adamc@350 620 (and (looking-at "\\\\")
adamc@350 621 (save-excursion
adamc@350 622 (if (save-excursion (previous-line 1)
adamc@350 623 (beginning-of-line)
adamc@350 624 (looking-at "[\t ]*\\\\"))
adamc@350 625 (progn (previous-line 1) (current-indentation))
adamc@350 626 (if (re-search-backward "[^\\\\]\"" nil t)
adamc@350 627 (1+ (current-column))
adamc@350 628 0))))
adamc@350 629
adamc@350 630 ;; Closing parens. Could be handled below with `urweb-indent-relative'?
adamc@350 631 (and (looking-at "\\s)")
adamc@350 632 (save-excursion
adamc@350 633 (skip-syntax-forward ")")
adamc@350 634 (backward-sexp 1)
adamc@350 635 (if (urweb-dangling-sym)
adamc@350 636 (urweb-indent-default 'noindent)
adamc@350 637 (current-column))))
adamc@350 638
adamc@374 639 (and (or (looking-at "FROM") (looking-at urweb-sql-starters-re))
adamc@386 640
adamc@372 641 (save-excursion
adamc@372 642 (and (re-search-backward urweb-sql-starters-re nil t)
adamc@373 643 (if (looking-at urweb-sql-main-starters-re)
adamc@373 644 (current-column)
adamc@373 645 (current-indentation)))))
adamc@372 646
adamc@374 647 (and (urweb-in-sql)
adamc@374 648 (setq data (urweb-sql-depth))
adamc@374 649 (save-excursion
adamc@374 650 (re-search-backward urweb-sql-starters-re nil t)
adamc@374 651 (+ (current-column) 2 (* 2 data))))
adamc@374 652
adamc@350 653 (and (setq data (assoc sym urweb-close-paren))
adamc@350 654 (urweb-indent-relative sym data))
adamc@350 655
adamc@350 656 (and (member sym urweb-starters-syms)
adamc@350 657 (urweb-indent-starter sym))
adamc@350 658
adamc@350 659 (and (string= sym "|") (urweb-indent-pipe))
adamc@350 660
adamc@350 661 (urweb-indent-arg)
adamc@350 662 (urweb-indent-default))))))
adamc@350 663
adamc@350 664 (defsubst urweb-bolp ()
adamc@350 665 (save-excursion (skip-chars-backward " \t|") (bolp)))
adamc@350 666
adamc@350 667 (defun urweb-indent-starter (orig-sym)
adamc@350 668 "Return the indentation to use for a symbol in `urweb-starters-syms'.
adamc@350 669 Point should be just before the symbol ORIG-SYM and is not preserved."
adamc@350 670 (let ((sym (unless (save-excursion (urweb-backward-arg))
adamc@350 671 (urweb-backward-spaces)
adamc@350 672 (urweb-backward-sym))))
adamc@350 673 (if (member sym '(";" "d=")) (setq sym nil))
adamc@350 674 (if sym (urweb-get-sym-indent sym)
adamc@350 675 ;; FIXME: this can take a *long* time !!
adamc@350 676 (setq sym (urweb-find-matching-starter urweb-starters-syms))
adamc@350 677 ;; Don't align with `and' because it might be specially indented.
adamc@350 678 (if (and (or (equal orig-sym "and") (not (equal sym "and")))
adamc@350 679 (urweb-bolp))
adamc@350 680 (+ (current-column)
adamc@350 681 (if (and urweb-rightalign-and (equal orig-sym "and"))
adamc@350 682 (- (length sym) 3) 0))
adamc@350 683 (urweb-indent-starter orig-sym)))))
adamc@350 684
adamc@350 685 (defun urweb-indent-relative (sym data)
adamc@350 686 (save-excursion
adamc@350 687 (urweb-forward-sym) (urweb-backward-sexp nil)
adamc@350 688 (unless (second data) (urweb-backward-spaces) (urweb-backward-sym))
adamc@350 689 (+ (or (cdr (assoc sym urweb-symbol-indent)) 0)
adamc@350 690 (urweb-delegated-indent))))
adamc@350 691
adamc@350 692 (defun urweb-indent-pipe ()
adamc@350 693 (let ((sym (urweb-find-matching-starter urweb-pipeheads
adamc@350 694 (urweb-op-prec "|" 'back))))
adamc@350 695 (when sym
adamc@350 696 (if (string= sym "|")
adamc@350 697 (if (urweb-bolp) (current-column) (urweb-indent-pipe))
adamc@350 698 (let ((pipe-indent (or (cdr (assoc "|" urweb-symbol-indent)) -2)))
adamc@350 699 (when (or (member sym '("datatype"))
adamc@350 700 (and (equal sym "and")
adamc@350 701 (save-excursion
adamc@350 702 (forward-word 1)
adamc@350 703 (not (urweb-funname-of-and)))))
adamc@350 704 (re-search-forward "="))
adamc@350 705 (urweb-forward-sym)
adamc@350 706 (urweb-forward-spaces)
adamc@350 707 (+ pipe-indent (current-column)))))))
adamc@350 708
adamc@350 709 (defun urweb-find-forward (re)
adamc@350 710 (urweb-forward-spaces)
adamc@350 711 (while (and (not (looking-at re))
adamc@350 712 (progn
adamc@350 713 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
adamc@350 714 (urweb-forward-spaces)
adamc@350 715 (not (looking-at re))))))
adamc@350 716
adamc@350 717 (defun urweb-indent-arg ()
adamc@350 718 (and (save-excursion (ignore-errors (urweb-forward-arg)))
adamc@350 719 ;;(not (looking-at urweb-not-arg-re))
adamc@350 720 ;; looks like a function or an argument
adamc@350 721 (urweb-move-if (urweb-backward-arg))
adamc@350 722 ;; an argument
adamc@350 723 (if (save-excursion (not (urweb-backward-arg)))
adamc@350 724 ;; a first argument
adamc@350 725 (+ (current-column) urweb-indent-args)
adamc@350 726 ;; not a first arg
adamc@350 727 (while (and (/= (current-column) (current-indentation))
adamc@350 728 (urweb-move-if (urweb-backward-arg))))
adamc@350 729 (unless (save-excursion (urweb-backward-arg))
adamc@350 730 ;; all earlier args are on the same line
adamc@350 731 (urweb-forward-arg) (urweb-forward-spaces))
adamc@350 732 (current-column))))
adamc@350 733
adamc@350 734 (defun urweb-get-indent (data sym)
adamc@350 735 (let (d)
adamc@350 736 (cond
adamc@350 737 ((not (listp data)) data)
adamc@350 738 ((setq d (member sym data)) (cadr d))
adamc@350 739 ((and (consp data) (not (stringp (car data)))) (car data))
adamc@350 740 (t urweb-indent-level))))
adamc@350 741
adamc@350 742 (defun urweb-dangling-sym ()
adamc@350 743 "Non-nil if the symbol after point is dangling.
adamc@350 744 The symbol can be an Ur/Web symbol or an open-paren. \"Dangling\" means that
adamc@350 745 it is not on its own line but is the last element on that line."
adamc@350 746 (save-excursion
adamc@350 747 (and (not (urweb-bolp))
adamc@350 748 (< (urweb-point-after (end-of-line))
adamc@350 749 (urweb-point-after (or (urweb-forward-sym) (skip-syntax-forward "("))
adamc@350 750 (urweb-forward-spaces))))))
adamc@350 751
adamc@350 752 (defun urweb-delegated-indent ()
adamc@350 753 (if (urweb-dangling-sym)
adamc@350 754 (urweb-indent-default 'noindent)
adamc@350 755 (urweb-move-if (backward-word 1)
adamc@350 756 (looking-at urweb-agglomerate-re))
adamc@350 757 (current-column)))
adamc@350 758
adamc@350 759 (defun urweb-get-sym-indent (sym &optional style)
adamc@350 760 "Find the indentation for the SYM we're `looking-at'.
adamc@350 761 If indentation is delegated, point will move to the start of the parent.
adamc@350 762 Optional argument STYLE is currently ignored."
adamc@371 763 ;;(assert (equal sym (save-excursion (urweb-forward-sym))))
adamc@350 764 (save-excursion
adamc@350 765 (let ((delegate (and (not (equal sym "end")) (assoc sym urweb-close-paren)))
adamc@350 766 (head-sym sym))
adamc@350 767 (when (and delegate (not (eval (third delegate))))
adamc@350 768 ;;(urweb-find-match-backward sym delegate)
adamc@350 769 (urweb-forward-sym) (urweb-backward-sexp nil)
adamc@350 770 (setq head-sym
adamc@350 771 (if (second delegate)
adamc@350 772 (save-excursion (urweb-forward-sym))
adamc@350 773 (urweb-backward-spaces) (urweb-backward-sym))))
adamc@350 774 (let ((idata (assoc head-sym urweb-indent-rule)))
adamc@350 775 (when idata
adamc@350 776 ;;(if (or style (not delegate))
adamc@350 777 ;; normal indentation
adamc@350 778 (let ((indent (urweb-get-indent (cdr idata) sym)))
adamc@350 779 (when indent (+ (urweb-delegated-indent) indent)))
adamc@350 780 ;; delgate indentation to the parent
adamc@350 781 ;;(urweb-forward-sym) (urweb-backward-sexp nil)
adamc@350 782 ;;(let* ((parent-sym (save-excursion (urweb-forward-sym)))
adamc@350 783 ;; (parent-indent (cdr (assoc parent-sym urweb-indent-starters))))
adamc@350 784 ;; check the special rules
adamc@350 785 ;;(+ (urweb-delegated-indent)
adamc@350 786 ;; (or (urweb-get-indent (cdr indent-data) 1 'strict)
adamc@350 787 ;; (urweb-get-indent (cdr parent-indent) 1 'strict)
adamc@350 788 ;; (urweb-get-indent (cdr indent-data) 0)
adamc@350 789 ;; (urweb-get-indent (cdr parent-indent) 0))))))))
adamc@350 790 )))))
adamc@350 791
adamc@350 792 (defun urweb-indent-default (&optional noindent)
adamc@386 793 (condition-case nil
adamc@386 794 (progn
adamc@386 795 (let* ((sym-after (save-excursion (urweb-forward-sym)))
adamc@386 796 (_ (urweb-backward-spaces))
adamc@386 797 (sym-before (urweb-backward-sym))
adamc@386 798 (sym-indent (and sym-before (urweb-get-sym-indent sym-before)))
adamc@386 799 (indent-after (or (cdr (assoc sym-after urweb-symbol-indent)) 0)))
adamc@386 800 (when (equal sym-before "end")
adamc@386 801 ;; I don't understand what's really happening here, but when
adamc@386 802 ;; it's `end' clearly, we need to do something special.
adamc@386 803 (forward-word 1)
adamc@386 804 (setq sym-before nil sym-indent nil))
adamc@386 805 (cond
adamc@386 806 (sym-indent
adamc@386 807 ;; the previous sym is an indentation introducer: follow the rule
adamc@386 808 (if noindent
adamc@386 809 ;;(current-column)
adamc@386 810 sym-indent
adamc@386 811 (+ sym-indent indent-after)))
adamc@386 812 ;; If we're just after a hanging open paren.
adamc@386 813 ((and (eq (char-syntax (preceding-char)) ?\()
adamc@386 814 (save-excursion (backward-char) (urweb-dangling-sym)))
adamc@386 815 (backward-char)
adamc@386 816 (urweb-indent-default))
adamc@386 817 (t
adamc@386 818 ;; default-default
adamc@386 819 (let* ((prec-after (urweb-op-prec sym-after 'back))
adamc@386 820 (prec (or (urweb-op-prec sym-before 'back) prec-after 100)))
adamc@386 821 ;; go back until you hit a symbol that has a lower prec than the
adamc@386 822 ;; "current one", or until you backed over a sym that has the same prec
adamc@386 823 ;; but is at the beginning of a line.
adamc@386 824 (while (and (not (urweb-bolp))
adamc@386 825 (while (urweb-move-if (urweb-backward-sexp (1- prec))))
adamc@386 826 (not (urweb-bolp)))
adamc@386 827 (while (urweb-move-if (urweb-backward-sexp prec))))
adamc@386 828 (if noindent
adamc@386 829 ;; the `noindent' case does back over an introductory symbol
adamc@386 830 ;; such as `fun', ...
adamc@386 831 (progn
adamc@386 832 (urweb-move-if
adamc@386 833 (urweb-backward-spaces)
adamc@386 834 (member (urweb-backward-sym) urweb-starters-syms))
adamc@386 835 (current-column))
adamc@386 836 ;; Use `indent-after' for cases such as when , or ; should be
adamc@386 837 ;; outdented so that their following terms are aligned.
adamc@386 838 (+ (if (progn
adamc@386 839 (if (equal sym-after ";")
adamc@386 840 (urweb-move-if
adamc@386 841 (urweb-backward-spaces)
adamc@386 842 (member (urweb-backward-sym) urweb-starters-syms)))
adamc@386 843 (and sym-after (not (looking-at sym-after))))
adamc@386 844 indent-after 0)
adamc@386 845 (current-column))))))))
adamc@386 846 (error 0)))
adamc@350 847
adamc@350 848
adamc@350 849 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
adamc@350 850 (defun urweb-current-indentation ()
adamc@350 851 (save-excursion
adamc@350 852 (beginning-of-line)
adamc@350 853 (skip-chars-forward " \t|")
adamc@350 854 (current-column)))
adamc@350 855
adamc@350 856
adamc@350 857 (defun urweb-find-matching-starter (syms &optional prec)
adamc@350 858 (let (sym)
adamc@350 859 (ignore-errors
adamc@350 860 (while
adamc@350 861 (progn (urweb-backward-sexp prec)
adamc@350 862 (setq sym (save-excursion (urweb-forward-sym)))
adamc@350 863 (not (or (member sym syms) (bobp)))))
adamc@350 864 (if (member sym syms) sym))))
adamc@350 865
adamc@350 866 (defun urweb-skip-siblings ()
adamc@350 867 (while (and (not (bobp)) (urweb-backward-arg))
adamc@350 868 (urweb-find-matching-starter urweb-starters-syms)))
adamc@350 869
adamc@350 870 (defun urweb-beginning-of-defun ()
adamc@350 871 (let ((sym (urweb-find-matching-starter urweb-starters-syms)))
adamc@350 872 (if (member sym '("fun" "and" "functor" "signature" "structure"
adamc@350 873 "datatype"))
adamc@350 874 (save-excursion (urweb-forward-sym) (urweb-forward-spaces)
adamc@350 875 (urweb-forward-sym))
adamc@350 876 ;; We're inside a "non function declaration": let's skip all other
adamc@350 877 ;; declarations that we find at the same level and try again.
adamc@350 878 (urweb-skip-siblings)
adamc@350 879 ;; Obviously, let's not try again if we're at bobp.
adamc@350 880 (unless (bobp) (urweb-beginning-of-defun)))))
adamc@350 881
adamc@350 882 (defcustom urweb-max-name-components 3
adamc@350 883 "Maximum number of components to use for the current function name."
adamc@350 884 :group 'urweb
adamc@350 885 :type 'integer)
adamc@350 886
adamc@350 887 (defun urweb-current-fun-name ()
adamc@350 888 (save-excursion
adamc@350 889 (let ((count urweb-max-name-components)
adamc@350 890 fullname name)
adamc@350 891 (end-of-line)
adamc@350 892 (while (and (> count 0)
adamc@350 893 (setq name (urweb-beginning-of-defun)))
adamc@350 894 (decf count)
adamc@350 895 (setq fullname (if fullname (concat name "." fullname) name))
adamc@350 896 ;; Skip all other declarations that we find at the same level.
adamc@350 897 (urweb-skip-siblings))
adamc@350 898 fullname)))
adamc@350 899
adamc@358 900
adamc@358 901
adamc@350 902 (provide 'urweb-mode)
adamc@350 903
adamc@350 904 ;;; urweb-mode.el ends here