Mercurial > urweb

annotate src/elisp/urweb-mode.el @ 1232:efbefd6e3f6c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
When applying multiple policies at once, filter the policy set at the beginning, removing unmatchable policies
author Adam Chlipala <adamc@hcoop.net>
date Tue, 13 Apr 2010 09:31:04 -0400
parents c316ca3c9ec6
children 0b639858200b
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@1199 139 "rec" "sequence" "sig" "signature" "cookie" "style" "task" "policy"
adamc@754 140 "struct" "structure" "table" "view" "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@993 147 (urweb-syms-re "SELECT" "DISTINCT" "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@714 151 "PRIMARY" "KEY" "CONSTRAINT" "UNIQUE" "CHECK"
adamc@749 152 "FOREIGN" "REFERENCES" "ON" "NO" "ACTION" "CASCADE" "RESTRICT" "NULL"
adamc@1071 153 "JOIN" "INNER" "OUTER" "LEFT" "RIGHT" "FULL" "CROSS" "SELECT1")
adamc@350 154 "A regexp that matches SQL keywords.")
adamc@350 155
adamc@351 156 (defconst urweb-lident-regexp "\\<[a-z_][A-Za-z0-9_']*\\>"
adamc@351 157 "A regexp that matches lowercase Ur/Web identifiers.")
adamc@351 158
adamc@351 159 (defconst urweb-cident-regexp "\\<[A-Z][A-Za-z0-9_']*\\>"
adamc@351 160 "A regexp that matches uppercase Ur/Web identifiers.")
adamc@351 161
adamc@350 162 ;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
adamc@350 163
adamc@350 164 ;; The font lock regular expressions.
adamc@350 165
adamc@363 166 (defun urweb-in-xml ()
adamc@360 167 (save-excursion
adamc@360 168 (let (
adamc@360 169 (depth 0)
adamc@360 170 (finished nil)
adamc@360 171 (answer nil)
adamc@360 172 )
adamc@360 173 (while (and (not finished) (re-search-backward "[<>{}]" nil t))
adamc@360 174 (cond
adamc@360 175 ((looking-at "{")
adamc@360 176 (if (> depth 0)
adamc@363 177 (decf depth)
adamc@360 178 (setq finished t)))
adamc@360 179 ((looking-at "}")
adamc@363 180 (incf depth))
adamc@374 181 ((save-excursion (backward-char 1) (or (looking-at "=>")
adamc@374 182 (looking-at "->")
adamc@374 183 (looking-at "<>")))
adamc@360 184 nil)
adamc@393 185 ((or (looking-at "< ") (looking-at "<="))
adamc@393 186 nil)
adamc@360 187 ((looking-at "<")
adamc@360 188 (setq finished t))
adamc@393 189 ((save-excursion (backward-char 1) (looking-at " >"))
adamc@393 190 nil)
adamc@360 191 ((looking-at ">")
adamc@374 192 (cond
adamc@374 193 ((> depth 0)
adamc@374 194 (if (not (re-search-backward "<" nil t))
adamc@374 195 (setq finished t)))
adamc@393 196 ((save-excursion (backward-char 1) (looking-at " "))
adamc@393 197 (setq finished t))
adamc@374 198 (t
adamc@360 199 (progn (backward-char 4)
adamc@360 200 (setq answer (not (or
adamc@360 201 (looking-at "/xml")
adamc@360 202 (looking-at "xml/"))))
adamc@374 203 (setq finished t)))))))
adamc@360 204 answer)))
adamc@360 205
adamc@360 206 (defun amAttribute (face)
adamc@360 207 (if (ignore-errors (save-excursion (backward-word 2) (backward-char 1) (looking-at "<")))
adamc@360 208 nil
adamc@360 209 face))
adamc@358 210
adamc@350 211 (defconst urweb-font-lock-keywords
adamc@350 212 `(;;(urweb-font-comments-and-strings)
adamc@362 213 ("\\(<\\sw+\\)\\(\\s-\\|\\sw\\|=\\|\"[^\"]*\"\\|{[^}]*}\\)*\\(/?>\\)"
adamc@359 214 (1 font-lock-tag-face)
adamc@359 215 (3 font-lock-tag-face))
adamc@359 216 ("\\(</\\sw+>\\)"
adamc@359 217 (1 font-lock-tag-face))
adamc@359 218 ("\\([^<>{}]+\\)"
adamc@363 219 (1 (if (urweb-in-xml)
adamc@359 220 font-lock-string-face
adamc@359 221 nil)))
adamc@359 222
adamc@357 223 ("\\<\\(fun\\|and\\)\\s-+\\(\\sw+\\)\\s-+[^ \t\n=]"
adamc@350 224 (1 font-lock-keyword-face)
adamc@360 225 (2 (amAttribute font-lock-function-name-face)))
adamc@357 226 ("\\<\\(\\(data\\)?type\\|con\\|class\\)\\s-+\\(\\sw+\\)"
adamc@350 227 (1 font-lock-keyword-face)
adamc@360 228 (3 (amAttribute font-lock-type-def-face)))
adamc@1199 229 ("\\<\\(val\\|table\\|sequence\\|cookie\\|style\\|task\\|policy\\)\\s-+\\(\\sw+\\>\\s-*\\)?\\(\\sw+\\)\\s-*[=:]"
adamc@350 230 (1 font-lock-keyword-face)
adamc@360 231 (3 (amAttribute font-lock-variable-name-face)))
adamc@350 232 ("\\<\\(structure\\|functor\\)\\s-+\\(\\sw+\\)"
adamc@350 233 (1 font-lock-keyword-face)
adamc@360 234 (2 (amAttribute font-lock-module-def-face)))
adamc@350 235 ("\\<\\(signature\\)\\s-+\\(\\sw+\\)"
adamc@350 236 (1 font-lock-keyword-face)
adamc@360 237 (2 (amAttribute font-lock-interface-def-face)))
adamc@350 238
adamc@350 239 (,urweb-keywords-regexp . font-lock-keyword-face)
adamc@351 240 (,urweb-sql-keywords-regexp . font-lock-sql-face)
adamc@351 241 (,urweb-cident-regexp . font-lock-cvariable-face))
adamc@350 242 "Regexps matching standard Ur/Web keywords.")
adamc@350 243
adamc@350 244 (defface font-lock-type-def-face
adamc@350 245 '((t (:bold t)))
adamc@350 246 "Font Lock mode face used to highlight type definitions."
adamc@350 247 :group 'font-lock-highlighting-faces)
adamc@350 248 (defvar font-lock-type-def-face 'font-lock-type-def-face
adamc@350 249 "Face name to use for type definitions.")
adamc@350 250
adamc@350 251 (defface font-lock-module-def-face
adamc@350 252 '((t (:bold t)))
adamc@350 253 "Font Lock mode face used to highlight module definitions."
adamc@350 254 :group 'font-lock-highlighting-faces)
adamc@350 255 (defvar font-lock-module-def-face 'font-lock-module-def-face
adamc@350 256 "Face name to use for module definitions.")
adamc@350 257
adamc@350 258 (defface font-lock-interface-def-face
adamc@350 259 '((t (:bold t)))
adamc@350 260 "Font Lock mode face used to highlight interface definitions."
adamc@350 261 :group 'font-lock-highlighting-faces)
adamc@350 262 (defvar font-lock-interface-def-face 'font-lock-interface-def-face
adamc@350 263 "Face name to use for interface definitions.")
adamc@350 264
adamc@350 265 (defface font-lock-sql-face
adamc@350 266 '((t (:bold t)))
adamc@350 267 "Font Lock mode face used to highlight SQL keywords."
adamc@350 268 :group 'font-lock-highlighting-faces)
adamc@350 269 (defvar font-lock-sql-face 'font-lock-sql-face
adamc@350 270 "Face name to use for SQL keywords.")
adamc@350 271
adamc@351 272 (defface font-lock-cvariable-face
adamc@351 273 '((t (:foreground "dark blue")))
adamc@351 274 "Font Lock mode face used to highlight capitalized identifiers."
adamc@351 275 :group 'font-lock-highlighting-faces)
adamc@351 276 (defvar font-lock-cvariable-face 'font-lock-cvariable-face
adamc@351 277 "Face name to use for capitalized identifiers.")
adamc@351 278
adamc@357 279 (defface font-lock-tag-face
adamc@357 280 '((t (:bold t)))
adamc@357 281 "Font Lock mode face used to highlight XML tags."
adamc@357 282 :group 'font-lock-highlighting-faces)
adamc@357 283 (defvar font-lock-tag-face 'font-lock-tag-face
adamc@357 284 "Face name to use for XML tags.")
adamc@357 285
adamc@358 286 (defface font-lock-attr-face
adamc@358 287 '((t (:bold t)))
adamc@358 288 "Font Lock mode face used to highlight XML attributes."
adamc@358 289 :group 'font-lock-highlighting-faces)
adamc@358 290 (defvar font-lock-attr-face 'font-lock-attr-face
adamc@358 291 "Face name to use for XML attributes.")
adamc@358 292
adamc@350 293 ;;
adamc@350 294 ;; Code to handle nested comments and unusual string escape sequences
adamc@350 295 ;;
adamc@350 296
adamc@350 297 (defsyntax urweb-syntax-prop-table
adamc@350 298 '((?\\ . ".") (?* . "."))
adamc@350 299 "Syntax table for text-properties")
adamc@350 300
adamc@350 301 ;; For Emacsen that have no built-in support for nested comments
adamc@350 302 (defun urweb-get-depth-st ()
adamc@350 303 (save-excursion
adamc@350 304 (let* ((disp (if (eq (char-before) ?\)) (progn (backward-char) -1) nil))
adamc@350 305 (_ (backward-char))
adamc@350 306 (disp (if (eq (char-before) ?\() (progn (backward-char) 0) disp))
adamc@350 307 (pt (point)))
adamc@350 308 (when disp
adamc@350 309 (let* ((depth
adamc@350 310 (save-match-data
adamc@350 311 (if (re-search-backward "\\*)\\|(\\*" nil t)
adamc@350 312 (+ (or (get-char-property (point) 'comment-depth) 0)
adamc@350 313 (case (char-after) (?\( 1) (?* 0))
adamc@350 314 disp)
adamc@350 315 0)))
adamc@350 316 (depth (if (> depth 0) depth)))
adamc@350 317 (put-text-property pt (1+ pt) 'comment-depth depth)
adamc@350 318 (when depth urweb-syntax-prop-table))))))
adamc@350 319
adamc@350 320 (defconst urweb-font-lock-syntactic-keywords
adamc@350 321 `(("^\\s-*\\(\\\\\\)" (1 ',urweb-syntax-prop-table))
adamc@350 322 ,@(unless urweb-builtin-nested-comments-flag
adamc@350 323 '(("(?\\(\\*\\))?" (1 (urweb-get-depth-st)))))))
adamc@350 324
adamc@350 325 (defconst urweb-font-lock-defaults
adamc@350 326 '(urweb-font-lock-keywords nil nil ((?_ . "w") (?' . "w")) nil
adamc@350 327 (font-lock-syntactic-keywords . urweb-font-lock-syntactic-keywords)))
adamc@350 328
adamc@350 329 ;;;;
adamc@350 330 ;;;; Imenu support
adamc@350 331 ;;;;
adamc@350 332
adamc@350 333 (defvar urweb-imenu-regexp
adamc@350 334 (concat "^[ \t]*\\(let[ \t]+\\)?"
adamc@350 335 (regexp-opt (append urweb-module-head-syms
adamc@350 336 '("and" "fun" "datatype" "type")) t)
adamc@350 337 "\\>"))
adamc@350 338
adamc@350 339 (defun urweb-imenu-create-index ()
adamc@350 340 (let (alist)
adamc@350 341 (goto-char (point-max))
adamc@350 342 (while (re-search-backward urweb-imenu-regexp nil t)
adamc@350 343 (save-excursion
adamc@350 344 (let ((kind (match-string 2))
adamc@350 345 (column (progn (goto-char (match-beginning 2)) (current-column)))
adamc@350 346 (location
adamc@350 347 (progn (goto-char (match-end 0))
adamc@350 348 (urweb-forward-spaces)
adamc@350 349 (when (looking-at urweb-tyvarseq-re)
adamc@350 350 (goto-char (match-end 0)))
adamc@350 351 (point)))
adamc@350 352 (name (urweb-forward-sym)))
adamc@350 353 ;; Eliminate trivial renamings.
adamc@350 354 (when (or (not (member kind '("structure" "signature")))
adamc@350 355 (progn (search-forward "=")
adamc@350 356 (urweb-forward-spaces)
adamc@350 357 (looking-at "sig\\|struct")))
adamc@350 358 (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
adamc@350 359 alist)))))
adamc@350 360 alist))
adamc@350 361
adamc@350 362 ;;; MORE CODE FOR URWEB-MODE
adamc@350 363
adamc@350 364 ;;;###autoload (add-to-list 'load-path (file-name-directory load-file-name))
adamc@350 365 ;;;###autoload
adamc@362 366 (add-to-list 'auto-mode-alist '("\\.urs?\\'" . urweb-mode))
adamc@350 367
adamc@350 368 ;;;###autoload
adamc@350 369 (define-derived-mode urweb-mode fundamental-mode "Ur/Web"
adamc@350 370 "\\<urweb-mode-map>Major mode for editing Ur/Web code.
adamc@350 371 This mode runs `urweb-mode-hook' just before exiting.
adamc@350 372 \\{urweb-mode-map}"
adamc@350 373 (set (make-local-variable 'font-lock-defaults) urweb-font-lock-defaults)
adamc@358 374 (set (make-local-variable 'font-lock-multiline) 'undecided)
adamc@350 375 (set (make-local-variable 'outline-regexp) urweb-outline-regexp)
adamc@350 376 (set (make-local-variable 'imenu-create-index-function)
adamc@350 377 'urweb-imenu-create-index)
adamc@350 378 (set (make-local-variable 'add-log-current-defun-function)
adamc@350 379 'urweb-current-fun-name)
adamc@350 380 ;; Treat paragraph-separators in comments as paragraph-separators.
adamc@350 381 (set (make-local-variable 'paragraph-separate)
adamc@350 382 (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
adamc@350 383 (set (make-local-variable 'require-final-newline) t)
adamc@350 384 ;; forward-sexp-function is an experimental variable in my hacked Emacs.
adamc@350 385 (set (make-local-variable 'forward-sexp-function) 'urweb-user-forward-sexp)
adamc@350 386 ;; For XEmacs
adamc@350 387 (easy-menu-add urweb-mode-menu)
adamc@358 388
adamc@350 389 ;; Compatibility. FIXME: we should use `-' in Emacs-CVS.
adamc@350 390 (unless (boundp 'skeleton-positions) (set (make-local-variable '@) nil))
adamc@358 391
adamc@360 392 (urweb-mode-variables))
adamc@350 393
adamc@350 394 (defun urweb-mode-variables ()
adamc@350 395 (set-syntax-table urweb-mode-syntax-table)
adamc@350 396 (setq local-abbrev-table urweb-mode-abbrev-table)
adamc@350 397 ;; A paragraph is separated by blank lines or ^L only.
adamc@350 398
adamc@350 399 (set (make-local-variable 'indent-line-function) 'urweb-indent-line)
adamc@350 400 (set (make-local-variable 'comment-start) "(* ")
adamc@350 401 (set (make-local-variable 'comment-end) " *)")
adamc@350 402 (set (make-local-variable 'comment-nested) t)
adamc@350 403 ;;(set (make-local-variable 'block-comment-start) "* ")
adamc@350 404 ;;(set (make-local-variable 'block-comment-end) "")
adamc@350 405 ;; (set (make-local-variable 'comment-column) 40)
adamc@350 406 (set (make-local-variable 'comment-start-skip) "(\\*+\\s-*"))
adamc@350 407
adamc@350 408 (defun urweb-funname-of-and ()
adamc@350 409 "Name of the function this `and' defines, or nil if not a function.
adamc@350 410 Point has to be right after the `and' symbol and is not preserved."
adamc@350 411 (urweb-forward-spaces)
adamc@350 412 (if (looking-at urweb-tyvarseq-re) (goto-char (match-end 0)))
adamc@350 413 (let ((sym (urweb-forward-sym)))
adamc@350 414 (urweb-forward-spaces)
adamc@350 415 (unless (or (member sym '(nil "d="))
adamc@350 416 (member (urweb-forward-sym) '("d=")))
adamc@350 417 sym)))
adamc@350 418
adamc@350 419 ;;; INDENTATION !!!
adamc@350 420
adamc@350 421 (defun urweb-mark-function ()
adamc@350 422 "Synonym for `mark-paragraph' -- sorry.
adamc@350 423 If anyone has a good algorithm for this..."
adamc@350 424 (interactive)
adamc@350 425 (mark-paragraph))
adamc@350 426
adamc@350 427 (defun urweb-indent-line ()
adamc@350 428 "Indent current line of Ur/Web code."
adamc@350 429 (interactive)
adamc@350 430 (let ((savep (> (current-column) (current-indentation)))
adamc@350 431 (indent (max (or (ignore-errors (urweb-calculate-indentation)) 0) 0)))
adamc@350 432 (if savep
adamc@350 433 (save-excursion (indent-line-to indent))
adamc@350 434 (indent-line-to indent))))
adamc@350 435
adamc@350 436 (defun urweb-back-to-outer-indent ()
adamc@350 437 "Unindents to the next outer level of indentation."
adamc@350 438 (interactive)
adamc@350 439 (save-excursion
adamc@350 440 (beginning-of-line)
adamc@350 441 (skip-chars-forward "\t ")
adamc@350 442 (let ((start-column (current-column))
adamc@350 443 (indent (current-column)))
adamc@350 444 (if (> start-column 0)
adamc@350 445 (progn
adamc@350 446 (save-excursion
adamc@350 447 (while (>= indent start-column)
adamc@350 448 (if (re-search-backward "^[^\n]" nil t)
adamc@350 449 (setq indent (current-indentation))
adamc@350 450 (setq indent 0))))
adamc@350 451 (backward-delete-char-untabify (- start-column indent)))))))
adamc@350 452
adamc@350 453 (defun urweb-find-comment-indent ()
adamc@350 454 (save-excursion
adamc@350 455 (let ((depth 1))
adamc@350 456 (while (> depth 0)
adamc@350 457 (if (re-search-backward "(\\*\\|\\*)" nil t)
adamc@350 458 (cond
adamc@350 459 ;; FIXME: That's just a stop-gap.
adamc@350 460 ((eq (get-text-property (point) 'face) 'font-lock-string-face))
adamc@350 461 ((looking-at "*)") (incf depth))
adamc@350 462 ((looking-at comment-start-skip) (decf depth)))
adamc@350 463 (setq depth -1)))
adamc@350 464 (if (= depth 0)
adamc@350 465 (1+ (current-column))
adamc@350 466 nil))))
adamc@350 467
adamc@369 468 (defun urweb-empty-line ()
adamc@365 469 (save-excursion
adamc@369 470 (beginning-of-line)
adamc@365 471 (let ((start-pos (point)))
adamc@369 472 (end-of-line)
adamc@369 473 (not (re-search-backward "[^\n \t]" start-pos t)))))
adamc@365 474
adamc@369 475 (defun urweb-seek-back ()
adamc@369 476 (while (urweb-empty-line) (previous-line 1)))
adamc@363 477
adamc@369 478 (defun urweb-skip-matching-braces ()
adamc@367 479 "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code"
adamc@367 480 (beginning-of-line)
adamc@367 481 (let ((start-pos (point))
adamc@367 482 (depth 0))
adamc@367 483 (end-of-line)
adamc@367 484 (while (re-search-backward "[{}]" start-pos t)
adamc@367 485 (cond
adamc@367 486 ((looking-at "}")
adamc@367 487 (incf depth))
adamc@367 488 ((looking-at "{")
adamc@367 489 (decf depth))))
adamc@367 490 (while (and (> depth 0) (re-search-backward "[{}]" nil t)
adamc@367 491 (cond
adamc@367 492 ((looking-at "}")
adamc@367 493 (incf depth))
adamc@367 494 ((looking-at "{")
adamc@367 495 (decf depth)))))))
adamc@367 496
adamc@369 497 (defun urweb-new-tags ()
adamc@369 498 "Decide if the previous line of XML introduced unclosed tags"
adamc@369 499 (save-excursion
adamc@369 500 (let ((start-pos (point))
adamc@369 501 (depth 0)
adamc@369 502 (done nil))
adamc@369 503 (previous-line 1)
adamc@369 504 (urweb-seek-back)
adamc@369 505 (urweb-skip-matching-braces)
adamc@369 506 (urweb-seek-back)
adamc@369 507 (beginning-of-line)
adamc@369 508 (while (and (not done) (search-forward "<" start-pos t))
adamc@396 509 (cond
adamc@396 510 ((or (looking-at " ") (looking-at "="))
adamc@396 511 nil)
adamc@396 512 ((looking-at "/")
adamc@396 513 (if (re-search-forward "[^\\sw]>" start-pos t)
adamc@369 514 (when (> depth 0) (decf depth))
adamc@396 515 (setq done t)))
adamc@396 516 (t
adamc@396 517 (if (re-search-forward "[^\\sw]>" start-pos t)
adamc@369 518 (if (not (save-excursion (backward-char 2) (looking-at "/")))
adamc@369 519 (incf depth))
adamc@396 520 (setq done t)))))
adamc@369 521 (and (not done) (> depth 0)))))
adamc@369 522
adamc@363 523 (defun urweb-tag-matching-indent ()
adamc@363 524 "Seek back to a matching opener tag and get its line's indent"
adamc@363 525 (save-excursion
adamc@369 526 (end-of-line)
adamc@369 527 (search-backward "</" nil t)
adamc@368 528 (urweb-tag-matcher)
adamc@369 529 (beginning-of-line)
adamc@369 530 (current-indentation)))
adamc@363 531
adamc@373 532 (defconst urweb-sql-main-starters
adamc@1071 533 '("SQL" "SELECT" "INSERT" "UPDATE" "DELETE" "FROM" "SELECT1" "WHERE"))
adamc@373 534
adamc@372 535 (defconst urweb-sql-starters
adamc@373 536 (append urweb-sql-main-starters
adamc@373 537 '("^\\s-+FROM" "WHERE" "GROUP" "ORDER" "HAVING" "LIMIT" "OFFSET"
adamc@373 538 "VALUES" "SET")))
adamc@372 539
adamc@373 540 (defconst urweb-sql-main-starters-re
adamc@373 541 (urweb-syms-re urweb-sql-main-starters))
adamc@372 542 (defconst urweb-sql-starters-re
adamc@372 543 (urweb-syms-re urweb-sql-starters))
adamc@372 544
adamc@374 545 (defconst urweb-sql-main-starters-paren-re
adamc@374 546 (concat "(" urweb-sql-main-starters-re))
adamc@374 547
adamc@374 548 (defun urweb-in-sql ()
adamc@374 549 "Check if the point is in a block of SQL syntax."
adamc@374 550 (save-excursion
adamc@375 551 (let ((start-pos (point))
adamc@375 552 (depth 0)
adamc@375 553 done
adamc@375 554 (good t))
adamc@375 555 (when (re-search-backward urweb-sql-main-starters-paren-re nil t)
adamc@375 556 (forward-char)
adamc@375 557 (while (and (not done) (re-search-forward "[()]" start-pos t))
adamc@375 558 (save-excursion
adamc@375 559 (backward-char)
adamc@375 560 (cond
adamc@375 561 ((looking-at ")")
adamc@375 562 (cond
adamc@375 563 ((= depth 0) (setq done t) (setq good nil))
adamc@375 564 (t (decf depth))))
adamc@375 565 ((looking-at "(")
adamc@375 566 (incf depth)))))
adamc@375 567 good))))
adamc@374 568
adamc@374 569 (defun urweb-sql-depth ()
adamc@374 570 "Check if the point is in a block of SQL syntax.
adamc@374 571 Returns the paren nesting depth if so, and nil otherwise."
adamc@374 572 (save-excursion
adamc@374 573 (let ((depth 0)
adamc@374 574 done)
adamc@374 575 (while (and (not done)
adamc@374 576 (re-search-backward "[()]" nil t))
adamc@374 577 (cond
adamc@374 578 ((looking-at ")")
adamc@374 579 (decf depth))
adamc@374 580 ((looking-at "(")
adamc@374 581 (if (looking-at urweb-sql-main-starters-paren-re)
adamc@374 582 (setq done t)
adamc@374 583 (incf depth)))))
adamc@374 584 (max 0 depth))))
adamc@374 585
adamc@350 586 (defun urweb-calculate-indentation ()
adamc@350 587 (save-excursion
adamc@350 588 (beginning-of-line) (skip-chars-forward "\t ")
adamc@350 589 (urweb-with-ist
adamc@350 590 ;; Indentation for comments alone on a line, matches the
adamc@350 591 ;; proper indentation of the next line.
adamc@350 592 (when (looking-at "(\\*") (urweb-forward-spaces))
adamc@350 593 (let (data
adamc@350 594 (sym (save-excursion (urweb-forward-sym))))
adamc@350 595 (or
adamc@350 596 ;; Allow the user to override the indentation.
adamc@350 597 (when (looking-at (concat ".*" (regexp-quote comment-start)
adamc@350 598 "[ \t]*fixindent[ \t]*"
adamc@350 599 (regexp-quote comment-end)))
adamc@350 600 (current-indentation))
adamc@350 601
adamc@350 602 ;; Continued comment.
adamc@350 603 (and (looking-at "\\*") (urweb-find-comment-indent))
adamc@350 604
adamc@363 605 (and (urweb-in-xml)
adamc@363 606 (let ((prev-indent (save-excursion
adamc@363 607 (previous-line 1)
adamc@369 608 (urweb-seek-back)
adamc@369 609 (urweb-skip-matching-braces)
adamc@369 610 (urweb-seek-back)
adamc@363 611 (current-indentation))))
adamc@363 612 (cond
adamc@363 613 ((looking-at "</")
adamc@363 614 (urweb-tag-matching-indent))
adamc@363 615 ((urweb-new-tags)
adamc@363 616 (+ prev-indent 2))
adamc@363 617 (t
adamc@363 618 prev-indent))))
adamc@363 619
adamc@350 620 ;; Continued string ? (Added 890113 lbn)
adamc@350 621 (and (looking-at "\\\\")
adamc@350 622 (save-excursion
adamc@350 623 (if (save-excursion (previous-line 1)
adamc@350 624 (beginning-of-line)
adamc@350 625 (looking-at "[\t ]*\\\\"))
adamc@350 626 (progn (previous-line 1) (current-indentation))
adamc@350 627 (if (re-search-backward "[^\\\\]\"" nil t)
adamc@350 628 (1+ (current-column))
adamc@350 629 0))))
adamc@350 630
adamc@350 631 ;; Closing parens. Could be handled below with `urweb-indent-relative'?
adamc@350 632 (and (looking-at "\\s)")
adamc@350 633 (save-excursion
adamc@350 634 (skip-syntax-forward ")")
adamc@350 635 (backward-sexp 1)
adamc@350 636 (if (urweb-dangling-sym)
adamc@350 637 (urweb-indent-default 'noindent)
adamc@350 638 (current-column))))
adamc@350 639
adamc@374 640 (and (or (looking-at "FROM") (looking-at urweb-sql-starters-re))
adamc@386 641
adamc@372 642 (save-excursion
adamc@372 643 (and (re-search-backward urweb-sql-starters-re nil t)
adamc@373 644 (if (looking-at urweb-sql-main-starters-re)
adamc@373 645 (current-column)
adamc@373 646 (current-indentation)))))
adamc@372 647
adamc@374 648 (and (urweb-in-sql)
adamc@374 649 (setq data (urweb-sql-depth))
adamc@374 650 (save-excursion
adamc@374 651 (re-search-backward urweb-sql-starters-re nil t)
adamc@374 652 (+ (current-column) 2 (* 2 data))))
adamc@374 653
adamc@350 654 (and (setq data (assoc sym urweb-close-paren))
adamc@350 655 (urweb-indent-relative sym data))
adamc@350 656
adamc@350 657 (and (member sym urweb-starters-syms)
adamc@350 658 (urweb-indent-starter sym))
adamc@350 659
adamc@350 660 (and (string= sym "|") (urweb-indent-pipe))
adamc@350 661
adamc@350 662 (urweb-indent-arg)
adamc@350 663 (urweb-indent-default))))))
adamc@350 664
adamc@350 665 (defsubst urweb-bolp ()
adamc@350 666 (save-excursion (skip-chars-backward " \t|") (bolp)))
adamc@350 667
adamc@350 668 (defun urweb-indent-starter (orig-sym)
adamc@350 669 "Return the indentation to use for a symbol in `urweb-starters-syms'.
adamc@350 670 Point should be just before the symbol ORIG-SYM and is not preserved."
adamc@350 671 (let ((sym (unless (save-excursion (urweb-backward-arg))
adamc@350 672 (urweb-backward-spaces)
adamc@350 673 (urweb-backward-sym))))
adamc@350 674 (if (member sym '(";" "d=")) (setq sym nil))
adamc@350 675 (if sym (urweb-get-sym-indent sym)
adamc@350 676 ;; FIXME: this can take a *long* time !!
adamc@350 677 (setq sym (urweb-find-matching-starter urweb-starters-syms))
adamc@350 678 ;; Don't align with `and' because it might be specially indented.
adamc@350 679 (if (and (or (equal orig-sym "and") (not (equal sym "and")))
adamc@350 680 (urweb-bolp))
adamc@350 681 (+ (current-column)
adamc@350 682 (if (and urweb-rightalign-and (equal orig-sym "and"))
adamc@350 683 (- (length sym) 3) 0))
adamc@350 684 (urweb-indent-starter orig-sym)))))
adamc@350 685
adamc@350 686 (defun urweb-indent-relative (sym data)
adamc@350 687 (save-excursion
adamc@350 688 (urweb-forward-sym) (urweb-backward-sexp nil)
adamc@350 689 (unless (second data) (urweb-backward-spaces) (urweb-backward-sym))
adamc@350 690 (+ (or (cdr (assoc sym urweb-symbol-indent)) 0)
adamc@350 691 (urweb-delegated-indent))))
adamc@350 692
adamc@350 693 (defun urweb-indent-pipe ()
adamc@350 694 (let ((sym (urweb-find-matching-starter urweb-pipeheads
adamc@350 695 (urweb-op-prec "|" 'back))))
adamc@350 696 (when sym
adamc@350 697 (if (string= sym "|")
adamc@350 698 (if (urweb-bolp) (current-column) (urweb-indent-pipe))
adamc@350 699 (let ((pipe-indent (or (cdr (assoc "|" urweb-symbol-indent)) -2)))
adamc@350 700 (when (or (member sym '("datatype"))
adamc@350 701 (and (equal sym "and")
adamc@350 702 (save-excursion
adamc@350 703 (forward-word 1)
adamc@350 704 (not (urweb-funname-of-and)))))
adamc@350 705 (re-search-forward "="))
adamc@350 706 (urweb-forward-sym)
adamc@350 707 (urweb-forward-spaces)
adamc@350 708 (+ pipe-indent (current-column)))))))
adamc@350 709
adamc@350 710 (defun urweb-find-forward (re)
adamc@350 711 (urweb-forward-spaces)
adamc@350 712 (while (and (not (looking-at re))
adamc@350 713 (progn
adamc@350 714 (or (ignore-errors (forward-sexp 1) t) (forward-char 1))
adamc@350 715 (urweb-forward-spaces)
adamc@350 716 (not (looking-at re))))))
adamc@350 717
adamc@350 718 (defun urweb-indent-arg ()
adamc@350 719 (and (save-excursion (ignore-errors (urweb-forward-arg)))
adamc@350 720 ;;(not (looking-at urweb-not-arg-re))
adamc@350 721 ;; looks like a function or an argument
adamc@350 722 (urweb-move-if (urweb-backward-arg))
adamc@350 723 ;; an argument
adamc@350 724 (if (save-excursion (not (urweb-backward-arg)))
adamc@350 725 ;; a first argument
adamc@350 726 (+ (current-column) urweb-indent-args)
adamc@350 727 ;; not a first arg
adamc@350 728 (while (and (/= (current-column) (current-indentation))
adamc@350 729 (urweb-move-if (urweb-backward-arg))))
adamc@350 730 (unless (save-excursion (urweb-backward-arg))
adamc@350 731 ;; all earlier args are on the same line
adamc@350 732 (urweb-forward-arg) (urweb-forward-spaces))
adamc@350 733 (current-column))))
adamc@350 734
adamc@350 735 (defun urweb-get-indent (data sym)
adamc@350 736 (let (d)
adamc@350 737 (cond
adamc@350 738 ((not (listp data)) data)
adamc@350 739 ((setq d (member sym data)) (cadr d))
adamc@350 740 ((and (consp data) (not (stringp (car data)))) (car data))
adamc@350 741 (t urweb-indent-level))))
adamc@350 742
adamc@350 743 (defun urweb-dangling-sym ()
adamc@350 744 "Non-nil if the symbol after point is dangling.
adamc@350 745 The symbol can be an Ur/Web symbol or an open-paren. \"Dangling\" means that
adamc@350 746 it is not on its own line but is the last element on that line."
adamc@350 747 (save-excursion
adamc@350 748 (and (not (urweb-bolp))
adamc@350 749 (< (urweb-point-after (end-of-line))
adamc@350 750 (urweb-point-after (or (urweb-forward-sym) (skip-syntax-forward "("))
adamc@350 751 (urweb-forward-spaces))))))
adamc@350 752
adamc@350 753 (defun urweb-delegated-indent ()
adamc@350 754 (if (urweb-dangling-sym)
adamc@350 755 (urweb-indent-default 'noindent)
adamc@350 756 (urweb-move-if (backward-word 1)
adamc@350 757 (looking-at urweb-agglomerate-re))
adamc@350 758 (current-column)))
adamc@350 759
adamc@350 760 (defun urweb-get-sym-indent (sym &optional style)
adamc@350 761 "Find the indentation for the SYM we're `looking-at'.
adamc@350 762 If indentation is delegated, point will move to the start of the parent.
adamc@350 763 Optional argument STYLE is currently ignored."
adamc@371 764 ;;(assert (equal sym (save-excursion (urweb-forward-sym))))
adamc@350 765 (save-excursion
adamc@350 766 (let ((delegate (and (not (equal sym "end")) (assoc sym urweb-close-paren)))
adamc@350 767 (head-sym sym))
adamc@350 768 (when (and delegate (not (eval (third delegate))))
adamc@350 769 ;;(urweb-find-match-backward sym delegate)
adamc@350 770 (urweb-forward-sym) (urweb-backward-sexp nil)
adamc@350 771 (setq head-sym
adamc@350 772 (if (second delegate)
adamc@350 773 (save-excursion (urweb-forward-sym))
adamc@350 774 (urweb-backward-spaces) (urweb-backward-sym))))
adamc@350 775 (let ((idata (assoc head-sym urweb-indent-rule)))
adamc@350 776 (when idata
adamc@350 777 ;;(if (or style (not delegate))
adamc@350 778 ;; normal indentation
adamc@350 779 (let ((indent (urweb-get-indent (cdr idata) sym)))
adamc@350 780 (when indent (+ (urweb-delegated-indent) indent)))
adamc@350 781 ;; delgate indentation to the parent
adamc@350 782 ;;(urweb-forward-sym) (urweb-backward-sexp nil)
adamc@350 783 ;;(let* ((parent-sym (save-excursion (urweb-forward-sym)))
adamc@350 784 ;; (parent-indent (cdr (assoc parent-sym urweb-indent-starters))))
adamc@350 785 ;; check the special rules
adamc@350 786 ;;(+ (urweb-delegated-indent)
adamc@350 787 ;; (or (urweb-get-indent (cdr indent-data) 1 'strict)
adamc@350 788 ;; (urweb-get-indent (cdr parent-indent) 1 'strict)
adamc@350 789 ;; (urweb-get-indent (cdr indent-data) 0)
adamc@350 790 ;; (urweb-get-indent (cdr parent-indent) 0))))))))
adamc@350 791 )))))
adamc@350 792
adamc@350 793 (defun urweb-indent-default (&optional noindent)
adamc@386 794 (condition-case nil
adamc@386 795 (progn
adamc@386 796 (let* ((sym-after (save-excursion (urweb-forward-sym)))
adamc@386 797 (_ (urweb-backward-spaces))
adamc@386 798 (sym-before (urweb-backward-sym))
adamc@386 799 (sym-indent (and sym-before (urweb-get-sym-indent sym-before)))
adamc@386 800 (indent-after (or (cdr (assoc sym-after urweb-symbol-indent)) 0)))
adamc@386 801 (when (equal sym-before "end")
adamc@386 802 ;; I don't understand what's really happening here, but when
adamc@386 803 ;; it's `end' clearly, we need to do something special.
adamc@386 804 (forward-word 1)
adamc@386 805 (setq sym-before nil sym-indent nil))
adamc@386 806 (cond
adamc@386 807 (sym-indent
adamc@386 808 ;; the previous sym is an indentation introducer: follow the rule
adamc@386 809 (if noindent
adamc@386 810 ;;(current-column)
adamc@386 811 sym-indent
adamc@386 812 (+ sym-indent indent-after)))
adamc@386 813 ;; If we're just after a hanging open paren.
adamc@386 814 ((and (eq (char-syntax (preceding-char)) ?\()
adamc@386 815 (save-excursion (backward-char) (urweb-dangling-sym)))
adamc@386 816 (backward-char)
adamc@386 817 (urweb-indent-default))
adamc@386 818 (t
adamc@386 819 ;; default-default
adamc@386 820 (let* ((prec-after (urweb-op-prec sym-after 'back))
adamc@386 821 (prec (or (urweb-op-prec sym-before 'back) prec-after 100)))
adamc@386 822 ;; go back until you hit a symbol that has a lower prec than the
adamc@386 823 ;; "current one", or until you backed over a sym that has the same prec
adamc@386 824 ;; but is at the beginning of a line.
adamc@386 825 (while (and (not (urweb-bolp))
adamc@386 826 (while (urweb-move-if (urweb-backward-sexp (1- prec))))
adamc@386 827 (not (urweb-bolp)))
adamc@386 828 (while (urweb-move-if (urweb-backward-sexp prec))))
adamc@386 829 (if noindent
adamc@386 830 ;; the `noindent' case does back over an introductory symbol
adamc@386 831 ;; such as `fun', ...
adamc@386 832 (progn
adamc@386 833 (urweb-move-if
adamc@386 834 (urweb-backward-spaces)
adamc@386 835 (member (urweb-backward-sym) urweb-starters-syms))
adamc@386 836 (current-column))
adamc@386 837 ;; Use `indent-after' for cases such as when , or ; should be
adamc@386 838 ;; outdented so that their following terms are aligned.
adamc@386 839 (+ (if (progn
adamc@386 840 (if (equal sym-after ";")
adamc@386 841 (urweb-move-if
adamc@386 842 (urweb-backward-spaces)
adamc@386 843 (member (urweb-backward-sym) urweb-starters-syms)))
adamc@386 844 (and sym-after (not (looking-at sym-after))))
adamc@386 845 indent-after 0)
adamc@386 846 (current-column))))))))
adamc@386 847 (error 0)))
adamc@350 848
adamc@350 849
adamc@350 850 ;; maybe `|' should be set to word-syntax in our temp syntax table ?
adamc@350 851 (defun urweb-current-indentation ()
adamc@350 852 (save-excursion
adamc@350 853 (beginning-of-line)
adamc@350 854 (skip-chars-forward " \t|")
adamc@350 855 (current-column)))
adamc@350 856
adamc@350 857
adamc@350 858 (defun urweb-find-matching-starter (syms &optional prec)
adamc@350 859 (let (sym)
adamc@350 860 (ignore-errors
adamc@350 861 (while
adamc@350 862 (progn (urweb-backward-sexp prec)
adamc@350 863 (setq sym (save-excursion (urweb-forward-sym)))
adamc@350 864 (not (or (member sym syms) (bobp)))))
adamc@350 865 (if (member sym syms) sym))))
adamc@350 866
adamc@350 867 (defun urweb-skip-siblings ()
adamc@350 868 (while (and (not (bobp)) (urweb-backward-arg))
adamc@350 869 (urweb-find-matching-starter urweb-starters-syms)))
adamc@350 870
adamc@350 871 (defun urweb-beginning-of-defun ()
adamc@350 872 (let ((sym (urweb-find-matching-starter urweb-starters-syms)))
adamc@350 873 (if (member sym '("fun" "and" "functor" "signature" "structure"
adamc@350 874 "datatype"))
adamc@350 875 (save-excursion (urweb-forward-sym) (urweb-forward-spaces)
adamc@350 876 (urweb-forward-sym))
adamc@350 877 ;; We're inside a "non function declaration": let's skip all other
adamc@350 878 ;; declarations that we find at the same level and try again.
adamc@350 879 (urweb-skip-siblings)
adamc@350 880 ;; Obviously, let's not try again if we're at bobp.
adamc@350 881 (unless (bobp) (urweb-beginning-of-defun)))))
adamc@350 882
adamc@350 883 (defcustom urweb-max-name-components 3
adamc@350 884 "Maximum number of components to use for the current function name."
adamc@350 885 :group 'urweb
adamc@350 886 :type 'integer)
adamc@350 887
adamc@350 888 (defun urweb-current-fun-name ()
adamc@350 889 (save-excursion
adamc@350 890 (let ((count urweb-max-name-components)
adamc@350 891 fullname name)
adamc@350 892 (end-of-line)
adamc@350 893 (while (and (> count 0)
adamc@350 894 (setq name (urweb-beginning-of-defun)))
adamc@350 895 (decf count)
adamc@350 896 (setq fullname (if fullname (concat name "." fullname) name))
adamc@350 897 ;; Skip all other declarations that we find at the same level.
adamc@350 898 (urweb-skip-siblings))
adamc@350 899 fullname)))
adamc@350 900
adamc@358 901
adamc@358 902
adamc@350 903 (provide 'urweb-mode)
adamc@350 904
adamc@350 905 ;;; urweb-mode.el ends here