emacs/external/visual-basic-mode.el

   1 ;;; visual-basic-mode.el
   2 ;; This is free software.
   3
   4 ;; A mode for editing Visual Basic programs.
   5 ;; Modified version of Fred White's visual-basic-mode.el
   6
   7 ;; Copyright (C) 1996 Fred White <fwhite@alum.mit.edu>
   8 ;; Copyright (C) 1998 Free Software Foundation, Inc.
   9 ;;   (additions by Dave Love)
  10 ;; Copyright (C) 2008 Free Software Foundation, Inc.
  11 ;;   (additions by Randolph Fritz)
  12
  13 ;; Author: Fred White <fwhite@alum.mit.edu>
  14 ;; Adapted-by: Dave Love <d.love@dl.ac.uk>
  15 ;;           : Kevin Whitefoot <kevin.whitefoot@nopow.abb.no>
  16 ;;           : Randolph Fritz <rfritz@u.washington.edu>
  17 ;; Version: 1.4.2 (Mar 10, 2008)
  18 ;; Serial Version: %Id: 8%
  19 ;; Keywords: languages, basic, Evil
  20
  21
  22 ;; (Old) LCD Archive Entry:
  23 ;; basic-mode|Fred White|fwhite@alum.mit.edu|
  24 ;; A mode for editing Visual Basic programs.|
  25 ;; 18-Apr-96|1.0|~/modes/basic-mode.el.Z|
  26
  27 ;; This file is NOT part of GNU Emacs but the same permissions apply.
  28 ;;
  29 ;; GNU Emacs  is free software;  you can redistribute it and/or modify
  30 ;; it under the terms of  the GNU General  Public License as published
  31 ;; by  the Free Software  Foundation;  either version  2, or (at  your
  32 ;; option) any later version.
  33 ;;
  34 ;; GNU  Emacs is distributed  in the hope that  it will be useful, but
  35 ;; WITHOUT    ANY  WARRANTY;  without even the     implied warranty of
  36 ;; MERCHANTABILITY or FITNESS FOR A  PARTICULAR PURPOSE.  See the  GNU
  37 ;; General Public License for more details.
  38 ;;
  39 ;; You should have received  a copy of  the GNU General Public License
  40 ;; along with GNU Emacs; see  the file COPYING.  If  not, write to the
  41 ;; Free Software Foundation, 675  Mass Ave, Cambridge, MA 02139,  USA.
  42 ;; This  program  is free  software;  you  can  redistribute it and/or
  43 ;; modify it  under  the terms of the  GNU  General Public License  as
  44 ;; published by the Free Software  Foundation; either version 2 of the
  45 ;; License, or (at your option) any later version.
  46
  47 ;;; Commentary:
  48
  49 ;; Purpose of this package:
  50 ;;  This is a mode for editing programs written in The World's Most
  51 ;;  Successful Programming Language.  It features automatic
  52 ;;  indentation, font locking, keyword capitalization, and some minor
  53 ;;  convenience functions.
  54
  55 ;; Installation instructions
  56 ;;  Put basic-mode.el somewhere in your path, compile it, and add the
  57 ;;  following to your init file:
  58
  59 ;;  (autoload 'visual-basic-mode "visual-basic-mode" "Visual Basic mode." t)
  60 ;;  (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\)$" .
  61 ;;                                  visual-basic-mode)) auto-mode-alist))
  62 ;;
  63 ;;  If you are doing Rhino scripts, add:
  64 ;;  (setq auto-mode-alist (append '(("\\.\\(frm\\|bas\\|cls\\|rvb\\)$" .
  65 ;;                                  visual-basic-mode)) auto-mode-alist))
  66
  67
  68 ;; Of course, under Windows 3.1, you'll have to name this file
  69 ;; something shorter than visual-basic-mode.el
  70
  71 ;; Revisions:
  72 ;; 1.0 18-Apr-96  Initial version
  73 ;; 1.1 Accomodate emacs 19.29+ font-lock-defaults
  74 ;;     Simon Marshall <Simon.Marshall@esrin.esa.it>
  75 ;  1.2 Rename to visual-basic-mode
  76 ;; 1.3 Fix some indentation bugs.
  77 ;; 1.3+ Changes by Dave Love: [No attempt at compatibility with
  78 ;;      anything other than Emacs 20, sorry, but little attempt to
  79 ;;      sanitize for Emacs 20 specifically.]
  80 ;;      Change `_' syntax only for font-lock and imenu, not generally;
  81 ;;      provide levels of font-locking in the current fashion;
  82 ;;      font-lock case-insensitively; use regexp-opt with the font-lok
  83 ;;      keywords; imenu support; `visual-basic-split-line', bound to
  84 ;;      C-M-j; account for single-statement `if' in indentation; add
  85 ;;      keyword "Global"; use local-write-file-hooks, not
  86 ;;      write-file-hooks.
  87 ;; 1.4 September 1998
  88 ;; 1.4 KJW Add begin..end, add extra keywords
  89 ;;     Add customisation for single line if.  Disallow by default.
  90 ;;     Fix if regexp to require whitespace after if and require then.
  91 ;;     Add more VB keywords.  Make begin..end work as if..endif so
  92 ;;     that forms are formatted correctly.
  93 ;; 1.4.1 KJW Merged Dave Love and KJW versions.
  94 ;;     Added keywords suggested by Mickey Ferguson
  95 ;;     <MFerguson@peinc.com>
  96 ;;     Fixed imenu variable to find private variables and enums
  97
  98 ;;     Changed syntax class of =, <, > to punctuation to allow dynamic
  99 ;;     abbreviations to pick up only the word at point rather than the
 100 ;;     whole expression.
 101
 102 ;;     Fixed bug introduced by KJW adding suport for begin...end in
 103 ;;     forms whereby a single end outdented.
 104
 105 ;;     Partially fixed failure to recognise if statements with
 106 ;;     continuations (still fails on 'single line' if with
 107 ;;     continuation, ugh).
 108 ;; 1.4.2 RF added "class" and "null" keywords, "Rhino" script note.
 109
 110 ;;
 111 ;; Notes:
 112 ;; Dave Love
 113 ;; BTW, here's a script for making tags tables that I (Dave Love) have
 114 ;; used with reasonable success.  It assumes a hacked version of etags
 115 ;; with support for case-folded regexps.  I think this is now in the
 116 ;; development version at <URL:ftp://fly.cnuce.cnr.it/pub/> and should
 117 ;; make it into Emacs after 20.4.
 118
 119 ;; #! /bin/sh
 120
 121 ;; # etags-vb: (so-called) Visual (so-called) Basic TAGS generation.
 122 ;; # Dave Love <d.love@dl.ac.uk>.  Public domain.
 123 ;; # 1997-11-21
 124
 125 ;; if [ $# -lt 1 ]; then
 126 ;;     echo "Usage: `basename $0` [etags options] VBfile ... [etags options] " 1>&2
 127 ;;     exit 1
 128 ;; fi
 129
 130 ;; if [ $1 = "--help" ] || [ $1 = "-h" ]; then
 131 ;;     echo "Usage: `basename $0` [etags options] VBfile ... [etags options]
 132
 133 ;; "
 134 ;;     etags --help
 135 ;; fi
 136
 137 ;; exec etags --lang=none -c '/\(global\|public\)[ \t]+\(\(const\|type\)[ \t]+\)*\([a-z_0-9]+\)/\4/' \
 138 ;;     -c '/public[ \t]+\(sub\|function\|class\)[ \t]+\([a-z_0-9]+\)/\2/' \
 139 ;;   "$@"
 140
 141 ;; End Notes Dave Love
 142
 143
 144 ;; Known bugs:
 145 ;;  Doesn't know about ":" separated stmts
 146 ;;  Doesn't recognize single line if statements if these are broken by
 147 ;;  line continuation characters
 148
 149
 150 ;; todo:
 151 ;;  fwd/back-compound-statement
 152 ;;  completion over OCX methods and properties.
 153 ;;  IDE integration
 154 ;;  Change behaviour of ESC-q to recognise words used as paragraph
 155 ;;  titles and prevent them being dragged into the previous
 156 ;;  paragraph.
 157 ;;  etc.
 158
 159
 160 ;;; Code:
 161
 162 (provide 'visual-basic-mode)
 163
 164 (defvar visual-basic-xemacs-p (string-match "XEmacs\\|Lucid" (emacs-version)))
 165 (defvar visual-basic-winemacs-p (string-match "Win-Emacs" (emacs-version)))
 166 (defvar visual-basic-win32-p (eq window-system 'w32))
 167
 168 ;; Variables you may want to customize.
 169 (defvar visual-basic-mode-indent 8 "*Default indentation per nesting level.")
 170 (defvar visual-basic-fontify-p t "*Whether to fontify Basic buffers.")
 171 (defvar visual-basic-capitalize-keywords-p t
 172   "*Whether to capitalize BASIC keywords.")
 173 (defvar visual-basic-wild-files "*.frm *.bas *.cls"
 174   "*Wildcard pattern for BASIC source files.")
 175 (defvar visual-basic-ide-pathname nil
 176   "*The full pathname of your Visual Basic exe file, if any.")
 177 ;; KJW Provide for my preference in if statements
 178 (defvar visual-basic-allow-single-line-if nil
 179   "*Whether to allow single line if")
 180
 181
 182 (defvar visual-basic-defn-templates
 183   (list "Public Sub ()\nEnd Sub\n\n"
 184         "Public Function () As Variant\nEnd Function\n\n"
 185         "Public Property Get ()\nEnd Property\n\n")
 186   "*List of function templates though which visual-basic-new-sub cycles.")
 187
 188 (defvar visual-basic-imenu-generic-expression
 189    '((nil "^\\s-*\\(public\\|private\\)*\\s-+\\(declare\\s-+\\)*\\(sub\\|function\\)\\s-+\\(\\sw+\\>\\)"
 190          4)
 191     ("Constants"
 192      "^\\s-*\\(private\\|public\\|global\\)*\\s-*\\(const\\s-+\\)\\(\\sw+\\>\\s-*=\\s-*.+\\)$\\|'"
 193      3)
 194     ("Variables"
 195      "^\\(private\\|public\\|global\\|dim\\)+\\s-+\\(\\sw+\\>\\s-+as\\s-+\\sw+\\>\\)"
 196      2)
 197     ("Types" "^\\(public\\s-+\\)*type\\s-+\\(\\sw+\\)" 2)))
 198
 199
 200
 201 (defvar visual-basic-mode-syntax-table nil)
 202 (if visual-basic-mode-syntax-table
 203     ()
 204   (setq visual-basic-mode-syntax-table (make-syntax-table))
 205   (modify-syntax-entry ?\' "\<" visual-basic-mode-syntax-table) ; Comment starter
 206   (modify-syntax-entry ?\n ">" visual-basic-mode-syntax-table)
 207   (modify-syntax-entry ?\\ "w" visual-basic-mode-syntax-table)
 208   (modify-syntax-entry ?\= "." visual-basic-mode-syntax-table)
 209   (modify-syntax-entry ?\< "." visual-basic-mode-syntax-table)
 210   (modify-syntax-entry ?\> "." visual-basic-mode-syntax-table)) ; Make =, etc., punctuation so that dynamic abbreviations work properly
 211
 212
 213 (defvar visual-basic-mode-map nil)
 214 (if visual-basic-mode-map
 215     ()
 216   (setq visual-basic-mode-map (make-sparse-keymap))
 217   (define-key visual-basic-mode-map "\t" 'visual-basic-indent-line)
 218   (define-key visual-basic-mode-map "\r" 'visual-basic-newline-and-indent)
 219   (define-key visual-basic-mode-map "\M-\C-a" 'visual-basic-beginning-of-defun)
 220   (define-key visual-basic-mode-map "\M-\C-e" 'visual-basic-end-of-defun)
 221   (define-key visual-basic-mode-map "\M-\C-h" 'visual-basic-mark-defun)
 222   (define-key visual-basic-mode-map "\M-\C-\\" 'visual-basic-indent-region)
 223   (define-key visual-basic-mode-map "\M-q" 'visual-basic-fill-or-indent)
 224   (define-key visual-basic-mode-map "\M-\C-j" 'visual-basic-split-line)
 225    (cond (visual-basic-winemacs-p
 226          (define-key visual-basic-mode-map '(control C) 'visual-basic-start-ide))
 227         (visual-basic-win32-p
 228          (define-key visual-basic-mode-map (read "[?\\S-\\C-c]") 'visual-basic-start-ide)))
 229   (if visual-basic-xemacs-p
 230       (progn
 231         (define-key visual-basic-mode-map "\M-G" 'visual-basic-grep)
 232         (define-key visual-basic-mode-map '(meta backspace) 'backward-kill-word)
 233         (define-key visual-basic-mode-map '(control meta /) 'visual-basic-new-sub))))
 234
 235
 236 ;; These abbrevs are valid only in a code context.
 237 (defvar visual-basic-mode-abbrev-table nil)
 238
 239 (defvar visual-basic-mode-hook ())
 240
 241
 242 ;; Is there a way to case-fold all regexp matches?
 243 ;; Change KJW Add enum, , change matching from 0 or more to zero or one for public etc.
 244 (eval-and-compile
 245   (defconst visual-basic-defun-start-regexp
 246     (concat
 247      "^[ \t]*\\([Pp]ublic \\|[Pp]rivate \\|[Ss]tatic\\|[Ff]riend \\)?"
 248      "\\([Ss]ub\\|[Ff]unction\\|[Pp]roperty +[GgSsLl]et\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)"
 249      "[ \t]+\\(\\w+\\)[ \t]*(?")))
 250
 251
 252 (defconst visual-basic-defun-end-regexp
 253   "^[ \t]*[Ee]nd \\([Ss]ub\\|[Ff]unction\\|[Pp]roperty\\|[Tt]ype\\|[Ee]num\\|[Cc]lass\\)")
 254
 255
 256 ;; Includes the compile-time #if variation.
 257 ;; KJW fixed if to require a whitespace so as to avoid matching, for
 258 ;; instance, iFileName and to require then.
 259
 260 ;; Two versions; one recognizes single line if just as though it were
 261 ;; a multi-line and the other does not.  Modified again to remove the
 262 ;; requirement for then so as to allow it to match if statements that
 263 ;; have continuations.
 264 ;;(defconst visual-basic-if-regexp
 265 ;;   "^[ \t]*#?[Ii]f[ \t]+.*[ \t]+[Tt]hen[ \t]*.*\\('\\|$\\)")
 266 (defconst visual-basic-if-regexp
 267    "^[ \t]*#?[Ii]f[ \t]+.*[ \t_]+")
 268
 269 (defconst visual-basic-ifthen-regexp "^[ \t]*#?[Ii]f.+\\<[Tt]hen\\>\\s-\\S-+")
 270
 271 (defconst visual-basic-else-regexp "^[ \t]*#?[Ee]lse\\([Ii]f\\)?")
 272 (defconst visual-basic-endif-regexp "[ \t]*#?[Ee]nd[ \t]*[Ii]f")
 273
 274 (defconst visual-basic-continuation-regexp "^.*\_[ \t]*$")
 275 (eval-and-compile
 276   (defconst visual-basic-label-regexp "^[ \t]*[a-zA-Z0-9_]+:$"))
 277
 278 (defconst visual-basic-select-regexp "^[ \t]*[Ss]elect[ \t]+[Cc]ase")
 279 (defconst visual-basic-case-regexp "^[ \t]*[Cc]ase")
 280 (defconst visual-basic-select-end-regexp "^[ \t]*[Ee]nd[ \t]+[Ss]elect")
 281
 282
 283 (defconst visual-basic-for-regexp "^[ \t]*[Ff]or\\b")
 284 (defconst visual-basic-next-regexp "^[ \t]*[Nn]ext\\b")
 285
 286 (defconst visual-basic-do-regexp "^[ \t]*[Dd]o\\b")
 287 (defconst visual-basic-loop-regexp "^[ \t]*[Ll]oop\\b")
 288
 289 (defconst visual-basic-while-regexp "^[ \t]*[Ww]hile\\b")
 290 (defconst visual-basic-wend-regexp "^[ \t]*[Ww]end\\b")
 291
 292 ;; Added KJW Begin..end for forms
 293 (defconst visual-basic-begin-regexp "^[ \t]*[Bb]egin)?")
 294 ;; This has created a bug.  End on its own in code should not outdent.
 295 ;; How can we fix this?  They are used in separate Lisp expressions so
 296 ;; add another one.
 297 (defconst visual-basic-end-begin-regexp "^[ \t]*[Ee]nd")
 298
 299 (defconst visual-basic-with-regexp "^[ \t]*[Ww]ith\\b")
 300 (defconst visual-basic-end-with-regexp "^[ \t]*[Ee]nd[ \t]+[Ww]ith\\b")
 301
 302 (defconst visual-basic-blank-regexp "^[ \t]*$")
 303 (defconst visual-basic-comment-regexp "^[ \t]*\\s<.*$")
 304
 305
 306 ;; This is some approximation of the set of reserved words in Visual Basic.
 307 (eval-and-compile
 308   (defvar visual-basic-all-keywords
 309   '("Add" "Aggregate" "And" "App" "AppActivate" "Application" "Array" "As"
 310     "Asc" "AscB" "Atn" "Attribute"
 311     "Beep" "Begin" "BeginTrans" "Boolean" "ByVal" "ByRef"
 312     "CBool" "CByte" "CCur"
 313     "CDate" "CDbl" "CInt" "CLng" "CSng" "CStr" "CVErr" "CVar" "Call"
 314     "Case" "ChDir" "ChDrive" "Character" "Choose" "Chr" "ChrB" "Class"
 315     "ClassModule" "Clipboard" "Close" "Collection" "Column" "Columns"
 316     "Command" "CommitTrans" "CompactDatabase" "Component" "Components"
 317     "Const" "Container" "Containers" "Cos" "CreateDatabase" "CreateObject"
 318     "CurDir" "Currency"
 319     "DBEngine" "DDB" "Data" "Database" "Databases"
 320     "Date" "DateAdd" "DateDiff" "DatePart" "DateSerial" "DateValue" "Day"
 321     "Debug" "Declare" "Deftype" "DeleteSetting" "Dim" "Dir" "Do"
 322     "DoEvents" "Domain"
 323     "Double" "Dynaset" "EOF" "Each" "Else" "End" "EndProperty"
 324     "Enum" "Environ" "Erase" "Err" "Error" "Exit" "Exp" "FV" "False" "Field"
 325     "Fields" "FileAttr" "FileCopy" "FileDateTime" "FileLen" "Fix" "Font" "For"
 326     "Form" "FormTemplate" "Format" "Forms" "FreeFile" "FreeLocks" "Friend"
 327     "Function"
 328     "Get" "GetAllSettings" "GetAttr" "GetObject" "GetSetting" "Global" "GoSub"
 329     "GoTo" "Group" "Groups" "Hex" "Hour" "IIf" "IMEStatus" "IPmt" "IRR"
 330     "If" "Implements" "InStr" "Input" "Int" "Integer" "Is" "IsArray" "IsDate"
 331     "IsEmpty" "IsError" "IsMissing" "IsNull" "IsNumeric" "IsObject" "Kill"
 332     "LBound" "LCase" "LOF" "LSet" "LTrim" "Left" "Len" "Let" "Like" "Line"
 333     "Load" "LoadPicture" "LoadResData" "LoadResPicture" "LoadResString" "Loc"
 334     "Lock" "Log" "Long" "Loop" "MDIForm" "MIRR" "Me" "MenuItems"
 335     "MenuLine" "Mid" "Minute" "MkDir" "Month" "MsgBox" "NPV" "NPer" "Name"
 336     "New" "Next" "Not" "Now" "Nothing" "Null" "Object" "Oct" "On" "Open"
 337     "OpenDatabase"
 338     "Operator" "Option" "Optional"
 339     "Or" "PPmt" "PV" "Parameter" "Parameters" "Partition"
 340     "Picture" "Pmt" "Print" "Printer" "Printers" "Private" "ProjectTemplate"
 341     "Property"
 342     "Properties" "Public" "Put" "QBColor" "QueryDef" "QueryDefs"
 343     "RSet" "RTrim" "Randomize" "Rate" "ReDim" "Recordset" "Recordsets"
 344     "RegisterDatabase" "Relation" "Relations" "Rem" "RepairDatabase"
 345     "Reset" "Resume" "Return" "Right" "RmDir" "Rnd" "Rollback" "RowBuffer"
 346     "SLN" "SYD" "SavePicture" "SaveSetting" "Screen" "Second" "Seek"
 347     "SelBookmarks" "Select" "SelectedComponents" "SendKeys" "Set"
 348     "SetAttr" "SetDataAccessOption" "SetDefaultWorkspace" "Sgn" "Shell"
 349     "Sin" "Single" "Snapshot" "Space" "Spc" "Sqr" "Static" "Step" "Stop" "Str"
 350     "StrComp" "StrConv" "String" "Sub" "SubMenu" "Switch" "Tab" "Table"
 351     "TableDef" "TableDefs" "Tan" "Then" "Time" "TimeSerial" "TimeValue"
 352     "Timer" "To" "Trim" "True" "Type" "TypeName" "UBound" "UCase" "Unload"
 353     "Unlock" "Val" "Variant" "VarType" "Verb" "Weekday" "Wend"
 354     "While" "Width" "With" "Workspace" "Workspaces" "Write" "Year")))
 355
 356 (defvar visual-basic-font-lock-keywords-1
 357   (eval-when-compile
 358     (list
 359      ;; Names of functions.
 360      (list visual-basic-defun-start-regexp
 361            '(1 font-lock-keyword-face nil t)
 362            '(2 font-lock-keyword-face nil t)
 363            '(3 font-lock-function-name-face))
 364
 365      ;; Statement labels
 366      (cons visual-basic-label-regexp 'font-lock-keyword-face)
 367
 368      ;; Case values
 369      ;; String-valued cases get font-lock-string-face regardless.
 370      (list "^[ \t]*case[ \t]+\\([^'\n]+\\)" 1 'font-lock-keyword-face t)
 371
 372      ;; Any keywords you like.
 373      (list (concat "\\<" (regexp-opt
 374                           '("Dim" "If" "Then" "Else" "ElseIf" "End If") t)
 375                    "\\>")
 376            1 'font-lock-keyword-face))))
 377
 378 (defvar visual-basic-font-lock-keywords-2
 379   (append visual-basic-font-lock-keywords-1
 380           (eval-when-compile
 381             `((,(concat "\\<" (regexp-opt visual-basic-all-keywords t) "\\>")
 382                    1 font-lock-keyword-face)))))
 383
 384 (defvar visual-basic-font-lock-keywords visual-basic-font-lock-keywords-1)
 385
 386
 387 (put 'visual-basic-mode 'font-lock-keywords 'visual-basic-font-lock-keywords)
 388
 389 (defun visual-basic-mode ()
 390   "A mode for editing Microsoft Visual Basic programs.
 391 Features automatic indentation, font locking, keyword capitalization,
 392 and some minor convenience functions.
 393 Commands:
 394 \\{visual-basic-mode-map}"
 395   (interactive)
 396   (kill-all-local-variables)
 397   (use-local-map visual-basic-mode-map)
 398   (setq major-mode 'visual-basic-mode)
 399   (setq mode-name "Visual Basic")
 400   (set-syntax-table visual-basic-mode-syntax-table)
 401
 402   (add-hook 'local-write-file-hooks 'visual-basic-untabify)
 403
 404   (setq local-abbrev-table visual-basic-mode-abbrev-table)
 405   (if visual-basic-capitalize-keywords-p
 406       (progn
 407         (make-local-variable 'pre-abbrev-expand-hook)
 408         (add-hook 'pre-abbrev-expand-hook 'visual-basic-pre-abbrev-expand-hook)
 409         (abbrev-mode 1)))
 410
 411   (make-local-variable 'comment-start)
 412   (setq comment-start "' ")
 413   (make-local-variable 'comment-start-skip)
 414   (setq comment-start-skip "'+ *")
 415   (make-local-variable 'comment-column)
 416   (setq comment-column 40)
 417   (make-local-variable 'comment-end)
 418   (setq comment-end "")
 419
 420   (make-local-variable 'indent-line-function)
 421   (setq indent-line-function 'visual-basic-indent-line)
 422
 423   (if visual-basic-fontify-p
 424       (visual-basic-enable-font-lock))
 425
 426   (make-local-variable 'imenu-generic-expression)
 427   (setq imenu-generic-expression visual-basic-imenu-generic-expression)
 428
 429   (set (make-local-variable 'imenu-syntax-alist) `((,(string-to-char "_") . "w")))
 430   (set (make-local-variable 'imenu-case-fold-search) t)
 431
 432   ;;(make-local-variable 'visual-basic-associated-files)
 433   ;; doing this here means we need not check to see if it is bound later.
 434   (add-hook 'find-file-hooks 'visual-basic-load-associated-files)
 435
 436   (run-hooks 'visual-basic-mode-hook))
 437
 438
 439 (defun visual-basic-enable-font-lock ()
 440   ;; Emacs 19.29 requires a window-system else font-lock-mode errs out.
 441   (cond ((or visual-basic-xemacs-p window-system)
 442
 443          ;; In win-emacs this sets font-lock-keywords back to nil!
 444          (if visual-basic-winemacs-p
 445              (font-lock-mode 1))
 446
 447          ;; Accomodate emacs 19.29+
 448          ;; From: Simon Marshall <Simon.Marshall@esrin.esa.it>
 449          (cond ((boundp 'font-lock-defaults)
 450                 (make-local-variable 'font-lock-defaults)
 451                 (setq font-lock-defaults
 452                       `((visual-basic-font-lock-keywords
 453                          visual-basic-font-lock-keywords-1
 454                          visual-basic-font-lock-keywords-2)
 455                         nil t ((,(string-to-char "_") . "w")))))
 456                (t
 457                 (make-local-variable 'font-lock-keywords)
 458                 (setq font-lock-keywords visual-basic-font-lock-keywords)))
 459
 460          (if visual-basic-winemacs-p
 461              (font-lock-fontify-buffer)
 462            (font-lock-mode 1)))))
 463
 464 ;; KJW should add some odds and bobs here to cover "end if" one way
 465 ;; could be to create the abbreviations by removing whitespace then we
 466 ;; could put "end if", "end with" and so on in the keyword table
 467 ;; Another idea would be to make it intelligent enough to substitute
 468 ;; the correct end for the construct (with, select, if)
 469 ;; Is this what the abbrev table hook entry is for?
 470 (defun visual-basic-construct-keyword-abbrev-table ()
 471   (if visual-basic-mode-abbrev-table
 472       nil
 473     (let ((words visual-basic-all-keywords)
 474           (word nil)
 475           (list nil))
 476       (while words
 477         (setq word (car words)
 478               words (cdr words))
 479         (setq list (cons (list (downcase word) word) list)))
 480
 481       (define-abbrev-table 'visual-basic-mode-abbrev-table list))))
 482
 483 ;; Would like to do this at compile-time.
 484 (visual-basic-construct-keyword-abbrev-table)
 485
 486
 487 (defun visual-basic-in-code-context-p ()
 488   (if (fboundp 'buffer-syntactic-context) ; XEmacs function.
 489       (null (buffer-syntactic-context))
 490     ;; Attempt to simulate buffer-syntactic-context
 491     ;; I don't know how reliable this is.
 492     (let* ((beg (save-excursion
 493                   (beginning-of-line)
 494                   (point)))
 495            (list
 496             (parse-partial-sexp beg (point))))
 497       (and (null (nth 3 list))          ; inside string.
 498            (null (nth 4 list))))))      ; inside comment
 499
 500
 501 (defun visual-basic-pre-abbrev-expand-hook ()
 502   ;; Allow our abbrevs only in a code context.
 503   (setq local-abbrev-table
 504         (if (visual-basic-in-code-context-p)
 505             visual-basic-mode-abbrev-table)))
 506
 507
 508 (defun visual-basic-newline-and-indent (&optional count)
 509   "Insert a newline, updating indentation."
 510   (interactive)
 511   (expand-abbrev)
 512   (save-excursion
 513     (visual-basic-indent-line))
 514   (call-interactively 'newline-and-indent))
 515
 516 (defun visual-basic-beginning-of-defun ()
 517   (interactive)
 518   (re-search-backward visual-basic-defun-start-regexp))
 519
 520 (defun visual-basic-end-of-defun ()
 521   (interactive)
 522   (re-search-forward visual-basic-defun-end-regexp))
 523
 524 (defun visual-basic-mark-defun ()
 525   (interactive)
 526   (beginning-of-line)
 527   (visual-basic-end-of-defun)
 528   (set-mark (point))
 529   (visual-basic-beginning-of-defun)
 530   (if visual-basic-xemacs-p
 531       (zmacs-activate-region)))
 532
 533 (defun visual-basic-indent-defun ()
 534   (interactive)
 535   (save-excursion
 536     (visual-basic-mark-defun)
 537     (call-interactively 'visual-basic-indent-region)))
 538
 539
 540 (defun visual-basic-fill-long-comment ()
 541   "Fills block of comment lines around point."
 542   ;; Derived from code in ilisp-ext.el.
 543   (interactive)
 544   (save-excursion
 545     (beginning-of-line)
 546     (let ((comment-re "^[ \t]*\\s<+[ \t]*"))
 547       (if (looking-at comment-re)
 548           (let ((fill-prefix
 549                  (buffer-substring
 550                   (progn (beginning-of-line) (point))
 551                   (match-end 0))))
 552
 553             (while (and (not (bobp))
 554                         (looking-at visual-basic-comment-regexp))
 555               (forward-line -1))
 556             (if (not (bobp)) (forward-line 1))
 557
 558             (let ((start (point)))
 559
 560               ;; Make all the line prefixes the same.
 561               (while (and (not (eobp))
 562                           (looking-at comment-re))
 563                 (replace-match fill-prefix)
 564                 (forward-line 1))
 565
 566               (if (not (eobp))
 567                   (beginning-of-line))
 568
 569               ;; Fill using fill-prefix
 570               (fill-region-as-paragraph start (point))))))))
 571
 572
 573 (defun visual-basic-fill-or-indent ()
 574   "Fill long comment around point, if any, else indent current definition."
 575   (interactive)
 576   (cond ((save-excursion
 577            (beginning-of-line)
 578            (looking-at visual-basic-comment-regexp))
 579          (visual-basic-fill-long-comment))
 580         (t
 581          (visual-basic-indent-defun))))
 582
 583
 584 (defun visual-basic-new-sub ()
 585   "Insert template for a new subroutine.  Repeat to cycle through alternatives."
 586   (interactive)
 587   (beginning-of-line)
 588   (let ((templates (cons visual-basic-blank-regexp
 589                          visual-basic-defn-templates))
 590         (tem nil)
 591         (bound (point)))
 592     (while templates
 593       (setq tem (car templates)
 594             templates (cdr templates))
 595       (cond ((looking-at tem)
 596              (replace-match (or (car templates)
 597                                 ""))
 598              (setq templates nil))))
 599
 600     (search-backward "()" bound t)))
 601
 602
 603 (defun visual-basic-untabify ()
 604   "Do not allow any tabs into the file."
 605   (if (eq major-mode 'visual-basic-mode)
 606       (untabify (point-min) (point-max)))
 607   nil)
 608
 609 (defun visual-basic-default-tag ()
 610   (if (and (not (bobp))
 611            (save-excursion
 612              (backward-sexp)
 613              (looking-at "\\w")))
 614       (backward-word 1))
 615   (let ((s (point))
 616         (e (save-excursion
 617              (forward-sexp)
 618              (point))))
 619     (buffer-substring s e)))
 620
 621 (defun visual-basic-grep (tag)
 622   "Search BASIC source files in current directory for TAG."
 623   (interactive
 624    (list (let* ((def (visual-basic-default-tag))
 625                 (tag (read-string
 626                       (format "Grep for [%s]: " def))))
 627            (if (string= tag "") def tag))))
 628   (grep (format "grep -n %s %s" tag visual-basic-wild-files)))
 629
 630
 631 ;;; IDE Connection.
 632
 633 (defun visual-basic-buffer-project-file ()
 634   "Return a guess as to the project file associated with the current buffer."
 635   (car (directory-files (file-name-directory (buffer-file-name)) t "\\.vbp")))
 636
 637 (defun visual-basic-start-ide ()
 638   "Start Visual Basic (or your favorite IDE, (after Emacs, of course))
 639 on the first project file in the current directory.
 640 Note: it's not a good idea to leave Visual Basic running while you
 641 are editing in Emacs, since Visual Basic has no provision for reloading
 642 changed files."
 643   (interactive)
 644   (let (file)
 645     (cond ((null visual-basic-ide-pathname)
 646            (error "No pathname set for Visual Basic.  See visual-basic-ide-pathname"))
 647           ((null (setq file (visual-basic-buffer-project-file)))
 648            (error "No project file found"))
 649           ((fboundp 'win-exec)
 650            (iconify-emacs)
 651            (win-exec visual-basic-ide-pathname 'win-show-normal file))
 652           ((fboundp 'start-process)
 653            (iconify-frame (selected-frame))
 654            (start-process "*VisualBasic*" nil visual-basic-ide-pathname file))
 655           (t
 656            (error "No way to spawn process!")))))
 657
 658
 659
 660 ;;; Indentation-related stuff.
 661
 662 (defun visual-basic-indent-region (start end)
 663   "Perform visual-basic-indent-line on each line in region."
 664   (interactive "r")
 665   (save-excursion
 666     (goto-char start)
 667     (beginning-of-line)
 668     (while (and (not (eobp))
 669                 (< (point) end))
 670       (if (not (looking-at visual-basic-blank-regexp))
 671           (visual-basic-indent-line))
 672       (forward-line 1)))
 673
 674   (cond ((fboundp 'zmacs-deactivate-region)
 675          (zmacs-deactivate-region))
 676         ((fboundp 'deactivate-mark)
 677          (deactivate-mark))))
 678
 679
 680
 681 (defun visual-basic-previous-line-of-code ()
 682   (if (not (bobp))
 683       (forward-line -1))        ; previous-line depends on goal column
 684   (while (and (not (bobp))
 685               (or (looking-at visual-basic-blank-regexp)
 686                   (looking-at visual-basic-comment-regexp)))
 687     (forward-line -1)))
 688
 689
 690 (defun visual-basic-find-original-statement ()
 691   "If the current line is a continuation, move back to the original stmt."
 692   (let ((here (point)))
 693     (visual-basic-previous-line-of-code)
 694     (while (and (not (bobp))
 695                 (looking-at visual-basic-continuation-regexp))
 696       (setq here (point))
 697       (visual-basic-previous-line-of-code))
 698     (goto-char here)))
 699
 700 (defun visual-basic-find-matching-stmt (open-regexp close-regexp)
 701   ;; Searching backwards
 702   (let ((level 0))
 703     (while (and (>= level 0) (not (bobp)))
 704       (visual-basic-previous-line-of-code)
 705       (visual-basic-find-original-statement)
 706       (cond ((looking-at close-regexp)
 707              (setq level (+ level 1)))
 708             ((looking-at open-regexp)
 709              (setq level (- level 1)))))))
 710
 711 (defun visual-basic-find-matching-if ()
 712   (visual-basic-find-matching-stmt visual-basic-if-regexp
 713                                    visual-basic-endif-regexp))
 714
 715 (defun visual-basic-find-matching-select ()
 716   (visual-basic-find-matching-stmt visual-basic-select-regexp
 717                                    visual-basic-select-end-regexp))
 718
 719 (defun visual-basic-find-matching-for ()
 720   (visual-basic-find-matching-stmt visual-basic-for-regexp
 721                                    visual-basic-next-regexp))
 722
 723 (defun visual-basic-find-matching-do ()
 724   (visual-basic-find-matching-stmt visual-basic-do-regexp
 725                                    visual-basic-loop-regexp))
 726
 727 (defun visual-basic-find-matching-while ()
 728   (visual-basic-find-matching-stmt visual-basic-while-regexp
 729                                    visual-basic-wend-regexp))
 730
 731 (defun visual-basic-find-matching-with ()
 732   (visual-basic-find-matching-stmt visual-basic-with-regexp
 733                                    visual-basic-end-with-regexp))
 734
 735 ;;; If this fails it must return the indent of the line preceding the
 736 ;;; end not the first line because end without matching begin is a
 737 ;;; normal simple statement
 738 (defun visual-basic-find-matching-begin ()
 739   (let ((original-point (point)))
 740     (visual-basic-find-matching-stmt visual-basic-begin-regexp
 741                                      visual-basic-end-begin-regexp)
 742     (if (bobp) ;failed to find a matching begin so assume that it is
 743                ;an end statement instead and use the indent of the
 744                ;preceding line.
 745         (progn (goto-char original-point)
 746                (visual-basic-previous-line-of-code)))))
 747
 748
 749 (defun visual-basic-calculate-indent ()
 750   (let ((original-point (point)))
 751     (save-excursion
 752       (beginning-of-line)
 753       ;; Some cases depend only on where we are now.
 754       (cond ((or (looking-at visual-basic-defun-start-regexp)
 755                  (looking-at visual-basic-label-regexp)
 756                  (looking-at visual-basic-defun-end-regexp))
 757              0)
 758
 759             ;; The outdenting stmts, which simply match their original.
 760             ((or (looking-at visual-basic-else-regexp)
 761                  (looking-at visual-basic-endif-regexp))
 762              (visual-basic-find-matching-if)
 763              (current-indentation))
 764
 765             ;; All the other matching pairs act alike.
 766             ((looking-at visual-basic-next-regexp) ; for/next
 767              (visual-basic-find-matching-for)
 768              (current-indentation))
 769
 770             ((looking-at visual-basic-loop-regexp) ; do/loop
 771              (visual-basic-find-matching-do)
 772              (current-indentation))
 773
 774             ((looking-at visual-basic-wend-regexp) ; while/wend
 775              (visual-basic-find-matching-while)
 776              (current-indentation))
 777
 778             ((looking-at visual-basic-end-with-regexp) ; with/end with
 779              (visual-basic-find-matching-with)
 780              (current-indentation))
 781
 782             ((looking-at visual-basic-select-end-regexp) ; select case/end select
 783              (visual-basic-find-matching-select)
 784              (current-indentation))
 785
 786             ;; A case of a select is somewhat special.
 787             ((looking-at visual-basic-case-regexp)
 788              (visual-basic-find-matching-select)
 789              (+ (current-indentation) visual-basic-mode-indent))
 790
 791             ;; Added KJW: Make sure that this comes after the cases
 792             ;; for if..endif, end select because end-regexp will also
 793             ;; match "end select" etc.
 794             ((looking-at visual-basic-end-begin-regexp) ; begin/end
 795              (visual-basic-find-matching-begin)
 796              (current-indentation))
 797
 798             (t
 799              ;; Other cases which depend on the previous line.
 800              (visual-basic-previous-line-of-code)
 801
 802              ;; Skip over label lines, which always have 0 indent.
 803              (while (looking-at visual-basic-label-regexp)
 804                (visual-basic-previous-line-of-code))
 805
 806              (cond
 807               ((looking-at visual-basic-continuation-regexp)
 808                (visual-basic-find-original-statement)
 809                ;; Indent continuation line under matching open paren,
 810                ;; or else one word in.
 811                (let* ((orig-stmt (point))
 812                       (matching-open-paren
 813                        (condition-case ()
 814                            (save-excursion
 815                              (goto-char original-point)
 816                              (beginning-of-line)
 817                              (backward-up-list 1)
 818                              ;; Only if point is now w/in cont. block.
 819                              (if (<= orig-stmt (point))
 820                                  (current-column)))
 821                          (error nil))))
 822                  (cond (matching-open-paren
 823                         (1+ matching-open-paren))
 824                        (t
 825                         ;; Else, after first word on original line.
 826                         (back-to-indentation)
 827                         (forward-word 1)
 828                         (while (looking-at "[ \t]")
 829                           (forward-char 1))
 830                         (current-column)))))
 831               (t
 832                (visual-basic-find-original-statement)
 833
 834                (let ((indent (current-indentation)))
 835                  ;; All the various +indent regexps.
 836                  (cond ((looking-at visual-basic-defun-start-regexp)
 837                         (+ indent visual-basic-mode-indent))
 838
 839                        ((and (or (looking-at visual-basic-if-regexp)
 840                                  (looking-at visual-basic-else-regexp))
 841                              (not (and visual-basic-allow-single-line-if
 842                                        (looking-at visual-basic-ifthen-regexp))))
 843                         (+ indent visual-basic-mode-indent))
 844
 845                        ((or (looking-at visual-basic-select-regexp)
 846                             (looking-at visual-basic-case-regexp))
 847                         (+ indent visual-basic-mode-indent))
 848
 849                        ((or (looking-at visual-basic-do-regexp)
 850                             (looking-at visual-basic-for-regexp)
 851                             (looking-at visual-basic-while-regexp)
 852                             (looking-at visual-basic-with-regexp)
 853                             (looking-at visual-basic-begin-regexp))
 854                         (+ indent visual-basic-mode-indent))
 855
 856                        (t
 857                         ;; By default, just copy indent from prev line.
 858                         indent))))))))))
 859
 860 (defun visual-basic-indent-to-column (col)
 861   (let* ((bol (save-excursion
 862                 (beginning-of-line)
 863                 (point)))
 864          (point-in-whitespace
 865           (<= (point) (+ bol (current-indentation))))
 866          (blank-line-p
 867           (save-excursion
 868             (beginning-of-line)
 869             (looking-at visual-basic-blank-regexp))))
 870
 871     (cond ((/= col (current-indentation))
 872            (save-excursion
 873              (beginning-of-line)
 874              (back-to-indentation)
 875              (delete-region bol (point))
 876              (indent-to col))))
 877
 878     ;; If point was in the whitespace, move back-to-indentation.
 879     (cond (blank-line-p
 880            (end-of-line))
 881           (point-in-whitespace
 882            (back-to-indentation)))))
 883
 884
 885 (defun visual-basic-indent-line ()
 886   "Indent current line for BASIC."
 887   (interactive)
 888   (visual-basic-indent-to-column (visual-basic-calculate-indent)))
 889
 890
 891 (defun visual-basic-split-line ()
 892   "Split line at point, adding continuation character or continuing a comment.
 893 In Abbrev mode, any abbrev before point will be expanded."
 894   (interactive)
 895   (let ((pps-list (parse-partial-sexp (save-excursion
 896                                         (beginning-of-line)
 897                                         (point))
 898                                       (point))))
 899     ;; Dispatch on syntax at this position.
 900     (cond ((equal t (nth 4 pps-list))  ; in comment
 901            (indent-new-comment-line))
 902           ((equal t (nth 4 pps-list))   ; in string
 903            (error "Can't break line inside a string"))
 904           (t (just-one-space)           ; leading space on next line
 905                                         ; doesn't count, sigh
 906              (insert "_")
 907              (visual-basic-newline-and-indent)))))
 908
 909 (provide 'visual-basic-mode)
 910
 911
 912 ;;; Some experimental functions
 913
 914 ;;; Load associated files listed in the file local variables block
 915 (defun visual-basic-load-associated-files ()
 916   "Load files that are useful to have around when editing the source of the file that has just been loaded.
 917 The file must have a local variable that lists the files to be loaded.
 918 If the file name is relative it is relative to the directory
 919 containing the current buffer.  If the file is already loaded nothing
 920 happens, this prevents circular references causing trouble.  After an
 921 associated file is loaded its associated files list will be
 922 processed."
 923   (if (boundp 'visual-basic-associated-files)
 924       (let ((files visual-basic-associated-files)
 925             (file nil))
 926         (while files
 927           (setq file (car files)
 928                 files (cdr files))
 929           (message "Load associated file: %s" file)
 930           (visual-basic-load-file-ifnotloaded file default-directory)))))
 931
 932
 933
 934 (defun visual-basic-load-file-ifnotloaded (file default-directory)
 935   "Load file if not already loaded.
 936 If file is relative then default-directory provides the path"
 937   (let((file-absolute (expand-file-name file default-directory)))
 938     (if (get-file-buffer file-absolute); don't do anything if the buffer is already loaded
 939         ()
 940       (find-file-noselect file-absolute ))))
 941
 942
 943
 944 ;;; visual-basic-mode.el ends here