Christopher Piro | 094823a | 2007-07-18 00:26:12 +0000 | [diff] [blame] | 1 | ;; $Id: erlang.el,v 1.21 2004/08/03 20:38:43 mlogan Exp $ |
| 2 | ;; erlang.el --- Major modes for editing and running Erlang |
| 3 | |
| 4 | ;; Copyright (C) 1995-1998,2000 Ericsson Telecom AB |
| 5 | |
| 6 | ;; Author: Anders Lindgren |
| 7 | ;; Version: 2.4 |
| 8 | ;; Keywords: erlang, languages, processes |
| 9 | ;; Date: 2000-09-11 |
| 10 | |
| 11 | ;; Lars Thorsén's modifications of 2000-06-07 included. |
| 12 | |
| 13 | ;; The original version of this package was written by Robert Virding. |
| 14 | ;; |
| 15 | ;; Most skeletons has been written at Ericsson Telecom by |
| 16 | ;; magnus@erix.ericsson.se and janne@erix.ericsson.se |
| 17 | |
| 18 | ;;; Commentary: |
| 19 | |
| 20 | ;; Introduction: |
| 21 | ;; ------------ |
| 22 | ;; |
| 23 | ;; This package provides support for the programming language Erlang. |
| 24 | ;; The package provides an editing mode with lots of bells and |
| 25 | ;; whistles, compilation support, and it makes it possible for the |
| 26 | ;; user to start Erlang shells that run inside Emacs. |
| 27 | ;; |
| 28 | ;; See the Erlang distribution for full documentation of this package. |
| 29 | |
| 30 | ;; Installation: |
| 31 | ;; ------------ |
| 32 | ;; |
| 33 | ;; Place this file in Emacs load path, byte-compile it, and add the |
| 34 | ;; following line to the appropriate init file: |
| 35 | ;; |
| 36 | ;; (require 'erlang-start) |
| 37 | ;; |
| 38 | ;; The full documentation contains much more extensive description of |
| 39 | ;; the installation procedure. |
| 40 | |
| 41 | ;; Reporting Bugs: |
| 42 | ;; -------------- |
| 43 | ;; |
| 44 | ;; Please send bug reports to the following email address: |
| 45 | ;; support@erlang.ericsson.se |
| 46 | ;; |
| 47 | ;; Please state as exactly as possible: |
| 48 | ;; - Version number of Erlang Mode (see the menu), Emacs, Erlang, |
| 49 | ;; and of any other relevant software. |
| 50 | ;; - What the expected result was. |
| 51 | ;; - What you did, preferably in a repeatable step-by-step form. |
| 52 | ;; - A description of the unexpected result. |
| 53 | ;; - Relevant pieces of Erlang code causing the problem. |
| 54 | ;; - Personal Emacs customisations, if any. |
| 55 | ;; |
| 56 | ;; Should the Emacs generate an error, please set the emacs variable |
| 57 | ;; `debug-on-error' to `t'. Repeat the error and enclose the debug |
| 58 | ;; information in your bug-report. |
| 59 | ;; |
| 60 | ;; To set the variable you can use the following command: |
| 61 | ;; M-x set-variable RET debug-on-error RET t RET |
| 62 | |
| 63 | ;;; Code: |
| 64 | |
| 65 | ;; Variables: |
| 66 | |
| 67 | (defconst erlang-version "2.4" |
| 68 | "The version number of Erlang mode.") |
| 69 | |
| 70 | (defvar erlang-root-dir nil |
| 71 | "The directory where the Erlang system is installed. |
| 72 | The name should not contain the ending slash. |
| 73 | |
| 74 | Should this variable be nil, no manual pages will show up in the |
| 75 | Erlang mode menu.") |
| 76 | |
| 77 | (defvar erlang-menu-items '(erlang-menu-base-items |
| 78 | erlang-menu-skel-items |
| 79 | erlang-menu-shell-items |
| 80 | erlang-menu-compile-items |
| 81 | erlang-menu-man-items |
| 82 | erlang-menu-personal-items |
| 83 | erlang-menu-version-items) |
| 84 | "*List of menu item list to combine to create Erland mode menu. |
| 85 | |
| 86 | External programs which temporary adds menu items to the Erland mode |
| 87 | menu use this variable. Please use the function `add-hook' to add |
| 88 | items. |
| 89 | |
| 90 | Please call the function `erlang-menu-init' after every change to this |
| 91 | variable.") |
| 92 | |
| 93 | (defvar erlang-menu-base-items |
| 94 | '(("Indent" |
| 95 | (("Indent Line" erlang-indent-command) |
| 96 | ("Indent Region " erlang-indent-region |
| 97 | (if erlang-xemacs-p (mark) mark-active)) |
| 98 | ("Indent Clause" erlang-indent-clause) |
| 99 | ("Indent Function" erlang-indent-function) |
| 100 | ("Indent Buffer" erlang-indent-current-buffer))) |
| 101 | ("Edit" |
| 102 | (("Fill Comment" erlang-fill-paragraph) |
| 103 | ("Comment Region" comment-region |
| 104 | (if erlang-xemacs-p (mark) mark-active)) |
| 105 | ("Uncomment Region" erlang-uncomment-region |
| 106 | (if erlang-xemacs-p (mark) mark-active)) |
| 107 | nil |
| 108 | ("Beginning of Function" erlang-beginning-of-function) |
| 109 | ("End of Function" erlang-end-of-function) |
| 110 | ("Mark Function" erlang-mark-function) |
| 111 | nil |
| 112 | ("Beginning of Clause" erlang-beginning-of-clause) |
| 113 | ("End of Clause" erlang-end-of-clause) |
| 114 | ("Mark Clause" erlang-mark-clause) |
| 115 | nil |
| 116 | ("New Clause" erlang-generate-new-clause) |
| 117 | ("Clone Arguments" erlang-clone-arguments))) |
| 118 | ("Syntax Highlighting" |
| 119 | (("Level 3" erlang-font-lock-level-3) |
| 120 | ("Level 2" erlang-font-lock-level-2) |
| 121 | ("Level 1" erlang-font-lock-level-1) |
| 122 | ("Off" erlang-font-lock-level-0))) |
| 123 | ("TAGS" |
| 124 | (("Find Tag" find-tag) |
| 125 | ("Find Next Tag" erlang-find-next-tag) |
| 126 | ;("Find Regexp" find-tag-regexp) |
| 127 | ("Complete Word" erlang-complete-tag) |
| 128 | ("Tags Apropos" tags-apropos) |
| 129 | ("Search Files" tags-search)))) |
| 130 | "*Description of menu used in Erlang mode. |
| 131 | |
| 132 | This variable must be a list. The elements are either nil representing |
| 133 | a horisontal line or a list with two or three elements. The first is |
| 134 | the name of the menu item, the second is the function to call, or a |
| 135 | submenu, on the same same form as ITEMS. The third optional argument |
| 136 | is an expression which is evaluated every time the menu is displayed. |
| 137 | Should the expression evaluate to nil the menu item is ghosted. |
| 138 | |
| 139 | Example: |
| 140 | '((\"Func1\" function-one) |
| 141 | (\"SubItem\" |
| 142 | ((\"Yellow\" function-yellow) |
| 143 | (\"Blue\" function-blue))) |
| 144 | nil |
| 145 | (\"Region Funtion\" spook-function midnight-variable)) |
| 146 | |
| 147 | Call the function `erlang-menu-init' after modifying this variable.") |
| 148 | |
| 149 | (defvar erlang-menu-shell-items |
| 150 | '(nil |
| 151 | ("Shell" |
| 152 | (("Start New Shell" erlang-shell) |
| 153 | ("Display Shell" erlang-shell-display)))) |
| 154 | "*Description of the Shell menu used by Erlang mode. |
| 155 | |
| 156 | Please see the documentation of `erlang-menu-base-items'.") |
| 157 | |
| 158 | (defvar erlang-menu-compile-items |
| 159 | '(("Compile" |
| 160 | (("Compile Buffer" erlang-compile) |
| 161 | ("Display Result" erlang-compile-display) |
| 162 | ("Next Error" erlang-next-error)))) |
| 163 | "*Description of the Compile menu used by Erlang mode. |
| 164 | |
| 165 | Please see the documentation of `erlang-menu-base-items'.") |
| 166 | |
| 167 | (defvar erlang-menu-version-items |
| 168 | '(nil |
| 169 | ("Version" erlang-version)) |
| 170 | "*Description of the version menu used in Erlang mode.") |
| 171 | |
| 172 | (defvar erlang-menu-personal-items nil |
| 173 | "*Description of personal menu items used in Erlang mode. |
| 174 | |
| 175 | Please see the variable `erlang-menu-base-items' for a description |
| 176 | of the format.") |
| 177 | |
| 178 | (defvar erlang-menu-man-items nil |
| 179 | "The menu containing man pages. |
| 180 | |
| 181 | The format of the menu should be compatible with `erlang-menu-base-items'. |
| 182 | This variable is added to the list of Erlang menus stored in |
| 183 | `erlang-menu-items'.") |
| 184 | |
| 185 | (defvar erlang-menu-skel-items '() |
| 186 | "Description of the menu containing the skeleton entries. |
| 187 | The menu is in the form described by the variable `erlang-menu-base-items'.") |
| 188 | |
| 189 | (defvar erlang-mode-hook nil |
| 190 | "*Functions to run when Erlang mode is activated. |
| 191 | |
| 192 | This hook is used to change the behaviour of Erlang mode. It is |
| 193 | normally used by the user to personalise the programming environment. |
| 194 | When used in a site init file, it could be used to customise Erlang |
| 195 | mode for all users on the system. |
| 196 | |
| 197 | The functions added to this hook is runed every time Erlang mode is |
| 198 | started. See also `erlang-load-hook', a hook which is runed once, |
| 199 | when Erlang mode is loaded into Emacs, and `erlang-shell-mode-hook' |
| 200 | which is run every time a new inferior Erlang shell is started. |
| 201 | |
| 202 | To use a hook, create an Emacs lisp function to perform your actions |
| 203 | and add the function to the hook by calling `add-hook'. |
| 204 | |
| 205 | The following example binds the key sequence C-c C-c to the command |
| 206 | `erlang-compile' (normally bound to C-c C-k). The example also |
| 207 | activates Font Lock mode to fontify the buffer and adds a menu |
| 208 | containing all functions defined in the current buffer. |
| 209 | |
| 210 | To use the example, copy the following lines to your `~/.emacs' file: |
| 211 | |
| 212 | (add-hook 'erlang-mode-hook 'my-erlang-mode-hook) |
| 213 | |
| 214 | (defun my-erlang-mode-hook () |
| 215 | (local-set-key \"\\C-c\\C-c\" 'erlang-compile) |
| 216 | (if window-system |
| 217 | (progn |
| 218 | (setq font-lock-maximum-decoration t) |
| 219 | (font-lock-mode 1))) |
| 220 | (if (and window-system (fboundp 'imenu-add-to-menubar)) |
| 221 | (imenu-add-to-menubar \"Imenu\")))") |
| 222 | |
| 223 | (defvar erlang-load-hook nil |
| 224 | "*Functions to run when Erlang mode is loaded. |
| 225 | |
| 226 | This hook is used to change the behaviour of Erlang mode. It is |
| 227 | normally used by the user to personalise the programming environment. |
| 228 | When used in a site init file, it could be used to customize Erlang |
| 229 | mode for all users on the system. |
| 230 | |
| 231 | The difference between this hook and `erlang-mode-hook' and |
| 232 | `erlang-shell-mode-hook' is that the functions in this hook |
| 233 | is only called once, when the Erlang mode is loaded into Emacs |
| 234 | the first time. |
| 235 | |
| 236 | Natural actions for the functions added to this hook are actions which |
| 237 | only should be performed once, and actions which should be performed |
| 238 | before starting Erlang mode. For example, a number of variables are |
| 239 | used by Erlang mode before `erlang-mode-hook' is runed. |
| 240 | |
| 241 | The following example sets the variable `erlang-root-dir' so that the |
| 242 | manual pages can be retrieved (note that you must set the value of |
| 243 | `erlang-root-dir' to match the loation of Erlang on your system): |
| 244 | |
| 245 | (add-hook 'erlang-load-hook 'my-erlang-load-hook) |
| 246 | |
| 247 | (defun my-erlang-load-hook () |
| 248 | (setq erlang-root-dir \"/usr/local/erlang\"))") |
| 249 | |
| 250 | (defvar erlang-new-file-hook nil |
| 251 | "Functions to run when a new Erlang source file is being edited. |
| 252 | |
| 253 | A useful function is `tempo-template-erlang-normal-header'. |
| 254 | \(This function only exists when the `tempo' packags is available.)") |
| 255 | |
| 256 | (defvar erlang-check-module-name 'ask |
| 257 | "*Non-nil means check that module name and file name agrees when saving. |
| 258 | |
| 259 | If the value of this variable is the atom `ask', the user is |
| 260 | prompted. If the value is t the source is silently changed.") |
| 261 | |
| 262 | (defvar erlang-electric-commands |
| 263 | '(erlang-electric-comma |
| 264 | erlang-electric-semicolon |
| 265 | erlang-electric-gt) |
| 266 | "*List of activated electric commands. |
| 267 | |
| 268 | The list should contain the electric commands which should be active. |
| 269 | Currently, the available electric commands are: |
| 270 | erlang-electric-comma |
| 271 | erlang-electric-semicolon |
| 272 | erlang-electric-gt |
| 273 | erlang-electric-newline |
| 274 | |
| 275 | Should the variable be bound to t, all electric commands |
| 276 | are activated. |
| 277 | |
| 278 | To deactivate all electric commands, set this variable to nil.") |
| 279 | |
| 280 | (defvar erlang-electric-newline-inhibit t |
| 281 | "*Set to non-nil to inhibit newline after electric command. |
| 282 | |
| 283 | This is useful since a lot of people press return after executing an |
| 284 | electric command. |
| 285 | |
| 286 | In order to work, the command must also be in the |
| 287 | list `erlang-electric-newline-inhibit-list'. |
| 288 | |
| 289 | Note that commands in this list are required to set the variable |
| 290 | `erlang-electric-newline-inhibit' to nil when the newline shouldn't be |
| 291 | inhibited.") |
| 292 | |
| 293 | (defvar erlang-electric-newline-inhibit-list |
| 294 | '(erlang-electric-semicolon |
| 295 | erlang-electric-comma |
| 296 | erlang-electric-gt) |
| 297 | "*Command which can inhibit the next newline.") |
| 298 | |
| 299 | (defvar erlang-electric-semicolon-insert-blank-lines nil |
| 300 | "*Number of blank lines inserted before header, or nil. |
| 301 | |
| 302 | This variable controls the behaviour of `erlang-electric-semicolon' |
| 303 | when a new function header is generated. When nil, no blank line is |
| 304 | inserted between the current line and the new header. When bound to a |
| 305 | number it represents the number of blank lines which should be |
| 306 | inserted.") |
| 307 | |
| 308 | (defvar erlang-electric-semicolon-criteria |
| 309 | '(erlang-next-lines-empty-p |
| 310 | erlang-at-keyword-end-p |
| 311 | erlang-at-end-of-function-p) |
| 312 | "*List of functions controlling `erlang-electric-semicolon'. |
| 313 | The functions in this list are called, in order, whenever a semicolon |
| 314 | is typed. Each function in the list is called with no arguments, |
| 315 | and should return one of the following values: |
| 316 | |
| 317 | nil -- no determination made, continue checking |
| 318 | 'stop -- do not create prototype for next line |
| 319 | (anything else) -- insert prototype, and stop checking |
| 320 | |
| 321 | If every function in the list is called with no determination made, |
| 322 | then no prototype is inserted. |
| 323 | |
| 324 | The test is performed by the function `erlang-test-criteria-list'.") |
| 325 | |
| 326 | (defvar erlang-electric-comma-criteria |
| 327 | '(erlang-stop-when-inside-argument-list |
| 328 | erlang-stop-when-at-guard |
| 329 | erlang-next-lines-empty-p |
| 330 | erlang-at-keyword-end-p |
| 331 | erlang-at-end-of-function-p) |
| 332 | "*List of functions controlling `erlang-electric-comma'. |
| 333 | The functions in this list are called, in order, whenever a comma |
| 334 | is typed. Each function in the list is called with no arguments, |
| 335 | and should return one of the following values: |
| 336 | |
| 337 | nil -- no determination made, continue checking |
| 338 | 'stop -- do not create prototype for next line |
| 339 | (anything else) -- insert prototype, and stop checking |
| 340 | |
| 341 | If every function in the list is called with no determination made, |
| 342 | then no prototype is inserted. |
| 343 | |
| 344 | The test is performed by the function `erlang-test-criteria-list'.") |
| 345 | |
| 346 | (defvar erlang-electric-arrow-criteria |
| 347 | '(erlang-next-lines-empty-p |
| 348 | erlang-at-end-of-function-p) |
| 349 | "*List of functions controlling the arrow aspect of `erlang-electric-gt'. |
| 350 | The functions in this list are called, in order, whenever a `>' |
| 351 | is typed. Each function in the list is called with no arguments, |
| 352 | and should return one of the following values: |
| 353 | |
| 354 | nil -- no determination made, continue checking |
| 355 | 'stop -- do not create prototype for next line |
| 356 | (anything else) -- insert prototype, and stop checking |
| 357 | |
| 358 | If every function in the list is called with no determination made, |
| 359 | then no prototype is inserted. |
| 360 | |
| 361 | The test is performed by the function `erlang-test-criteria-list'.") |
| 362 | |
| 363 | (defvar erlang-electric-newline-criteria |
| 364 | '(t) |
| 365 | "*List of functions controlling `erlang-electric-newline'. |
| 366 | |
| 367 | The electric newline commands indents the next line. Should the |
| 368 | current line begin with a comment the comment start is copied to |
| 369 | the newly created line. |
| 370 | |
| 371 | The functions in this list are called, in order, whenever a comma |
| 372 | is typed. Each function in the list is called with no arguments, |
| 373 | and should return one of the following values: |
| 374 | |
| 375 | nil -- no determination made, continue checking |
| 376 | 'stop -- do not create prototype for next line |
| 377 | (anything else) -- trigger the electric command. |
| 378 | |
| 379 | If every function in the list is called with no determination made, |
| 380 | then no prototype is inserted. Should the atom t be a member of the |
| 381 | list, it is treated as a function triggering the electric command. |
| 382 | |
| 383 | The test is performed by the function `erlang-test-criteria-list'.") |
| 384 | |
| 385 | (defvar erlang-next-lines-empty-threshold 2 |
| 386 | "*Number of blank lines required to activate an electric command. |
| 387 | |
| 388 | Actually, this value controls the behaviour of the function |
| 389 | `erlang-next-lines-empty-p' which normally is a member of the |
| 390 | criteria lists controlling the electric commands. (Please see |
| 391 | the variables `erlang-electric-semicolon-criteria' and |
| 392 | `erlang-electric-comma-criteria'.) |
| 393 | |
| 394 | The variable is bound to a threshold value, a number, representing the |
| 395 | number of lines which must be empty. |
| 396 | |
| 397 | Setting this variable to zero, electric commands will always be |
| 398 | triggered by `erlang-next-lines-empty-p', unless inhibited by other |
| 399 | rules. |
| 400 | |
| 401 | Should this variable be `nil', `erlang-next-lines-empty-p' will never |
| 402 | trigger an electric command. The same effect would be reached if the |
| 403 | function `erlang-next-lines-empty-p' would be removed from the criteria |
| 404 | lists. |
| 405 | |
| 406 | Note that even if `erlang-next-lines-empty-p' should not trigger an |
| 407 | electric command, other functions in the criteria list could.") |
| 408 | |
| 409 | (defvar erlang-new-clause-with-arguments nil |
| 410 | "*Non-nil means that the arguments are cloned when a clause is generated. |
| 411 | |
| 412 | A new function header can be generated by calls to the function |
| 413 | `erlang-generate-new-clause' and by use of the electric semicolon.") |
| 414 | |
| 415 | (defvar erlang-compile-use-outdir t |
| 416 | "*When nil, go to the directory containing source file when compiling. |
| 417 | |
| 418 | This is a workaround for a bug in the `outdir' option of compile. If the |
| 419 | outdir is not in the current load path, Erlang doesn't load the object |
| 420 | module after it has been compiled. |
| 421 | |
| 422 | To activate the workaround, place the following in your `~/.emacs' file: |
| 423 | (setq erlang-compile-use-outdir nil)") |
| 424 | |
| 425 | (defvar erlang-indent-level 4 |
| 426 | "*Indentation of Erlang calls/clauses within blocks.") |
| 427 | |
| 428 | (defvar erlang-indent-guard 2 |
| 429 | "*Indentation of Erlang guards.") |
| 430 | |
| 431 | (defvar erlang-argument-indent 2 |
| 432 | "*Indentation of the first argument in a function call. |
| 433 | When nil, indent to the column after the `(' of the |
| 434 | function.") |
| 435 | |
| 436 | (defvar erlang-tab-always-indent t |
| 437 | "*Non-nil means TAB in Erlang mode should always reindent the current line, |
| 438 | regardless of where in the line point is when the TAB command is used.") |
| 439 | |
| 440 | (defvar erlang-error-regexp-alist |
| 441 | '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2))) |
| 442 | "*Patterns for matching Erlang errors.") |
| 443 | |
| 444 | (defvar erlang-man-inhibit (eq system-type 'windows-nt) |
| 445 | "Inhibit the creation of the Erlang Manual Pages menu. |
| 446 | |
| 447 | The Windows distribution of Erlang does not include man pages, hence |
| 448 | there is no idea to create the menu.") |
| 449 | |
| 450 | (defvar erlang-man-dirs |
| 451 | '(("Man - Commands" "/man/man1" t) |
| 452 | ("Man - Modules" "/man/man3" t) |
| 453 | ("Man - Unsupported" "/uc/man/man3" t)) |
| 454 | "*The man directories displayed in the Erlang menu. |
| 455 | |
| 456 | Each item in the list should be a list with three elements, the first |
| 457 | the name of the menu, the second the directory, and the last a flag. |
| 458 | Should the flag the nil, the directory is absolute, should it be non-nil |
| 459 | the directory is relative to the variable `erlang-root-dir'.") |
| 460 | |
| 461 | (defvar erlang-man-max-menu-size 20 |
| 462 | "*The maximum number of menu items in one menu allowed.") |
| 463 | |
| 464 | (defvar erlang-man-display-function 'erlang-man-display |
| 465 | "*Function used to display man page. |
| 466 | |
| 467 | The function is called with one argument, the name of the file |
| 468 | containing the man page. Use this variable when the default |
| 469 | function, erlang-man-display, does not work on your system.") |
| 470 | |
| 471 | (defconst erlang-atom-regexp "\\([a-z][a-zA-Z0-9_]*\\|'[^\n']*[^\\]'\\)" |
| 472 | "Regexp which should match an Erlang atom. |
| 473 | |
| 474 | The regexp must be surrounded with a pair of regexp parentheses.") |
| 475 | (defconst erlang-atom-regexp-matches 1 |
| 476 | "Number of regexp parenthesis pairs in `erlang-atom-regexp'. |
| 477 | |
| 478 | This is used to determine parenthesis matches in complex regexps which |
| 479 | contains `erlang-atom-regexp'.") |
| 480 | |
| 481 | (defconst erlang-variable-regexp "\\([A-Z_][a-zA-Z0-9_]*\\)" |
| 482 | "Regexp which should match an Erlang variable. |
| 483 | |
| 484 | The regexp must be surrounded with a pair of regexp parenthesis.") |
| 485 | (defconst erlang-variable-regexp-matches 1 |
| 486 | "Number of regexp parenthesis pairs in `erlang-variable-regexp'. |
| 487 | |
| 488 | This is used to determine matches in complex rexeps which contains |
| 489 | `erlang-variable-regexp'.") |
| 490 | |
| 491 | (defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(") |
| 492 | "*Regexp which should match beginning of a clause.") |
| 493 | |
| 494 | (defvar erlang-file-name-extension-regexp "\\.[eh]rl$" |
| 495 | "*Regexp which should match an erlang file name. |
| 496 | |
| 497 | This regexp is used when an Erlang module name is extracted from the |
| 498 | name of an Erlang source file. |
| 499 | |
| 500 | The regexp should only match the section of the file name which should |
| 501 | be excluded from the module name. |
| 502 | |
| 503 | To match all files set this variable to \"\\\\(\\\\..*\\\\|\\\\)$\". |
| 504 | The matches all except the extension. This is useful if the Erlang |
| 505 | tags system should interpretate tags on the form `module:tag' for |
| 506 | files written in other languages than Erlang.") |
| 507 | |
| 508 | (defvar erlang-mode-map nil |
| 509 | "*Keymap used in Erlang mode.") |
| 510 | (defvar erlang-mode-abbrev-table nil |
| 511 | "Abbrev table in use in Erlang-mode buffers.") |
| 512 | (defvar erlang-mode-syntax-table nil |
| 513 | "Syntax table in use in Erlang-mode buffers.") |
| 514 | |
| 515 | (defconst erlang-emacs-major-version |
| 516 | (if (boundp 'emacs-major-version) |
| 517 | emacs-major-version |
| 518 | (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) |
| 519 | (string-to-int (substring emacs-version |
| 520 | (match-beginning 1) (match-end 1)))) |
| 521 | "Major version number of Emacs.") |
| 522 | |
| 523 | (defconst erlang-emacs-minor-version |
| 524 | (if (boundp 'emacs-minor-version) |
| 525 | emacs-minor-version |
| 526 | (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)" emacs-version) |
| 527 | (string-to-int (substring emacs-version |
| 528 | (match-beginning 2) (match-end 2)))) |
| 529 | "Minor version number of Emacs.") |
| 530 | |
| 531 | (defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) |
| 532 | "Non-nil when running under XEmacs or Lucid Emacs.") |
| 533 | |
| 534 | (defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil) |
| 535 | "Common popup menu for all buffers in Erlang mode. |
| 536 | |
| 537 | This variable is destructively modified every time the Erlang menu |
| 538 | is modified. The effect is that all changes take effekt in all |
| 539 | buffers in Erlang mode, just like under GNU Emacs. |
| 540 | |
| 541 | Never EVER set this variable!") |
| 542 | |
| 543 | |
| 544 | ;; Tempo skeleton templates: |
| 545 | |
| 546 | (defvar erlang-skel |
| 547 | '(("If" "if" erlang-skel-if) |
| 548 | ("Case" "case" erlang-skel-case) |
| 549 | ("Receive" "receive" erlang-skel-receive) |
| 550 | ("Receive After" "after" erlang-skel-receive-after) |
| 551 | ("Receive Loop" "loop" erlang-skel-receive-loop) |
| 552 | ("Module" "module" erlang-skel-module) |
| 553 | ("Author" "author" erlang-skel-author) |
| 554 | () |
| 555 | ("Small Header" "small-header" |
| 556 | erlang-skel-small-header erlang-skel-header) |
| 557 | ("Normal Header" "normal-header" |
| 558 | erlang-skel-normal-header erlang-skel-header) |
| 559 | ("Large Header" "large-header" |
| 560 | erlang-skel-large-header erlang-skel-header) |
| 561 | () |
| 562 | ("Small Server" "small-server" |
| 563 | erlang-skel-small-server erlang-skel-header) |
| 564 | () |
| 565 | ("Application" "application" |
| 566 | erlang-skel-application erlang-skel-header) |
| 567 | ("General Tcp Receive" "fs_gen_tcp_recv" |
| 568 | erlang-skel-fs-gen-tcp-recv erlang-skel-header) |
| 569 | ("Test Suite" "test-suite" |
| 570 | erlang-skel-test-suite erlang-skel-header) |
| 571 | ("Tcp Gateway" "fs_tcp_gateway" |
| 572 | erlang-skel-fs-tcp-gateway erlang-skel-header) |
| 573 | ("Edoc function" "fs_edoc_header" |
| 574 | erlang-skel-fs-edoc-header erlang-skel-header) |
| 575 | ("DB Initialize" "fs_db_init" |
| 576 | erlang-skel-fs-db-init erlang-skel-header) |
| 577 | ("gen_leader" "generic-leader" |
| 578 | erlang-skel-generic-leader erlang-skel-header) |
| 579 | ("Supervisor" "supervisor" |
| 580 | erlang-skel-supervisor erlang-skel-header) |
| 581 | ("supervisor_bridge" "supervisor-bridge" |
| 582 | erlang-skel-supervisor-bridge erlang-skel-header) |
| 583 | ("gen_server" "generic-server" |
| 584 | erlang-skel-generic-server erlang-skel-header) |
| 585 | ("gen_event" "gen-event" |
| 586 | erlang-skel-gen-event erlang-skel-header) |
| 587 | ("gen_fsm" "gen-fsm" |
| 588 | erlang-skel-gen-fsm erlang-skel-header) |
| 589 | ("Library module" "gen-lib" |
| 590 | erlang-skel-lib erlang-skel-header) |
| 591 | ("Corba callback" "gen-corba-cb" |
| 592 | erlang-skel-corba-callback erlang-skel-header)) |
| 593 | "*Description of all skeletons templates. |
| 594 | Both functions and menu entries will be created. |
| 595 | |
| 596 | Each entry in `erlang-skel' should be a list with three or four |
| 597 | elements, or the empty list. |
| 598 | |
| 599 | The first element is the name which shows up in the menu. The second |
| 600 | is the `tempo' identfier (The string \"erlang-\" will be added in |
| 601 | front of it). The third is the skeleton descriptor, a variable |
| 602 | containing `tempo' attributes as described in the function |
| 603 | `tempo-define-template'. The optional fourth elements denotes a |
| 604 | function which should be called when the menu is selected. |
| 605 | |
| 606 | Functions corresponding to every template will be created. The name |
| 607 | of the function will be `tempo-template-erlang-X' where `X' is the |
| 608 | tempo identifier as specified in the second argument of the elements |
| 609 | in this list. |
| 610 | |
| 611 | A list with zero elements means that the a horisontal line should |
| 612 | be placed in the menu.") |
| 613 | |
| 614 | ;; In XEmacs `user-mail-address' returns "x@y.z (Foo Bar)" ARGH! |
| 615 | ;; What's wrong with that? RFC 822 says it's legal. [sverkerw] |
| 616 | (defvar erlang-skel-mail-address |
| 617 | (concat (user-login-name) "@" |
| 618 | (or (and (boundp 'mail-host-address) |
| 619 | (symbol-value 'mail-host-address)) |
| 620 | (system-name))) |
| 621 | "Mail address of the user.") |
| 622 | |
| 623 | ;; Expression templates: |
| 624 | (defvar erlang-skel-case |
| 625 | '((erlang-skel-skip-blank) o > |
| 626 | "case " p " of" n> p "_ ->" n> p "ok" n> "end" p) |
| 627 | "*The skeleton of a `case' expression. |
| 628 | Please see the function `tempo-define-template'.") |
| 629 | |
| 630 | (defvar erlang-skel-if |
| 631 | '((erlang-skel-skip-blank) o > |
| 632 | "if" n> p " ->" n> p "ok" n> "end" p) |
| 633 | "The skeleton of an `if' expression. |
| 634 | Please see the function `tempo-define-template'.") |
| 635 | |
| 636 | (defvar erlang-skel-receive |
| 637 | '((erlang-skel-skip-blank) o > |
| 638 | "receive" n> p "_ ->" n> p "ok" n> "end" p) |
| 639 | "*The skeleton of a `receive' expression. |
| 640 | Please see the function `tempo-define-template'.") |
| 641 | |
| 642 | (defvar erlang-skel-receive-after |
| 643 | '((erlang-skel-skip-blank) o > |
| 644 | "receive" n> p "_ ->" n> p "ok" n> "after " p "T ->" n> |
| 645 | p "ok" n> "end" p) |
| 646 | "*The skeleton of a `receive' expression with an `after' clause. |
| 647 | Please see the function `tempo-define-template'.") |
| 648 | |
| 649 | (defvar erlang-skel-receive-loop |
| 650 | '(& o "loop(" p ") ->" n> "receive" n> p "_ ->" n> |
| 651 | "loop(" p ")" n> "end.") |
| 652 | "*The skeleton of a simple `recieve' loop. |
| 653 | Please see the function `tempo-define-template'.") |
| 654 | |
| 655 | |
| 656 | ;; Attribute templates |
| 657 | |
| 658 | (defvar erlang-skel-module |
| 659 | '(& "-module(" |
| 660 | (erlang-add-quotes-if-needed (erlang-get-module-from-file-name)) |
| 661 | ")." n) |
| 662 | "*The skeleton of a `module' attribute. |
| 663 | Please see the function `tempo-define-template'.") |
| 664 | |
| 665 | (defvar erlang-skel-author |
| 666 | '(& "-author('" erlang-skel-mail-address "')." n) |
| 667 | "*The skeleton of a `author' attribute. |
| 668 | Please see the function `tempo-define-template'.") |
| 669 | |
| 670 | (defvar erlang-skel-vc nil |
| 671 | "*The skeleton template to generate a version control attribute. |
| 672 | The default is to insert nothing. Example of usage: |
| 673 | |
| 674 | (setq erlang-skel-vc '(& \"-rcs(\\\"$\Id: $ \\\").\") n) |
| 675 | |
| 676 | Please see the function `tempo-define-template'.") |
| 677 | |
| 678 | (defvar erlang-skel-export |
| 679 | '(& "-export([" n> "])." n) |
| 680 | "*The skeleton of an `export' attribute. |
| 681 | Please see the function `tempo-define-template'.") |
| 682 | |
| 683 | (defvar erlang-skel-import |
| 684 | '(& "%%-import(Module, [Function/Arity, ...])." n) |
| 685 | "*The skeleton of an `import' attribute. |
| 686 | Please see the function `tempo-define-template'.") |
| 687 | |
| 688 | (defvar erlang-skel-compile nil |
| 689 | ;; '(& "%%-compile(export_all)." n) |
| 690 | "*The skeleton of a `compile' attribute. |
| 691 | Please see the function `tempo-define-template'.") |
| 692 | |
| 693 | |
| 694 | ;; Comment templates. |
| 695 | |
| 696 | (defvar erlang-skel-date-function 'erlang-skel-dd-mmm-yyyy |
| 697 | "*Function which returns date string. |
| 698 | Look in the module `time-stamp' for a battery of functions.") |
| 699 | |
| 700 | (defvar erlang-skel-copyright-comment '() |
| 701 | "*The template for a copyright line in the header, normally empty. |
| 702 | This variable should be bound to a `tempo' template, for example: |
| 703 | '(& \"%%% Copyright (C) 2000, Yoyodyne, Inc.\" n) |
| 704 | |
| 705 | Please see the function `tempo-define-template'.") |
| 706 | |
| 707 | (defvar erlang-skel-created-comment |
| 708 | '(& "%%% Created : " (funcall erlang-skel-date-function) " by " |
| 709 | (user-full-name) " <" erlang-skel-mail-address ">" n) |
| 710 | "*The template for the \"Created:\" comment line.") |
| 711 | |
| 712 | (defvar erlang-skel-author-comment |
| 713 | '(& "%%% Author : " (user-full-name) " <" erlang-skel-mail-address ">" n) |
| 714 | "*The template for creating the \"Author:\" line in the header. |
| 715 | Please see the function `tempo-define-template'.") |
| 716 | |
| 717 | (defvar erlang-skel-file-comment |
| 718 | '(& "%%% File : " (file-name-nondirectory buffer-file-name) n) |
| 719 | "*The template for creating the \"Module:\" line in the header. |
| 720 | Please see the function `tempo-define-template'.") |
| 721 | |
| 722 | (defvar erlang-skel-small-header |
| 723 | '(o (erlang-skel-include erlang-skel-module) |
| 724 | ;; erlang-skel-author) |
| 725 | n |
| 726 | (erlang-skel-include erlang-skel-compile |
| 727 | ;; erlang-skel-export |
| 728 | erlang-skel-vc)) |
| 729 | "*The template of a small header without any comments. |
| 730 | Please see the function `tempo-define-template'.") |
| 731 | |
| 732 | (defvar erlang-skel-normal-header |
| 733 | '(o (erlang-skel-include erlang-skel-copyright-comment |
| 734 | erlang-skel-file-comment |
| 735 | erlang-skel-author-comment) |
| 736 | "%%% Description : " p n |
| 737 | (erlang-skel-include erlang-skel-created-comment) n |
| 738 | (erlang-skel-include erlang-skel-small-header) n) |
| 739 | "*The template of a normal header. |
| 740 | Please see the function `tempo-define-template'.") |
| 741 | |
| 742 | (defvar erlang-skel-large-header |
| 743 | '(o "%%% $Id: erlang.el,v 1.21 2004/08/03 20:38:43 mlogan Exp $" n (erlang-skel-separator) |
| 744 | (erlang-skel-include erlang-skel-copyright-comment |
| 745 | erlang-skel-file-comment |
| 746 | erlang-skel-author-comment) |
| 747 | "%%%" n |
| 748 | "%%% @doc " p n |
| 749 | "%%% @end" n |
| 750 | "%%%" n |
| 751 | (erlang-skel-include erlang-skel-created-comment) |
| 752 | (erlang-skel-separator) |
| 753 | (erlang-skel-include erlang-skel-small-header) ) |
| 754 | "*The template of a large header. |
| 755 | Please see the function `tempo-define-template'.") |
| 756 | |
| 757 | |
| 758 | ;; Server templates. |
| 759 | |
| 760 | (defvar erlang-skel-small-server |
| 761 | '((erlang-skel-include erlang-skel-large-header) |
| 762 | (erlang-skel-separator 2) |
| 763 | "%% Include files" n |
| 764 | (erlang-skel-separator 2) n |
| 765 | (erlang-skel-separator 2) |
| 766 | "%% External exports" n |
| 767 | (erlang-skel-separator 2) |
| 768 | "-export([start_link/0])." n n |
| 769 | (erlang-skel-separator 2) |
| 770 | "%% Internal exports" n |
| 771 | (erlang-skel-separator 2) |
| 772 | "-export([init/1])." n n |
| 773 | n |
| 774 | (erlang-skel-separator 2) |
| 775 | "%% Macros" n |
| 776 | (erlang-skel-separator 2) |
| 777 | "-define(SERVER, ?MODULE)." n |
| 778 | n |
| 779 | (erlang-skel-separator 2) |
| 780 | "%% Records" n |
| 781 | (erlang-skel-separator 2) |
| 782 | n |
| 783 | (erlang-skel-double-separator 2) |
| 784 | "%% External functions" n |
| 785 | (erlang-skel-double-separator 2) |
| 786 | n |
| 787 | (erlang-skel-separator 2) |
| 788 | "%% @doc The starting point." n |
| 789 | "%% @spec start_link() -> {ok, Pid}" n |
| 790 | "%% @end" n |
| 791 | (erlang-skel-separator 2) |
| 792 | "start_link() ->" n> |
| 793 | "proc_lib:start_link(?MODULE, init, [self()])." n n |
| 794 | (erlang-skel-double-separator 2) |
| 795 | "%% Server functions" n |
| 796 | (erlang-skel-double-separator 2) |
| 797 | (erlang-skel-separator 2) |
| 798 | "%% Description: Initializes this server." n |
| 799 | "%% Variables:" n |
| 800 | "%% From - The pid of the parent process." n |
| 801 | (erlang-skel-separator 2) |
| 802 | "init(From) ->" n> |
| 803 | "register(?SERVER, self())," n> |
| 804 | "proc_lib:init_ack(From, {ok, self()})," n> |
| 805 | "loop(From)." n n |
| 806 | (erlang-skel-double-separator 2) |
| 807 | "%% Internal functions" n |
| 808 | (erlang-skel-double-separator 2) |
| 809 | "loop(From) ->" n> |
| 810 | "receive" n> |
| 811 | p "_ ->" n> |
| 812 | "loop(From)" n> |
| 813 | "end." |
| 814 | ) |
| 815 | "*Template of a small server. |
| 816 | Please see the function `tempo-define-template'.") |
| 817 | |
| 818 | ;; Behaviour templates. |
| 819 | |
| 820 | (defvar erlang-skel-application |
| 821 | '((erlang-skel-include erlang-skel-large-header) |
| 822 | "-behaviour(application)." n |
| 823 | (erlang-skel-separator 2) |
| 824 | "%% Include files" n |
| 825 | (erlang-skel-separator 2) |
| 826 | n |
| 827 | (erlang-skel-separator 2) |
| 828 | "%% External exports" n |
| 829 | (erlang-skel-separator 2) |
| 830 | "-export([" n> |
| 831 | "start/2," n> |
| 832 | "shutdown/0," n> |
| 833 | "stop/1" n> |
| 834 | "])." n |
| 835 | n |
| 836 | (erlang-skel-separator 2) |
| 837 | "%% Macros" n |
| 838 | (erlang-skel-separator 2) |
| 839 | n |
| 840 | (erlang-skel-separator 2) |
| 841 | "%% Records" n |
| 842 | (erlang-skel-separator 2) |
| 843 | n |
| 844 | (erlang-skel-double-separator 2) |
| 845 | "%% External functions" n |
| 846 | (erlang-skel-double-separator 2) |
| 847 | (erlang-skel-separator 2) |
| 848 | "%% @doc The starting point for an erlang application." n |
| 849 | "%% @spec start(Type, StartArgs) -> {ok, Pid} | {ok, Pid, State} | {error, Reason}" n |
| 850 | "%% @end" n |
| 851 | (erlang-skel-separator 2) |
| 852 | "start(Type, StartArgs) ->" n> |
| 853 | "case "(erlang-get-module-from-file-name)"_sup:start_link(StartArgs) of" n> |
| 854 | "{ok, Pid} -> " n> |
| 855 | "{ok, Pid};" n> |
| 856 | "Error ->" n> |
| 857 | "Error" n> |
| 858 | "end." n |
| 859 | n |
| 860 | (erlang-skel-separator 2) |
| 861 | "%% @doc Called to shudown the "(erlang-get-module-from-file-name)" application." n |
| 862 | "%% @spec shutdown() -> ok "n |
| 863 | "%% @end"n |
| 864 | (erlang-skel-separator 2) |
| 865 | "shutdown() ->" n> |
| 866 | "application:stop("(erlang-get-module-from-file-name)")." n |
| 867 | n |
| 868 | (erlang-skel-double-separator 2) |
| 869 | "%% Internal functions" n |
| 870 | (erlang-skel-double-separator 2) |
| 871 | n |
| 872 | (erlang-skel-separator 2) |
| 873 | "%% Called upon the termintion of an application." n |
| 874 | (erlang-skel-separator 2) |
| 875 | "stop(State) ->" n> |
| 876 | "ok." n |
| 877 | n |
| 878 | ) |
| 879 | "*The template of an application behaviour. |
| 880 | Please see the function `tempo-define-template'.") |
| 881 | |
| 882 | ;; Martins work |
| 883 | |
| 884 | ;; test server test suite template |
| 885 | (defvar erlang-skel-test-suite |
| 886 | '((erlang-skel-include erlang-skel-copyright-comment |
| 887 | erlang-skel-file-comment |
| 888 | erlang-skel-author-comment) |
| 889 | "%%%" n |
| 890 | "%%% @doc " p n |
| 891 | "%%% <p>A test spec consists of the test server required functions as detailed" n |
| 892 | "%%% by the comments for the functions themselves further down in this" n |
| 893 | "%%% file. The rest of a test suite consists of user defined Case functions" n |
| 894 | "%%% as referenced by the suite clause of the all/1 function and "n |
| 895 | "%%% described below.</p>"n |
| 896 | "%%%"n |
| 897 | "%%% <strong>" |
| 898 | "%%% Case(doc) -> [Decription]" n |
| 899 | "%%% Case(suite) -> [] | TestSpec | {skip, Comment}" n |
| 900 | "%%% Case(Config) -> {skip, Comment} | {comment, Comment} | Ok" n |
| 901 | "%%% </strong><pre>"n |
| 902 | "%%%"n |
| 903 | "%%% Variables:" n |
| 904 | "%%% Description - Short description of the test case TestSpec" n |
| 905 | "%%% Comment - This comment will be printed on the HTML result page " n |
| 906 | "%%%"n |
| 907 | "%%% Types:" n |
| 908 | "%%% Description = string()" n |
| 909 | "%%% TestSpec = list()" n |
| 910 | "%%% Ok = term()" n |
| 911 | "%%% Comment = string()" n |
| 912 | "%%% Config = term()" n |
| 913 | "%%% </pre>" n |
| 914 | "%%% <p>The documentation clause (argument doc) can be used for" n |
| 915 | "%%% automatic generation of test documentation or test descriptions.</p>" n |
| 916 | "%%%"n |
| 917 | "%%% <p>The specification clause (argument spec) shall return an empty" n |
| 918 | "%%% list, the test specification for the test case or {skip,Comment}." n |
| 919 | "%%% The syntax of a test specification is described in the reference " n |
| 920 | "%%% manual for the Test Server application.</p>" n |
| 921 | "%%%"n |
| 922 | "%%% <p>Note that the specification clause always is executed on "n |
| 923 | "%%% the controller host.</p>"n |
| 924 | "%%%"n |
| 925 | "%%% <p>The execution clause (argument Config) is only called if "n |
| 926 | "%%% the specification clause returns an empty list. The execution "n |
| 927 | "%%% clause is the real test case. Here you must call the functions "n |
| 928 | "%%% you want to test, and do whatever you need to check the result. "n |
| 929 | "%%% If someting fails, make sure the process crashes or call "n |
| 930 | "%%% test_server:fail/0/1 (which also will cause the process to crash).</p>"n |
| 931 | "%%%"n |
| 932 | "%%% <p>You can return {skip,Comment} if you decide not to run the "n |
| 933 | "%%% test case after all, e.g. if it is not applicable on this platform.</p>"n |
| 934 | "%%%"n |
| 935 | "%%% <p>You can return {comment,Comment} if you wish to print some "n |
| 936 | "%%% information in the 'Comment' field on the HTML result page.</p>"n |
| 937 | "%%%"n |
| 938 | "%%% <p>If the execution clause returns anything else, it is considered "n |
| 939 | "%%% a success. </p>"n |
| 940 | "%%% @end" n |
| 941 | "%%%" n |
| 942 | (erlang-skel-include erlang-skel-created-comment) |
| 943 | (erlang-skel-separator) |
| 944 | (erlang-skel-include erlang-skel-small-header) |
| 945 | (erlang-skel-separator 2) |
| 946 | "%% Include files" n |
| 947 | (erlang-skel-separator 2) |
| 948 | n |
| 949 | (erlang-skel-separator 2) |
| 950 | "%% Macro Definitions" n |
| 951 | (erlang-skel-separator 2) |
| 952 | n |
| 953 | (erlang-skel-separator 2) |
| 954 | "%% Test Suite Exports" n |
| 955 | (erlang-skel-separator 2) |
| 956 | "-export(["n>"all/1,"n>"init_per_testcase/2,"n>"fin_per_testcase/2"n>"])." n |
| 957 | n |
| 958 | (erlang-skel-separator 2) |
| 959 | "%% External Exports - test cases must be exported." n |
| 960 | (erlang-skel-separator 2) |
| 961 | "-export(["n>"])."n |
| 962 | n |
| 963 | (erlang-skel-double-separator 2) |
| 964 | "%% Test Server Functions" n |
| 965 | (erlang-skel-double-separator 2) |
| 966 | n |
| 967 | (erlang-skel-separator 2) |
| 968 | "%% @doc This function returns the test specification for the test suite module."n |
| 969 | "%% <pre>"n |
| 970 | "%% Types:"n |
| 971 | "%% TestSpec = list()"n |
| 972 | "%% Comment = string()"n |
| 973 | "%%"n |
| 974 | "%% </pre>"n |
| 975 | "%% @spec all(suite) -> TestSpec | {skip, Comment}"n |
| 976 | "%% @end"n |
| 977 | (erlang-skel-separator 2) |
| 978 | "all(doc) -> [];"n |
| 979 | "all(suite) -> []."n n |
| 980 | n |
| 981 | (erlang-skel-separator 2) |
| 982 | "%% @doc This function is called before each test case."n |
| 983 | "%% <pre>"n |
| 984 | "%% Types:"n |
| 985 | "%% Case = atom()"n |
| 986 | "%% Config = NewConfig = term()"n |
| 987 | "%%"n |
| 988 | "%% </pre>"n |
| 989 | "%% @spec init_per_testcase(Case, Config) -> NewConfig"n |
| 990 | "%% @end"n |
| 991 | (erlang-skel-separator 2) |
| 992 | "init_per_testcase(Case, Config) -> []."n n |
| 993 | n |
| 994 | (erlang-skel-separator 2) |
| 995 | "%% @doc This function is called after each test case."n |
| 996 | "%% <pre>"n |
| 997 | "%% Types:"n |
| 998 | "%% Case = atom()"n |
| 999 | "%% Config = term()"n |
| 1000 | "%%"n |
| 1001 | "%% </pre>"n |
| 1002 | "%% @spec fin_per_testcase(Case, Config) -> void()"n |
| 1003 | "%% @end"n |
| 1004 | (erlang-skel-separator 2) |
| 1005 | "fin_per_testcase(Case, Config) -> ok."n n |
| 1006 | n |
| 1007 | (erlang-skel-double-separator 2) |
| 1008 | "%% Individual Test Case Functions" n |
| 1009 | (erlang-skel-double-separator 2) |
| 1010 | n |
| 1011 | (erlang-skel-separator 2) |
| 1012 | "%% @doc ." n |
| 1013 | "%% @end" n |
| 1014 | (erlang-skel-separator 2) |
| 1015 | "Case(doc) -> [];"n |
| 1016 | "Case(suite) -> [];"n |
| 1017 | "Case(Config) when list(Config) -> ok."n n |
| 1018 | n |
| 1019 | (erlang-skel-double-separator 2) |
| 1020 | "%% Internal Functions" n |
| 1021 | (erlang-skel-double-separator 2) |
| 1022 | ) |
| 1023 | "*The template of an application behaviour. |
| 1024 | Please see the function `tempo-define-template'.") |
| 1025 | |
| 1026 | |
| 1027 | ;; fs_tcp_gateway template |
| 1028 | (defvar erlang-skel-fs-tcp-gateway |
| 1029 | '((erlang-skel-include erlang-skel-large-header) |
| 1030 | "%% TODO Implement this behaviour" n |
| 1031 | "%% -behaviour(tcp_gateway)." n |
| 1032 | (erlang-skel-separator 2) |
| 1033 | "%% Include files" n |
| 1034 | (erlang-skel-separator 2) |
| 1035 | n |
| 1036 | (erlang-skel-separator 2) |
| 1037 | "%% External exports" n |
| 1038 | (erlang-skel-separator 2) |
| 1039 | "-export([" n> "start_link/1, init/0, sync_request/5, async_request/5, terminate/2" n |
| 1040 | " ])." n |
| 1041 | n |
| 1042 | (erlang-skel-separator 2) |
| 1043 | "%% Macros" n |
| 1044 | (erlang-skel-separator 2) |
| 1045 | "-define(SERVER, ?MODULE)." n |
| 1046 | n |
| 1047 | (erlang-skel-separator 2) |
| 1048 | "%% Records" n |
| 1049 | (erlang-skel-separator 2) |
| 1050 | "-record(state, {})."n |
| 1051 | n |
| 1052 | (erlang-skel-double-separator 2) |
| 1053 | "%% External functions" n |
| 1054 | (erlang-skel-double-separator 2) |
| 1055 | (erlang-skel-separator 2) |
| 1056 | "%% @doc Starts the gateway server."n |
| 1057 | "%% <pre>"n |
| 1058 | "%%"n |
| 1059 | "%% Expects:"n |
| 1060 | "%% Port - The port number to bind to."n |
| 1061 | "%%"n |
| 1062 | "%% Types:"n |
| 1063 | "%% Port = integer()"n |
| 1064 | "%%"n |
| 1065 | "%% </pre>"n |
| 1066 | "%%"n |
| 1067 | "%% @spec start_link(Port) -> {ok, pid()}"n |
| 1068 | "%% @end"n |
| 1069 | (erlang-skel-separator 2) |
| 1070 | "start_link(Port) ->" n> |
| 1071 | "CallBackModule = ?MODULE,"n> |
| 1072 | " fs_tcp_gateway:start_link(CallBackModule, Port)."n |
| 1073 | n |
| 1074 | (erlang-skel-double-separator 2) |
| 1075 | "%% Callbacks" n |
| 1076 | (erlang-skel-double-separator 2) |
| 1077 | (erlang-skel-separator 2) |
| 1078 | "%% @doc Initialization stage for each new connection to the gateway server."n |
| 1079 | "%% <pre>"n |
| 1080 | "%%"n |
| 1081 | "%% Types:"n |
| 1082 | "%% State = term()"n |
| 1083 | "%%"n |
| 1084 | "%% </pre>"n |
| 1085 | "%%"n |
| 1086 | "%% @spec init() -> {ok, State}"n |
| 1087 | "%% @end"n |
| 1088 | (erlang-skel-separator 2) |
| 1089 | "init() ->"n> |
| 1090 | "{ok, #state{}}."n |
| 1091 | n |
| 1092 | (erlang-skel-separator 2) |
| 1093 | "%% @doc Called when the server receives a syncronous request from a client."n |
| 1094 | "%% <pre>"n |
| 1095 | "%%"n |
| 1096 | "%% Expects:"n |
| 1097 | "%% ID - The request ID number"n |
| 1098 | "%% M - module name"n |
| 1099 | "%% F - function name"n |
| 1100 | "%% A - List of arguments"n |
| 1101 | "%% Reply - A message sent back over the tcp stream to the client"n |
| 1102 | "%%"n |
| 1103 | "%% Types:"n |
| 1104 | "%% ID = M = F = Reply = string()"n |
| 1105 | "%% A = [string()]"n |
| 1106 | "%% State = term()"n |
| 1107 | "%% Reply = string()"n |
| 1108 | "%%"n |
| 1109 | "%% </pre>"n |
| 1110 | "%%"n |
| 1111 | "%% @spec sync_request(ID, M, F, A, State) ->"n |
| 1112 | "%% {reply, Reply, State} | {stop, Reply, Reason, State} | {noreply, State}"n |
| 1113 | "%% @end"n |
| 1114 | (erlang-skel-separator 2) |
| 1115 | "sync_request(ID, M, F, A, State) ->"n> |
| 1116 | "{reply, \"sync ok\", State}."n |
| 1117 | n |
| 1118 | (erlang-skel-separator 2) |
| 1119 | "%% @doc Called when the server receives a asyncronous request from a client."n |
| 1120 | "%% <pre>"n |
| 1121 | "%%"n |
| 1122 | "%% Expects:"n |
| 1123 | "%% ID - The request ID number"n |
| 1124 | "%% M - module name"n |
| 1125 | "%% F - function name"n |
| 1126 | "%% A - List of arguments"n |
| 1127 | "%% Reply - A message sent back over the tcp stream to the client"n |
| 1128 | "%%"n |
| 1129 | "%% Types:"n |
| 1130 | "%% ID = M = F = string()"n |
| 1131 | "%% A = [string()]"n |
| 1132 | "%% State = term()"n |
| 1133 | "%% Reply = string()"n |
| 1134 | "%%"n |
| 1135 | "%% </pre>"n |
| 1136 | "%%"n |
| 1137 | "%% @spec async_request(ID, M, F, A, State) ->"n |
| 1138 | "%% {stop, Reason, State} | {noreply, State}"n |
| 1139 | "%% @end"n |
| 1140 | (erlang-skel-separator 2) |
| 1141 | "async_request(ID, M, F, A, State) ->"n> |
| 1142 | "{noreply, State}."n |
| 1143 | n |
| 1144 | (erlang-skel-separator 2) |
| 1145 | "%% @doc Called upon the shutdown of a connection."n |
| 1146 | "%% @spec terminate(Reason, State) -> void()"n |
| 1147 | "%% @end"n |
| 1148 | (erlang-skel-separator 2) |
| 1149 | "terminate(Reason, State) ->"n> |
| 1150 | "ok."n |
| 1151 | n |
| 1152 | (erlang-skel-double-separator 2) |
| 1153 | "%% Internal functions" n |
| 1154 | (erlang-skel-double-separator 2) |
| 1155 | ) |
| 1156 | "*The template of a fs_tcp_gateway behaviour. |
| 1157 | Please see the function `tempo-define-template'.") |
| 1158 | |
| 1159 | |
| 1160 | ;; gen_tcp_recv template |
| 1161 | (defvar erlang-skel-fs-gen-tcp-recv |
| 1162 | '((erlang-skel-include erlang-skel-large-header) |
| 1163 | "%% TODO Implement this behaviour" n |
| 1164 | "%% -behaviour(gen_tcp_recv)." n |
| 1165 | (erlang-skel-separator 2) |
| 1166 | "%% External exports" n |
| 1167 | (erlang-skel-separator 2) |
| 1168 | "-export([" n> "start_link/0" n> "])." n n |
| 1169 | (erlang-skel-separator 2) |
| 1170 | "%% Server Callbacks" n |
| 1171 | (erlang-skel-separator 2) |
| 1172 | "-export([" n> "init/1," n> "handle_packet/3," n> "handle_call/4" n> |
| 1173 | "handle_info/3" n> "terminate/2" n> "])." n n |
| 1174 | (erlang-skel-separator 2) |
| 1175 | "%% Include files" n |
| 1176 | (erlang-skel-separator 2) |
| 1177 | n |
| 1178 | (erlang-skel-separator 2) |
| 1179 | "%% API - External Exports" n |
| 1180 | (erlang-skel-separator 2) |
| 1181 | "-export([" n> |
| 1182 | "start_link/1" n> |
| 1183 | "])." n |
| 1184 | n |
| 1185 | (erlang-skel-separator 2) |
| 1186 | "%% Macros" n |
| 1187 | (erlang-skel-separator 2) |
| 1188 | "-define(SERVER, ?MODULE)." n |
| 1189 | n |
| 1190 | (erlang-skel-separator 2) |
| 1191 | "%% Records" n |
| 1192 | (erlang-skel-separator 2) |
| 1193 | n |
| 1194 | (erlang-skel-double-separator 2) |
| 1195 | "%% External functions" n |
| 1196 | (erlang-skel-double-separator 2) n |
| 1197 | (erlang-skel-separator 2) |
| 1198 | "%% @doc Starts the fs_gen_tcp_recv server." n |
| 1199 | "%% @spec start_link() -> {ok, Pid}" n |
| 1200 | "%% @end" n |
| 1201 | (erlang-skel-separator 2) |
| 1202 | "start_link() ->" n> |
| 1203 | "fs_gen_tcp_recv:start_link(CallbackModule, ?TCP_PORT, [], [], [])." n n n |
| 1204 | (erlang-skel-double-separator 2) |
| 1205 | "%% Server Functions" n |
| 1206 | (erlang-skel-double-separator 2) n |
| 1207 | (erlang-skel-separator 2) |
| 1208 | "%% Initializes the state for a gen_tcp_recv server." n |
| 1209 | "%% Returns: {ok, State}" n |
| 1210 | "%% State = term()" n |
| 1211 | (erlang-skel-separator 2) |
| 1212 | "init([]) ->" n> |
| 1213 | "{ok, []}." n n n |
| 1214 | (erlang-skel-separator 2) |
| 1215 | "%% Receives packets from the socket. Also receives timout messages." n |
| 1216 | "%% Types:" n |
| 1217 | "%% Socket = socket()" n |
| 1218 | "%% Packet = binary() | string(). Can be altered in TCPOptions" n |
| 1219 | "%% Reply = binary() | string(). Can be altered in TCPOptions" n |
| 1220 | "%% State = NewState = term()" n |
| 1221 | "%% Timeout = integer() in miliseconds." n |
| 1222 | "%% Returns: " n |
| 1223 | "%% {noreply, NewState} {noreply, NewState, Timeout}" n |
| 1224 | "%% {reply, Reply, NewState} {reply, Reply, NewState, Timeout}" n |
| 1225 | "%% {stop, Reason, NewState}" n |
| 1226 | (erlang-skel-separator 2) |
| 1227 | "handle_packet(Socket, Packet, State) ->" n> |
| 1228 | "{noreply, State}." n n n |
| 1229 | (erlang-skel-separator 2) |
| 1230 | "%% Receives sync calls from a client." n |
| 1231 | "%% Variables:" n |
| 1232 | "%% Reply - A message sent back to the caller." n |
| 1233 | "%% " n |
| 1234 | "%% Types:" n |
| 1235 | "%% Socket = socket()" n |
| 1236 | "%% Msg = Reply = term()" n |
| 1237 | "%% State = NewState = term()" n |
| 1238 | "%% Timeout = integer() in miliseconds." n |
| 1239 | "%% Returns: " n |
| 1240 | "%% {noreply, NewState} {noreply, NewState, Timeout}" n |
| 1241 | "%% {reply, Reply, NewState} {reply, Reply, NewState, Timeout}" n |
| 1242 | "%% {stop, Reason, NewState} | {stop, Reason, Reply, NewState}" n |
| 1243 | (erlang-skel-separator 2) |
| 1244 | "handle_call(Socket, From, Msg, State) ->" n> |
| 1245 | "{reply, Reply, State}." n n n |
| 1246 | (erlang-skel-separator 2) |
| 1247 | "%% Receives messages from other processes and timeouts." n |
| 1248 | "%% Types:" n |
| 1249 | "%% Socket = socket()" n |
| 1250 | "%% Msg = term() | timeout" n |
| 1251 | "%% State = NewState = term()" n |
| 1252 | "%% Timeout = integer() in miliseconds." n |
| 1253 | "%% Returns: " n |
| 1254 | "%% {noreply, NewState} {noreply, NewState, Timeout}" n |
| 1255 | "%% {stop, Reason, NewState}" n |
| 1256 | (erlang-skel-separator 2) |
| 1257 | "handle_info(Socket, Msg, State) ->" n> |
| 1258 | "{noreply, State}." n n n |
| 1259 | (erlang-skel-separator 2) |
| 1260 | "%% Called after a socket closes or {stop, Reason, NewState}" n |
| 1261 | "%% Types:" n |
| 1262 | "%% Socket = socket()" n |
| 1263 | "%% State = NewState = term()" n |
| 1264 | "%% Returns: term()" n |
| 1265 | (erlang-skel-separator 2) |
| 1266 | "terminate(Socket, State) ->" n> |
| 1267 | "ok." n n n |
| 1268 | (erlang-skel-double-separator 2) |
| 1269 | "%%% Internal Functions" n |
| 1270 | (erlang-skel-double-separator 2) |
| 1271 | ) |
| 1272 | "*The template of a fs_gen_tcp_recv behaviour. |
| 1273 | Please see the function `tempo-define-template'.") |
| 1274 | |
| 1275 | ;; fs_edoc_header template |
| 1276 | (defvar erlang-skel-fs-edoc-header |
| 1277 | '((erlang-skel-separator 2) |
| 1278 | "%% @doc" n |
| 1279 | "%% <pre>" n |
| 1280 | "%% Variables:" n |
| 1281 | "%% Types:" n |
| 1282 | "%% </pre> term()" n |
| 1283 | "%% @spec" n |
| 1284 | "%% @end" n |
| 1285 | (erlang-skel-separator 2) |
| 1286 | ) |
| 1287 | "*The template of an edoc function header. |
| 1288 | Please see the function `tempo-define-template'.") |
| 1289 | |
| 1290 | ;; fs_db_init template |
| 1291 | (defvar erlang-skel-fs-db-init |
| 1292 | '((erlang-skel-include erlang-skel-large-header) |
| 1293 | "%% TODO Implement this behaviour" n |
| 1294 | "%% -behaviour(db_init)." n |
| 1295 | (erlang-skel-separator 2) |
| 1296 | "%% Include files" n |
| 1297 | (erlang-skel-separator 2) |
| 1298 | n |
| 1299 | (erlang-skel-separator 2) |
| 1300 | "%% External exports" n |
| 1301 | (erlang-skel-separator 2) |
| 1302 | "-export([" n> "start_link/1, start_link/3, init/1, local_init/0, remote_init/0" n |
| 1303 | " ])." n |
| 1304 | n |
| 1305 | (erlang-skel-separator 2) |
| 1306 | "%% Macros" n |
| 1307 | (erlang-skel-separator 2) |
| 1308 | "-define(SERVER, ?MODULE)." n |
| 1309 | n |
| 1310 | (erlang-skel-separator 2) |
| 1311 | "%% Records" n |
| 1312 | (erlang-skel-separator 2) |
| 1313 | n |
| 1314 | (erlang-skel-double-separator 2) |
| 1315 | "%% External functions" n |
| 1316 | (erlang-skel-separator 2) |
| 1317 | "%% @doc Starts the server. " n> |
| 1318 | "%% <pre>" n> |
| 1319 | "%% Variables:" n> |
| 1320 | "%% CallBackModule - The module that exhibits the db init behaviour." n> |
| 1321 | "%% Args - A list of arguments delivered to the CallBackModule:init/1 function." n> |
| 1322 | "%% Options - A list of options for fs_db_init." n> |
| 1323 | "%%" n> |
| 1324 | "%% The options are as follows:" n> |
| 1325 | "%% {schema_type, Type}" n> |
| 1326 | "%%" n> |
| 1327 | "%% Types:" n> |
| 1328 | "%% Args = list()" n> |
| 1329 | "%% Options = list()" n> |
| 1330 | "%% Type = ram_copies | disc_copies | disc_only_copies" n> |
| 1331 | "%%" n> |
| 1332 | "%% </pre>" n> |
| 1333 | "%% @spec start_link(CallBackModule, Args, Options) -> {ok, pid()} | {error, Reason}" n> |
| 1334 | "%% @end" n> |
| 1335 | "(erlang-skel-separator 2)" |
| 1336 | "start_link(CallBackModule, Args, Options) ->" n> |
| 1337 | "proc_lib:start_link(?MODULE, db_init, [self(), CallBackModule, Args, Options])." n> |
| 1338 | n |
| 1339 | "%% @spec start_link(CallBackModule) -> {ok, pid()} | {error, Reason}" n> |
| 1340 | "%% @equiv start_link(CallBackModule, [], [])" n> |
| 1341 | "start_link(CallBackModule) ->" n> |
| 1342 | "start_link(CallBackModule, [], [])." n> |
| 1343 | n |
| 1344 | (erlang-skel-double-separator 2) |
| 1345 | "%% Callbacks" n |
| 1346 | (erlang-skel-double-separator 2) |
| 1347 | (erlang-skel-separator 2) |
| 1348 | "%% @doc" n |
| 1349 | "%% Returns a list of nodes that db_init should try to replicate with." n |
| 1350 | "%%" n |
| 1351 | "%% <pre>" n |
| 1352 | "%% Types:" n |
| 1353 | "%% DBNodes = [node()]" n |
| 1354 | "%% </pre>" n |
| 1355 | "%%" n |
| 1356 | "%% @spec init(Args) -> {ok, DBNodes} | no_init" n |
| 1357 | "%% @end" n |
| 1358 | (erlang-skel-separator 2) |
| 1359 | "init(Args) ->" n |
| 1360 | " {ok, DBNodesToReplicateFrom = []}." n |
| 1361 | (erlang-skel-separator 2) |
| 1362 | "%% @doc" n |
| 1363 | "%% Created a schema and seeds the local database." n |
| 1364 | "%% Returns a list of records with their initial data." n |
| 1365 | "%% These are to be the tables and initial values for the database." n |
| 1366 | "%%" n |
| 1367 | "%% <pre>" n |
| 1368 | "%% Reclist = [record()]" n |
| 1369 | "%% Reason = atom()" n |
| 1370 | "%% </pre>" n |
| 1371 | "%%" n |
| 1372 | "%% @spec local_init() -> {ok, RecList} | {error, Reason}" n |
| 1373 | "%% @end" n |
| 1374 | (erlang-skel-separator 2) |
| 1375 | "local_init() ->" n |
| 1376 | " {ok, []}." n |
| 1377 | (erlang-skel-separator 2) |
| 1378 | "%% @doc Pushes the schema and the table definitions to the node" n |
| 1379 | "%% specified by the variable node." n |
| 1380 | "%% NOTE: Do not include the schema in this list." n |
| 1381 | "%%" n |
| 1382 | "%% <pre>" n |
| 1383 | "%% Types " n |
| 1384 | "%% Node = node()" n |
| 1385 | "%% TableList = [{Table, Type}]" n |
| 1386 | "%% Table = atom()" n |
| 1387 | "%% Type = ram_copies, disc_copies" n |
| 1388 | "%% Reason = atom()" n |
| 1389 | "%% </pre>" n |
| 1390 | "%%" n |
| 1391 | "%% @spec remote_init() -> {ok, TableList} | {error, Reason}" n |
| 1392 | "%% @end" n |
| 1393 | (erlang-skel-separator 2) |
| 1394 | "remote_init() ->" n |
| 1395 | " {ok, [{ini, ram_copies}]}." n |
| 1396 | n |
| 1397 | ) |
| 1398 | "*The template of a fs_db_init behaviour. |
| 1399 | Please see the function `tempo-define-template'.") |
| 1400 | |
| 1401 | (defvar erlang-skel-supervisor |
| 1402 | '((erlang-skel-include erlang-skel-large-header) |
| 1403 | "-behaviour(supervisor)." n |
| 1404 | (erlang-skel-separator 2) |
| 1405 | "%% Include files" n |
| 1406 | (erlang-skel-separator 2) |
| 1407 | n |
| 1408 | (erlang-skel-separator 2) |
| 1409 | "%% External exports" n |
| 1410 | (erlang-skel-separator 2) |
| 1411 | "-export([" n> "start_link/1" n |
| 1412 | " ])." n |
| 1413 | n |
| 1414 | (erlang-skel-separator 2) |
| 1415 | "%% Internal exports" n |
| 1416 | (erlang-skel-separator 2) |
| 1417 | "-export([" n> "init/1" n |
| 1418 | " ])." n |
| 1419 | n |
| 1420 | (erlang-skel-separator 2) |
| 1421 | "%% Macros" n |
| 1422 | (erlang-skel-separator 2) |
| 1423 | "-define(SERVER, ?MODULE)." n |
| 1424 | n |
| 1425 | (erlang-skel-separator 2) |
| 1426 | "%% Records" n |
| 1427 | (erlang-skel-separator 2) |
| 1428 | n |
| 1429 | (erlang-skel-double-separator 2) |
| 1430 | "%% External functions" n |
| 1431 | (erlang-skel-double-separator 2) |
| 1432 | (erlang-skel-separator 2) |
| 1433 | "%% @doc Starts the supervisor." n |
| 1434 | "%% @spec start_link(StartArgs) -> {ok, pid()} | Error" n |
| 1435 | "%% @end" n |
| 1436 | (erlang-skel-separator 2) |
| 1437 | "start_link(StartArgs) ->" n> |
| 1438 | "supervisor:start_link({local, ?SERVER}, ?MODULE, [])." n |
| 1439 | n |
| 1440 | (erlang-skel-double-separator 2) |
| 1441 | "%% Server functions" n |
| 1442 | (erlang-skel-double-separator 2) |
| 1443 | (erlang-skel-separator 2) |
| 1444 | "%% Func: init/1" n |
| 1445 | "%% Returns: {ok, {SupFlags, [ChildSpec]}} |" n |
| 1446 | "%% ignore |" n |
| 1447 | "%% {error, Reason} " n |
| 1448 | (erlang-skel-separator 2) |
| 1449 | "init([]) ->" n> |
| 1450 | "RestartStrategy = one_for_one," n> |
| 1451 | "MaxRestarts = 1000," n> |
| 1452 | "MaxTimeBetRestarts = 3600," n> |
| 1453 | n> |
| 1454 | "SupFlags = {RestartStrategy, MaxRestarts, MaxTimeBetRestarts}," n> |
| 1455 | n> |
| 1456 | "ChildSpecs =" n> |
| 1457 | "[" n> |
| 1458 | "{AppName," n> |
| 1459 | "{AppName, start_link, []}," n> |
| 1460 | "permanent," n> |
| 1461 | "1000," n> |
| 1462 | "worker," n> |
| 1463 | "[AppName]}" n> |
| 1464 | "]," n> |
| 1465 | "{ok,{SupFlags, ChildSpecs}}." n |
| 1466 | |
| 1467 | (erlang-skel-double-separator 2) |
| 1468 | "%% Internal functions" n |
| 1469 | (erlang-skel-double-separator 2) |
| 1470 | ) |
| 1471 | "*The template of an supervisor behaviour. |
| 1472 | Please see the function `tempo-define-template'.") |
| 1473 | |
| 1474 | (defvar erlang-skel-supervisor-bridge |
| 1475 | '((erlang-skel-include erlang-skel-large-header) |
| 1476 | "-behaviour(supervisor_bridge)." n |
| 1477 | (erlang-skel-separator 2) |
| 1478 | "%% Include files" n |
| 1479 | (erlang-skel-separator 2) |
| 1480 | n |
| 1481 | (erlang-skel-separator 2) |
| 1482 | "%% External exports" n |
| 1483 | (erlang-skel-separator 2) |
| 1484 | "-export([" n> "start_link/0" n |
| 1485 | " ])." n |
| 1486 | n |
| 1487 | (erlang-skel-separator 2) |
| 1488 | "%% Internal exports" n |
| 1489 | (erlang-skel-separator 2) |
| 1490 | "-export([" n> "init/1, " n> "terminate/2" n |
| 1491 | " ])." n |
| 1492 | n |
| 1493 | (erlang-skel-separator 2) |
| 1494 | "%% Macros" n |
| 1495 | (erlang-skel-separator 2) |
| 1496 | "-define(SERVER, ?MODULE)." n |
| 1497 | n |
| 1498 | (erlang-skel-separator 2) |
| 1499 | "%% Records" n |
| 1500 | (erlang-skel-separator 2) |
| 1501 | "-record(state, {})." n |
| 1502 | n |
| 1503 | (erlang-skel-double-separator 2) |
| 1504 | "%% External functions" n |
| 1505 | (erlang-skel-double-separator 2) |
| 1506 | (erlang-skel-separator 2) |
| 1507 | "%% Function: start_link/0" n |
| 1508 | "%% Description: Starts the supervisor bridge" n |
| 1509 | (erlang-skel-separator 2) |
| 1510 | "start_link() ->" n> |
| 1511 | "supervisor_bridge:start_link({local, ?SERVER}, ?MODULE, [])." n |
| 1512 | n |
| 1513 | (erlang-skel-double-separator 2) |
| 1514 | "%% Server functions" n |
| 1515 | (erlang-skel-double-separator 2) |
| 1516 | (erlang-skel-separator 2) |
| 1517 | "%% Func: init/1" n |
| 1518 | "%% Returns: {ok, Pid, State} |" n |
| 1519 | "%% ignore |" n |
| 1520 | "%% {error, Reason} " n |
| 1521 | (erlang-skel-separator 2) |
| 1522 | "init([]) ->" n> |
| 1523 | "case 'AModule':start_link() of" n> |
| 1524 | "{ok, Pid} ->" n> |
| 1525 | "{ok, Pid, #state{}};" n> |
| 1526 | "Error ->" n> |
| 1527 | "Error" n> |
| 1528 | "end." n |
| 1529 | n |
| 1530 | (erlang-skel-separator 2) |
| 1531 | "%% Func: terminate/2" n |
| 1532 | "%% Purpose: Synchronized shutdown of the underlying sub system." n |
| 1533 | "%% Returns: any" n |
| 1534 | (erlang-skel-separator 2) |
| 1535 | "terminate(Reason, State) ->" n> |
| 1536 | "'AModule':stop()," n> |
| 1537 | "ok." n |
| 1538 | n |
| 1539 | (erlang-skel-double-separator 2) |
| 1540 | "%% Internal functions" n |
| 1541 | (erlang-skel-double-separator 2) |
| 1542 | ) |
| 1543 | "*The template of an supervisor_bridge behaviour. |
| 1544 | Please see the function `tempo-define-template'.") |
| 1545 | |
| 1546 | (defvar erlang-skel-generic-server |
| 1547 | '((erlang-skel-include erlang-skel-large-header) |
| 1548 | "-behaviour(gen_server)." n |
| 1549 | (erlang-skel-separator 2) |
| 1550 | "%% Include files" n |
| 1551 | (erlang-skel-separator 2) |
| 1552 | n |
| 1553 | (erlang-skel-separator 2) |
| 1554 | "%% External exports" n |
| 1555 | (erlang-skel-separator 2) |
| 1556 | "-export([" n>"start_link/0,"n>"stop/0"n>"])." n |
| 1557 | n |
| 1558 | (erlang-skel-separator 2) |
| 1559 | "%% gen_server callbacks" n |
| 1560 | (erlang-skel-separator 2) |
| 1561 | "-export([init/1, handle_call/3, handle_cast/2, " |
| 1562 | "handle_info/2, terminate/2, code_change/3])." n n |
| 1563 | (erlang-skel-separator 2) |
| 1564 | "%% record definitions" n |
| 1565 | (erlang-skel-separator 2) |
| 1566 | "-record(state, {})." n n |
| 1567 | (erlang-skel-separator 2) |
| 1568 | "%% macro definitions" n |
| 1569 | (erlang-skel-separator 2) |
| 1570 | "-define(SERVER, ?MODULE)." n |
| 1571 | n |
| 1572 | (erlang-skel-double-separator 2) |
| 1573 | "%% External functions" n |
| 1574 | (erlang-skel-double-separator 2) |
| 1575 | (erlang-skel-separator 2) |
| 1576 | "%% @doc Starts the server." n |
| 1577 | "%% @spec start_link() -> {ok, pid()} | {error, Reason}" n |
| 1578 | "%% @end"n |
| 1579 | (erlang-skel-separator 2) |
| 1580 | "start_link() ->" n> |
| 1581 | "gen_server:start_link({local, ?SERVER}, ?MODULE, [], [])." n |
| 1582 | n |
| 1583 | (erlang-skel-separator 2) |
| 1584 | "%% @doc Stops the server." n |
| 1585 | "%% @spec stop() -> ok" n |
| 1586 | "%% @end"n |
| 1587 | (erlang-skel-separator 2) |
| 1588 | "stop() ->" n> |
| 1589 | "gen_server:cast(?SERVER, stop)." n |
| 1590 | n |
| 1591 | (erlang-skel-double-separator 2) |
| 1592 | "%% Server functions" n |
| 1593 | (erlang-skel-double-separator 2) |
| 1594 | n |
| 1595 | (erlang-skel-separator 2) |
| 1596 | "%% Function: init/1" n |
| 1597 | "%% Description: Initiates the server" n |
| 1598 | "%% Returns: {ok, State} |" n |
| 1599 | "%% {ok, State, Timeout} |" n |
| 1600 | "%% ignore |" n |
| 1601 | "%% {stop, Reason}" n |
| 1602 | (erlang-skel-separator 2) |
| 1603 | "init([]) ->" n> |
| 1604 | "{ok, #state{}}." n |
| 1605 | n |
| 1606 | (erlang-skel-separator 2) |
| 1607 | "%% Function: handle_call/3" n |
| 1608 | "%% Description: Handling call messages" n |
| 1609 | "%% Returns: {reply, Reply, State} |" n |
| 1610 | "%% {reply, Reply, State, Timeout} |" n |
| 1611 | "%% {noreply, State} |" n |
| 1612 | "%% {noreply, State, Timeout} |" n |
| 1613 | "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n |
| 1614 | "%% {stop, Reason, State} (terminate/2 is called)" n |
| 1615 | (erlang-skel-separator 2) |
| 1616 | "handle_call(Request, From, State) ->" n> |
| 1617 | "Reply = ok," n> |
| 1618 | "{reply, Reply, State}." n |
| 1619 | n |
| 1620 | (erlang-skel-separator 2) |
| 1621 | "%% Function: handle_cast/2" n |
| 1622 | "%% Description: Handling cast messages" n |
| 1623 | "%% Returns: {noreply, State} |" n |
| 1624 | "%% {noreply, State, Timeout} |" n |
| 1625 | "%% {stop, Reason, State} (terminate/2 is called)" n |
| 1626 | (erlang-skel-separator 2) |
| 1627 | "handle_cast(stop, State) ->" n> |
| 1628 | "{stop, normal, State};" n |
| 1629 | "handle_cast(Msg, State) ->" n> |
| 1630 | "{noreply, State}." n |
| 1631 | n |
| 1632 | (erlang-skel-separator 2) |
| 1633 | "%% Function: handle_info/2" n |
| 1634 | "%% Description: Handling all non call/cast messages" n |
| 1635 | "%% Returns: {noreply, State} |" n |
| 1636 | "%% {noreply, State, Timeout} |" n |
| 1637 | "%% {stop, Reason, State} (terminate/2 is called)" n |
| 1638 | (erlang-skel-separator 2) |
| 1639 | "handle_info(Info, State) ->" n> |
| 1640 | "{noreply, State}." n |
| 1641 | n |
| 1642 | (erlang-skel-separator 2) |
| 1643 | "%% Function: terminate/2" n |
| 1644 | "%% Description: Shutdown the server" n |
| 1645 | "%% Returns: any (ignored by gen_server)" n |
| 1646 | (erlang-skel-separator 2) |
| 1647 | "terminate(Reason, State) ->" n> |
| 1648 | "ok." n |
| 1649 | n |
| 1650 | (erlang-skel-separator 2) |
| 1651 | "%% Func: code_change/3" n |
| 1652 | "%% Purpose: Convert process state when code is changed" n |
| 1653 | "%% Returns: {ok, NewState}" n |
| 1654 | (erlang-skel-separator 2) |
| 1655 | "code_change(OldVsn, State, Extra) ->" n> |
| 1656 | "{ok, State}." n |
| 1657 | n |
| 1658 | (erlang-skel-double-separator 2) |
| 1659 | "%%% Internal functions" n |
| 1660 | (erlang-skel-double-separator 2) |
| 1661 | ) |
| 1662 | "*The template of a generic server. |
| 1663 | Please see the function `tempo-define-template'.") |
| 1664 | |
| 1665 | (defvar erlang-skel-gen-event |
| 1666 | '((erlang-skel-include erlang-skel-large-header) |
| 1667 | "-behaviour(gen_event)." n |
| 1668 | (erlang-skel-separator 2) |
| 1669 | "%% Include files" n |
| 1670 | (erlang-skel-separator 2) |
| 1671 | n |
| 1672 | (erlang-skel-separator 2) |
| 1673 | "%% External exports" n |
| 1674 | (erlang-skel-separator 2) |
| 1675 | "-export([start_link/0, add_handler/0])." n |
| 1676 | n |
| 1677 | (erlang-skel-separator 2) |
| 1678 | "%% gen_event callbacks" n |
| 1679 | (erlang-skel-separator 2) |
| 1680 | "-export([init/1, handle_event/2, handle_call/2, " |
| 1681 | "handle_info/2, terminate/2, code_change/3])." n n |
| 1682 | (erlang-skel-separator 2) |
| 1683 | "%% Record Definitions" n |
| 1684 | (erlang-skel-separator 2) |
| 1685 | "-record(state, {})." n n |
| 1686 | (erlang-skel-separator 2) |
| 1687 | "%% Macro Definitions" n |
| 1688 | (erlang-skel-separator 2) |
| 1689 | "-define(SERVER, ?MODULE)." n |
| 1690 | n |
| 1691 | (erlang-skel-double-separator 2) |
| 1692 | "%% External functions" n |
| 1693 | (erlang-skel-double-separator 2) |
| 1694 | (erlang-skel-separator 2) |
| 1695 | "%% @doc Starts the server" n |
| 1696 | "%% @spec start_link() -> {ok, Pid} | {error, {already_started, Pid}}" n |
| 1697 | "%% @end" n |
| 1698 | (erlang-skel-separator 2) |
| 1699 | "start_link() ->" n> |
| 1700 | "gen_event:start_link({local, ?SERVER}). " n |
| 1701 | n |
| 1702 | (erlang-skel-separator 2) |
| 1703 | "%% @doc Adds an event handler" n |
| 1704 | "%% @spec add_handler() -> ok | {'EXIT', Reason}" n |
| 1705 | "%% @end" n |
| 1706 | (erlang-skel-separator 2) |
| 1707 | "add_handler() ->" n> |
| 1708 | "gen_event:add_handler(?SERVER, ?MODULE, [])." n |
| 1709 | n |
| 1710 | (erlang-skel-double-separator 2) |
| 1711 | "%% Server functions" n |
| 1712 | (erlang-skel-double-separator 2) |
| 1713 | (erlang-skel-separator 2) |
| 1714 | "%% Func: init/1" n |
| 1715 | "%% Returns: {ok, State} |" n |
| 1716 | "%% Other" n |
| 1717 | (erlang-skel-separator 2) |
| 1718 | "init([]) ->" n> |
| 1719 | "{ok, #state{}}." n |
| 1720 | n |
| 1721 | (erlang-skel-separator 2) |
| 1722 | "%% Func: handle_event/2" n |
| 1723 | "%% Returns: {ok, State} |" n |
| 1724 | "%% {swap_handler, Args1, State1, Mod2, Args2} |" n |
| 1725 | "%% remove_handler " n |
| 1726 | (erlang-skel-separator 2) |
| 1727 | "handle_event(Event, State) ->" n> |
| 1728 | "{ok, State}." n |
| 1729 | n |
| 1730 | (erlang-skel-separator 2) |
| 1731 | "%% Func: handle_call/2" n |
| 1732 | "%% Returns: {ok, Reply, State} |" n |
| 1733 | "%% {swap_handler, Reply, Args1, State1, Mod2, Args2} |" n |
| 1734 | "%% {remove_handler, Reply} " n |
| 1735 | (erlang-skel-separator 2) |
| 1736 | "handle_call(Request, State) ->" n> |
| 1737 | "Reply = ok," n> |
| 1738 | "{ok, Reply, State}." n |
| 1739 | n |
| 1740 | (erlang-skel-separator 2) |
| 1741 | "%% Func: handle_info/2" n |
| 1742 | "%% Returns: {ok, State} |" n |
| 1743 | "%% {swap_handler, Args1, State1, Mod2, Args2} |" n |
| 1744 | "%% remove_handler " n |
| 1745 | (erlang-skel-separator 2) |
| 1746 | "handle_info(Info, State) ->" n> |
| 1747 | "{ok, State}." n |
| 1748 | n |
| 1749 | (erlang-skel-separator 2) |
| 1750 | "%% Func: terminate/2" n |
| 1751 | "%% Purpose: Shutdown the server" n |
| 1752 | "%% Returns: any" n |
| 1753 | (erlang-skel-separator 2) |
| 1754 | "terminate(Reason, State) ->" n> |
| 1755 | "ok." n |
| 1756 | n |
| 1757 | (erlang-skel-separator 2) |
| 1758 | "%% Func: code_change/3" n |
| 1759 | "%% Purpose: Convert process state when code is changed" n |
| 1760 | "%% Returns: {ok, NewState}" n |
| 1761 | (erlang-skel-separator 2) |
| 1762 | "code_change(OldVsn, State, Extra) ->" n> |
| 1763 | "{ok, State}." n |
| 1764 | n |
| 1765 | (erlang-skel-separator 2) |
| 1766 | "%%% Internal functions" n |
| 1767 | (erlang-skel-separator 2) |
| 1768 | ) |
| 1769 | "*The template of a gen_event. |
| 1770 | Please see the function `tempo-define-template'.") |
| 1771 | |
| 1772 | (defvar erlang-skel-gen-fsm |
| 1773 | '((erlang-skel-include erlang-skel-large-header) |
| 1774 | "-behaviour(gen_fsm)." n |
| 1775 | (erlang-skel-separator 2) |
| 1776 | "%% Include files" n |
| 1777 | (erlang-skel-separator 2) |
| 1778 | n |
| 1779 | (erlang-skel-separator 2) |
| 1780 | "%% External exports" n |
| 1781 | "-export([start_link/0])." n |
| 1782 | n |
| 1783 | "%% gen_fsm callbacks" n |
| 1784 | "-export([init/1, state_name/2, state_name/3, handle_event/3," n> |
| 1785 | "handle_sync_event/4, handle_info/3, terminate/3, code_change/4])." n n |
| 1786 | "-record(state, {})." n |
| 1787 | n |
| 1788 | (erlang-skel-double-separator 2) |
| 1789 | "%% External functions" n |
| 1790 | (erlang-skel-double-separator 2) |
| 1791 | (erlang-skel-separator 2) |
| 1792 | "%% Function: start_link/0" n |
| 1793 | "%% Description: Starts the server" n |
| 1794 | (erlang-skel-separator 2) |
| 1795 | "start_link() ->" n> |
| 1796 | "gen_fsm:start_link({local, ?SERVER}, ?MODULE, [], [])." n |
| 1797 | n |
| 1798 | (erlang-skel-double-separator 2) |
| 1799 | "%% Server functions" n |
| 1800 | (erlang-skel-double-separator 2) |
| 1801 | (erlang-skel-separator 2) |
| 1802 | "%% Func: init/1" n |
| 1803 | "%% Returns: {ok, StateName, StateData} |" n |
| 1804 | "%% {ok, StateName, StateData, Timeout} |" n |
| 1805 | "%% ignore |" n |
| 1806 | "%% {stop, StopReason} " n |
| 1807 | (erlang-skel-separator 2) |
| 1808 | "init([]) ->" n> |
| 1809 | "{ok, state_name, #state{}}." n |
| 1810 | n |
| 1811 | (erlang-skel-separator 2) |
| 1812 | "%% Func: StateName/2" n |
| 1813 | "%% Returns: {next_state, NextStateName, NextStateData} |" n |
| 1814 | "%% {next_state, NextStateName, NextStateData, Timeout} |" n |
| 1815 | "%% {stop, Reason, NewStateData} " n |
| 1816 | (erlang-skel-separator 2) |
| 1817 | "state_name(Event, StateData) ->" n> |
| 1818 | "{next_state, state_name, StateData}." n |
| 1819 | n |
| 1820 | (erlang-skel-separator 2) |
| 1821 | "%% Func: StateName/3" n |
| 1822 | "%% Returns: {next_state, NextStateName, NextStateData} |" n |
| 1823 | "%% {next_state, NextStateName, NextStateData, Timeout} |" n |
| 1824 | "%% {reply, Reply, NextStateName, NextStateData} |" n |
| 1825 | "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n |
| 1826 | "%% {stop, Reason, NewStateData} |" n |
| 1827 | "%% {stop, Reason, Reply, NewStateData} " n |
| 1828 | (erlang-skel-separator 2) |
| 1829 | "state_name(Event, From, StateData) ->" n> |
| 1830 | "Reply = ok," n> |
| 1831 | "{reply, Reply, state_name, StateData}." n |
| 1832 | n |
| 1833 | (erlang-skel-separator 2) |
| 1834 | "%% Func: handle_event/3" n |
| 1835 | "%% Returns: {next_state, NextStateName, NextStateData} |" n |
| 1836 | "%% {next_state, NextStateName, NextStateData, Timeout} |" n |
| 1837 | "%% {stop, Reason, NewStateData} " n |
| 1838 | (erlang-skel-separator 2) |
| 1839 | "handle_event(Event, StateName, StateData) ->" n> |
| 1840 | "{next_state, StateName, StateData}." n |
| 1841 | n |
| 1842 | (erlang-skel-separator 2) |
| 1843 | "%% Func: handle_sync_event/4" n |
| 1844 | "%% Returns: {next_state, NextStateName, NextStateData} |" n |
| 1845 | "%% {next_state, NextStateName, NextStateData, Timeout} |" n |
| 1846 | "%% {reply, Reply, NextStateName, NextStateData} |" n |
| 1847 | "%% {reply, Reply, NextStateName, NextStateData, Timeout} |" n |
| 1848 | "%% {stop, Reason, NewStateData} |" n |
| 1849 | "%% {stop, Reason, Reply, NewStateData} " n |
| 1850 | (erlang-skel-separator 2) |
| 1851 | "handle_sync_event(Event, From, StateName, StateData) ->" n> |
| 1852 | "Reply = ok," n> |
| 1853 | "{reply, Reply, StateName, StateData}." n |
| 1854 | n |
| 1855 | (erlang-skel-separator 2) |
| 1856 | "%% Func: handle_info/3" n |
| 1857 | "%% Returns: {next_state, NextStateName, NextStateData} |" n |
| 1858 | "%% {next_state, NextStateName, NextStateData, Timeout} |" n |
| 1859 | "%% {stop, Reason, NewStateData} " n |
| 1860 | (erlang-skel-separator 2) |
| 1861 | "handle_info(Info, StateName, StateData) ->" n> |
| 1862 | "{next_state, StateName, StateData}." n |
| 1863 | n |
| 1864 | (erlang-skel-separator 2) |
| 1865 | "%% Func: terminate/3" n |
| 1866 | "%% Purpose: Shutdown the fsm" n |
| 1867 | "%% Returns: any" n |
| 1868 | (erlang-skel-separator 2) |
| 1869 | "terminate(Reason, StateName, StatData) ->" n> |
| 1870 | "ok." n |
| 1871 | n |
| 1872 | (erlang-skel-separator 2) |
| 1873 | "%% Func: code_change/4" n |
| 1874 | "%% Purpose: Convert process state when code is changed" n |
| 1875 | "%% Returns: {ok, NewState, NewStateData}" n |
| 1876 | (erlang-skel-separator 2) |
| 1877 | "code_change(OldVsn, StateName, StateData, Extra) ->" n> |
| 1878 | "{ok, StateName, StateData}." n |
| 1879 | n |
| 1880 | (erlang-skel-separator 2) |
| 1881 | "%%% Internal functions" n |
| 1882 | (erlang-skel-separator 2) |
| 1883 | ) |
| 1884 | "*The template of a gen_fsm. |
| 1885 | Please see the function `tempo-define-template'.") |
| 1886 | |
| 1887 | (defvar erlang-skel-lib |
| 1888 | '((erlang-skel-include erlang-skel-large-header) |
| 1889 | (erlang-skel-separator 2) |
| 1890 | "%% Include files" n |
| 1891 | (erlang-skel-separator 2) |
| 1892 | n |
| 1893 | (erlang-skel-separator 2) |
| 1894 | "%% External exports" n |
| 1895 | (erlang-skel-separator 2) |
| 1896 | "-export([" n |
| 1897 | " ])." n |
| 1898 | n |
| 1899 | (erlang-skel-separator 2) |
| 1900 | "%% Internal exports" n |
| 1901 | (erlang-skel-separator 2) |
| 1902 | "-export([" n |
| 1903 | " ])." n |
| 1904 | n |
| 1905 | (erlang-skel-separator 2) |
| 1906 | "%% Macros" n |
| 1907 | (erlang-skel-separator 2) |
| 1908 | n |
| 1909 | (erlang-skel-separator 2) |
| 1910 | "%% Records" n |
| 1911 | (erlang-skel-separator 2) |
| 1912 | n |
| 1913 | (erlang-skel-double-separator 2) |
| 1914 | "%% External functions" n |
| 1915 | (erlang-skel-double-separator 2) |
| 1916 | (erlang-skel-separator 2) |
| 1917 | "%% @doc" n |
| 1918 | "%% @spec " n |
| 1919 | "%% @end " n |
| 1920 | (erlang-skel-separator 2) |
| 1921 | n |
| 1922 | (erlang-skel-double-separator 2) |
| 1923 | "%% Internal functions" n |
| 1924 | (erlang-skel-double-separator 2) |
| 1925 | ) |
| 1926 | "*The template of a library module. |
| 1927 | Please see the function `tempo-define-template'.") |
| 1928 | |
| 1929 | |
| 1930 | (defvar erlang-skel-generic-leader |
| 1931 | '((erlang-skel-include erlang-skel-large-header) |
| 1932 | "-behaviour(fs_gen_leader)." n |
| 1933 | (erlang-skel-separator 2) |
| 1934 | "%% Include files" n |
| 1935 | (erlang-skel-separator 2) |
| 1936 | n |
| 1937 | (erlang-skel-separator 2) |
| 1938 | "%% External exports" n |
| 1939 | (erlang-skel-separator 2) |
| 1940 | "-export([" n>"start_link/0,"n>"stop/0"n>"])." n |
| 1941 | n |
| 1942 | (erlang-skel-separator 2) |
| 1943 | "%% gen_leader callbacks" n |
| 1944 | (erlang-skel-separator 2) |
| 1945 | "-export([init/1," n> |
| 1946 | "elected/2," n> |
| 1947 | "surrendered/3," n> |
| 1948 | "handle_DOWN/3," n> |
| 1949 | "handle_leader_call/4," n> |
| 1950 | "handle_leader_cast/3," n> |
| 1951 | "from_leader/3," n> |
| 1952 | "handle_call/3," n> |
| 1953 | "handle_cast/2," n> |
| 1954 | "handle_info/2," n> |
| 1955 | "terminate/2," n> |
| 1956 | "code_change/4" n> |
| 1957 | "])." n> |
| 1958 | (erlang-skel-separator 2) |
| 1959 | "%% record definitions" n |
| 1960 | (erlang-skel-separator 2) |
| 1961 | "-record(state, {})." n n |
| 1962 | (erlang-skel-separator 2) |
| 1963 | "%% macro definitions" n |
| 1964 | (erlang-skel-separator 2) |
| 1965 | "-define(SERVER, ?MODULE)." n |
| 1966 | n |
| 1967 | (erlang-skel-double-separator 2) |
| 1968 | "%% External functions" n |
| 1969 | (erlang-skel-double-separator 2) |
| 1970 | (erlang-skel-separator 2) |
| 1971 | "%% @doc Starts the gen_leader." n |
| 1972 | "%% @spec start_link() -> {ok, pid()} | {error, Reason}" n |
| 1973 | "%% @end"n |
| 1974 | (erlang-skel-separator 2) |
| 1975 | "start_link() ->" n> |
| 1976 | "Candidates = [node()|nodes()]," n> |
| 1977 | "Workers = []," n> |
| 1978 | "gen_leader:start_link({local, ?SERVER}, Candidates, Workers, ?MODULE, [], [])." n |
| 1979 | n |
| 1980 | (erlang-skel-separator 2) |
| 1981 | "%% @doc Stops the gen_leader." n |
| 1982 | "%% @spec stop() -> ok" n |
| 1983 | "%% @end"n |
| 1984 | (erlang-skel-separator 2) |
| 1985 | "stop() ->" n> |
| 1986 | "gen_leader:cast(?SERVER, stop)." n |
| 1987 | n |
| 1988 | (erlang-skel-double-separator 2) |
| 1989 | "%% Server functions" n |
| 1990 | (erlang-skel-double-separator 2) |
| 1991 | n |
| 1992 | |
| 1993 | |
| 1994 | |
| 1995 | (erlang-skel-separator 2) |
| 1996 | "%% Function: init/1" n> |
| 1997 | "%% Description: Initiates the server" n> |
| 1998 | "%% Returns: {ok, State} |" n> |
| 1999 | "%% {ok, State, Timeout} |" n> |
| 2000 | "%% ignore |" n> |
| 2001 | "%% {stop, Reason}" n> |
| 2002 | (erlang-skel-separator 2) |
| 2003 | "init([]) ->" n> |
| 2004 | "{ok, #state{}}." n |
| 2005 | n |
| 2006 | |
| 2007 | (erlang-skel-separator 2) |
| 2008 | "%% Called when we become the leader." n> |
| 2009 | "%%" n> |
| 2010 | "%% elected(State::state(), E::election()) -> {ok, Broadcast, NState}" n> |
| 2011 | (erlang-skel-separator 2) |
| 2012 | "elected(State, E) ->" n> |
| 2013 | "BroadcastToAllCandidates = [],"n> |
| 2014 | "{ok, BroadcastToAllCandidates , State}." n |
| 2015 | n |
| 2016 | |
| 2017 | (erlang-skel-separator 2) |
| 2018 | "%% Called by each candidate when it recognizes another instance as leader." n> |
| 2019 | "%% Strictly speaking, this function is called when the candidate " n> |
| 2020 | "%% acknowledges a leader and receives a Synch message in return." n> |
| 2021 | "%%" n> |
| 2022 | "%% surrendered(State::state(), Synch::broadcast(), E::election()) -> {ok, NState}" n> |
| 2023 | (erlang-skel-separator 2) |
| 2024 | "surrendered(State, BCastFromLeaderElectedCall, E) ->" n> |
| 2025 | "{ok, State#state{leader_node = LeaderNode}}."n |
| 2026 | n |
| 2027 | |
| 2028 | (erlang-skel-separator 2) |
| 2029 | "%% Called by the leader when it detects loss of a candidate node." n> |
| 2030 | "%% If the function returns a broadcast() object, this will" n> |
| 2031 | "%% be sent to all candidates, and they will receive it in the function" n> |
| 2032 | "%% link from_leader/3. from_leader/3" n> |
| 2033 | "%%" n> |
| 2034 | "%% handle_DOWN(Node::node(), State::state(), E::election()) -> {ok, NState} | {ok, Broadcast, NState}" n> |
| 2035 | (erlang-skel-separator 2) |
| 2036 | "handle_DOWN(Node, State, _E) ->" n> |
| 2037 | "{ok, State}." n> |
| 2038 | |
| 2039 | (erlang-skel-separator 2) |
| 2040 | "%% handle_leader_call(Msg::term(), From::callerRef(), State::state(), E::election()) -> " n> |
| 2041 | "%% {reply, Reply, NState} |" n> |
| 2042 | "%% {reply, Reply, Broadcast, NState} |" n> |
| 2043 | "%% {noreply, state()} |" n> |
| 2044 | "%% {stop, Reason, Reply, NState} |" n> |
| 2045 | "%% commonReply()" n> |
| 2046 | "%%" n> |
| 2047 | "%% Called by the leader in response to a gen_leader:leader_call/2. leader_call()." n> |
| 2048 | (erlang-skel-separator 2) |
| 2049 | "handle_leader_call(Msg, _From, State, _E) ->" n> |
| 2050 | "{reply, Reply = [], State}." n |
| 2051 | n |
| 2052 | |
| 2053 | (erlang-skel-separator 2) |
| 2054 | "%% Called by the leader in response to a gen_leader:leader_cast/2 leader_cast()" n> |
| 2055 | "%% handle_leader_cast(Msg::term(), State::term(), E::election()) -> commonReply()" n> |
| 2056 | "%%" n> |
| 2057 | "%% BUG: This has not yet been implemented." n> |
| 2058 | (erlang-skel-separator 2) |
| 2059 | "handle_leader_cast(_Msg, State, _E) ->" n> |
| 2060 | "{ok, State}." n |
| 2061 | n |
| 2062 | |
| 2063 | (erlang-skel-separator 2) |
| 2064 | "%% Called by each candidate in response to a message from the leader. " n> |
| 2065 | "%% In this particular module, the leader passes an update function to be " n> |
| 2066 | "%% applied to the candidate's state. " n> |
| 2067 | "%% " n> |
| 2068 | "%% from_leader(Msg::term(), State::state(), E::election()) -> {ok, NState} " n> |
| 2069 | (erlang-skel-separator 2) |
| 2070 | "from_leader(MSG, State, _E) -> " n> |
| 2071 | "{ok, State}. " n |
| 2072 | n |
| 2073 | |
| 2074 | n |
| 2075 | (erlang-skel-separator 2) |
| 2076 | "%% Function: handle_call/3" n |
| 2077 | "%% Description: Handling call messages" n |
| 2078 | "%% Returns: {reply, Reply, State} |" n |
| 2079 | "%% {reply, Reply, State, Timeout} |" n |
| 2080 | "%% {noreply, State} |" n |
| 2081 | "%% {noreply, State, Timeout} |" n |
| 2082 | "%% {stop, Reason, Reply, State} | (terminate/2 is called)" n |
| 2083 | "%% {stop, Reason, State} (terminate/2 is called)" n |
| 2084 | (erlang-skel-separator 2) |
| 2085 | "handle_call(Request, From, State) ->" n> |
| 2086 | "Reply = ok," n> |
| 2087 | "{reply, Reply, State}." n |
| 2088 | n |
| 2089 | (erlang-skel-separator 2) |
| 2090 | "%% Function: handle_cast/2" n |
| 2091 | "%% Description: Handling cast messages" n |
| 2092 | "%% Returns: {noreply, State} |" n |
| 2093 | "%% {noreply, State, Timeout} |" n |
| 2094 | "%% {stop, Reason, State} (terminate/2 is called)" n |
| 2095 | (erlang-skel-separator 2) |
| 2096 | "handle_cast(stop, State) ->" n> |
| 2097 | "{stop, normal, State};" n |
| 2098 | "handle_cast(Msg, State) ->" n> |
| 2099 | "{noreply, State}." n |
| 2100 | n |
| 2101 | (erlang-skel-separator 2) |
| 2102 | "%% Function: handle_info/2" n |
| 2103 | "%% Description: Handling all non call/cast messages" n |
| 2104 | "%% Returns: {noreply, State} |" n |
| 2105 | "%% {noreply, State, Timeout} |" n |
| 2106 | "%% {stop, Reason, State} (terminate/2 is called)" n |
| 2107 | (erlang-skel-separator 2) |
| 2108 | "handle_info(Info, State) ->" n> |
| 2109 | "{noreply, State}." n |
| 2110 | n |
| 2111 | (erlang-skel-separator 2) |
| 2112 | "%% Function: terminate/2" n |
| 2113 | "%% Description: Shutdown the server" n |
| 2114 | "%% Returns: any (ignored by gen_server)" n |
| 2115 | (erlang-skel-separator 2) |
| 2116 | "terminate(Reason, State) ->" n> |
| 2117 | "ok." n |
| 2118 | n |
| 2119 | (erlang-skel-separator 2) |
| 2120 | "%% Func: code_change/3" n |
| 2121 | "%% Purpose: Convert process state when code is changed" n |
| 2122 | "%% Returns: {ok, NewState}" n |
| 2123 | (erlang-skel-separator 2) |
| 2124 | "code_change(OldVsn, State, _E, _Extra) ->" n> |
| 2125 | "{ok, State}." n |
| 2126 | n |
| 2127 | |
| 2128 | n |
| 2129 | (erlang-skel-separator 2) |
| 2130 | "%%% Internal functions" n |
| 2131 | (erlang-skel-separator 2) |
| 2132 | ) |
| 2133 | "*The template of a generic leader. |
| 2134 | Please see the function `tempo-define-template'.") |
| 2135 | |
| 2136 | |
| 2137 | (defvar erlang-skel-corba-callback |
| 2138 | '((erlang-skel-include erlang-skel-large-header) |
| 2139 | (erlang-skel-separator 2) |
| 2140 | "%% Include files" n |
| 2141 | (erlang-skel-separator 2) |
| 2142 | n |
| 2143 | (erlang-skel-separator 2) |
| 2144 | "%% External exports" n |
| 2145 | (erlang-skel-separator 2) |
| 2146 | "-export([" n> "init/1, " n> "terminate/2," n> "code_change/3" n |
| 2147 | " ])." n |
| 2148 | n |
| 2149 | (erlang-skel-separator 2) |
| 2150 | "%% Internal exports" n |
| 2151 | (erlang-skel-separator 2) |
| 2152 | "-export([" n |
| 2153 | " ])." n |
| 2154 | n |
| 2155 | (erlang-skel-separator 2) |
| 2156 | "%% Macros" n |
| 2157 | (erlang-skel-separator 2) |
| 2158 | n |
| 2159 | (erlang-skel-separator 2) |
| 2160 | "%% Records" n |
| 2161 | (erlang-skel-separator 2) |
| 2162 | "-record(state, {})." n |
| 2163 | n |
| 2164 | (erlang-skel-double-separator 2) |
| 2165 | "%% External functions" n |
| 2166 | (erlang-skel-double-separator 2) |
| 2167 | (erlang-skel-separator 2) |
| 2168 | "%% Function: init/1" n |
| 2169 | "%% Description: Initiates the server" n |
| 2170 | "%% Returns: {ok, State} |" n |
| 2171 | "%% {ok, State, Timeout} |" n |
| 2172 | "%% ignore |" n |
| 2173 | "%% {stop, Reason}" n |
| 2174 | (erlang-skel-separator 2) |
| 2175 | "init([]) ->" n> |
| 2176 | "{ok, #state{}}." n |
| 2177 | n |
| 2178 | (erlang-skel-separator 2) |
| 2179 | "%% Function: terminate/2" n |
| 2180 | "%% Description: Shutdown the server" n |
| 2181 | "%% Returns: any (ignored by gen_server)" n |
| 2182 | (erlang-skel-separator 2) |
| 2183 | "terminate(Reason, State) ->" n> |
| 2184 | "ok." n |
| 2185 | n |
| 2186 | (erlang-skel-separator 2) |
| 2187 | "%% Function: code_change/3" n |
| 2188 | "%% Description: Convert process state when code is changed" n |
| 2189 | "%% Returns: {ok, NewState}" n |
| 2190 | (erlang-skel-separator 2) |
| 2191 | "code_change(OldVsn, State, Extra) ->" n> |
| 2192 | "{ok, State}." n |
| 2193 | n |
| 2194 | (erlang-skel-double-separator 2) |
| 2195 | "%% Internal functions" n |
| 2196 | (erlang-skel-double-separator 2) |
| 2197 | ) |
| 2198 | "*The template of a library module. |
| 2199 | Please see the function `tempo-define-template'.") |
| 2200 | |
| 2201 | |
| 2202 | |
| 2203 | ;; Font-lock variables |
| 2204 | |
| 2205 | (defvar erlang-font-lock-modern-p |
| 2206 | (cond ((>= erlang-emacs-major-version 20) t) |
| 2207 | (erlang-xemacs-p (>= erlang-emacs-minor-version 14)) |
| 2208 | ((= erlang-emacs-major-version 19) (>= erlang-emacs-minor-version 29)) |
| 2209 | (t nil)) |
| 2210 | "Non-nil when this version of Emacs uses a modern version of Font Lock. |
| 2211 | |
| 2212 | This is determinated by checking the version of Emacs used, the actual |
| 2213 | font-lock code is not loaded.") |
| 2214 | |
| 2215 | |
| 2216 | ;; The next few variables define different Erlang font-lock patterns. |
| 2217 | ;; They could be appended to form a custom font-lock appearence. |
| 2218 | ;; |
| 2219 | ;; The function `erlang-font-lock-set-face' could be used to change |
| 2220 | ;; the face of a pattern. |
| 2221 | ;; |
| 2222 | ;; Note that Erlang strings and atoms are hightlighted with using |
| 2223 | ;; syntactix analysis. |
| 2224 | |
| 2225 | (defvar erlang-font-lock-keywords-func |
| 2226 | (list |
| 2227 | (list (concat "^" erlang-atom-regexp "\\s *(") |
| 2228 | 1 'font-lock-function-name-face t)) |
| 2229 | "Font lock keyword highlighting a function header.") |
| 2230 | |
| 2231 | (defvar erlang-font-lock-keywords-dollar |
| 2232 | (list |
| 2233 | (list "\\(\\$\\([^\\]\\|\\\\\\([^0-7^\n]\\|[0-7]+\\|\\^[a-zA-Z]\\)\\)\\)" |
| 2234 | 1 'font-lock-string-face)) |
| 2235 | "Font lock keyword highlighting numbers in ascii-form (e.g. $A).") |
| 2236 | |
| 2237 | (defvar erlang-font-lock-keywords-arrow |
| 2238 | (list |
| 2239 | (list "\\(->\\|:-\\)\\(\\s \\|$\\)" 2 'font-lock-function-name-face)) |
| 2240 | "Font lock keyword highlighting clause arrow.") |
| 2241 | |
| 2242 | (defvar erlang-font-lock-keywords-lc |
| 2243 | (list |
| 2244 | (list "\\(<-\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face) |
| 2245 | (list "\\(||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) |
| 2246 | "Font lock keyword highlighting list comprehension operators.") |
| 2247 | |
| 2248 | (defvar erlang-font-lock-keywords-keywords |
| 2249 | (list |
| 2250 | (list (concat "\\<\\(after\\|begin\\|c\\(atch\\|ase\\)\\|end\\|fun\\|if" |
| 2251 | "\\|of\\|receive\\|when\\|query\\)\\([^a-zA-Z0-9_]\\|$\\)") |
| 2252 | 1 'font-lock-keyword-face)) |
| 2253 | "Font lock keyword highlighting Erlang keywords.") |
| 2254 | |
| 2255 | (defvar erlang-font-lock-keywords-attr |
| 2256 | (list |
| 2257 | (list (concat "^\\(-" erlang-atom-regexp "\\)\\s *\\(\\.\\|(\\)") |
| 2258 | 1 'font-lock-function-name-face)) |
| 2259 | "Font lock keyword highlighting attribues.") |
| 2260 | |
| 2261 | (defvar erlang-font-lock-keywords-quotes |
| 2262 | (list |
| 2263 | (list "`\\([-+a-zA-Z0-9_:*][-+a-zA-Z0-9_:*]+\\)'" |
| 2264 | 1 |
| 2265 | (if erlang-font-lock-modern-p |
| 2266 | 'font-lock-reference-face |
| 2267 | 'font-lock-keyword-face) |
| 2268 | t)) |
| 2269 | "Font lock keyword highlighting words in single quotes in comments. |
| 2270 | |
| 2271 | This is not the keyword hightlighting Erlang strings and atoms, they |
| 2272 | are highlighted by syntactic analysis.") |
| 2273 | |
| 2274 | ;; Note: The guard `float' collides with the bif `float'. |
| 2275 | (defvar erlang-font-lock-keywords-guards |
| 2276 | (list |
| 2277 | (list |
| 2278 | |
| 2279 | ;; XXX: |
| 2280 | ; (concat "\\<" |
| 2281 | ; (regexp-opt '("atom" "binary" "constant" "float" "integer" "list" |
| 2282 | ; "number" "pid" "port" "reference" "record" "tuple") |
| 2283 | ; t) |
| 2284 | ; "\\>") |
| 2285 | |
| 2286 | (concat "\\<\\(atom\\|binary\\|constant\\|float\\|integer\\|list\\|" |
| 2287 | "number\\|p\\(id\\|ort\\)\\|re\\(ference\\|cord\\)\\|tuple" |
| 2288 | "\\)\\s *(") |
| 2289 | |
| 2290 | 1 |
| 2291 | (if erlang-font-lock-modern-p |
| 2292 | 'font-lock-reference-face |
| 2293 | 'font-lock-keyword-face))) |
| 2294 | "Font lock keyword highlighting guards.") |
| 2295 | |
| 2296 | (defvar erlang-font-lock-keywords-bifs |
| 2297 | (list |
| 2298 | (list |
| 2299 | (concat |
| 2300 | "\\<\\(" |
| 2301 | "a\\(bs\\|live\\|pply\\|tom_to_list\\)\\|" |
| 2302 | "binary_to_\\(list\\|term\\)\\|" |
| 2303 | "concat_binary\\|d\\(ate\\|isconnect_node\\)\\|" |
| 2304 | "e\\(lement\\|rase\\|xit\\)\\|" |
| 2305 | "float\\(\\|_to_list\\)\\|" |
| 2306 | "g\\(arbage_collect\\|et\\(\\|_keys\\)\\|roup_leader\\)\\|" |
| 2307 | "h\\(alt\\|d\\)\\|" |
| 2308 | "i\\(nte\\(ger_to_list\\|rnal_bif\\)\\|s_alive\\)\\|" |
| 2309 | "l\\(ength\\|i\\(nk\\|st_to_\\(atom\\|binary\\|float\\|integer" |
| 2310 | "\\|pid\\|tuple\\)\\)\\)\\|" |
| 2311 | "make_ref\\|no\\(de\\(\\|_\\(link\\|unlink\\)\\|s\\)\\|talive\\)\\|" |
| 2312 | "open_port\\|" |
| 2313 | "p\\(id_to_list\\|rocess\\(_\\(flag\\|info\\)\\|es\\)\\|ut\\)\\|" |
| 2314 | "r\\(egister\\(\\|ed\\)\\|ound\\)\\|" |
| 2315 | "s\\(e\\(lf\\|telement\\)\\|ize\\|" |
| 2316 | "p\\(awn\\(\\|_link\\)\\|lit_binary\\)\\|tatistics\\)\\|" |
| 2317 | "t\\(erm_to_binary\\|hrow\\|ime\\|l\\|" |
| 2318 | "r\\(ace\\|unc\\)\\|uple_to_list\\)\\|" |
| 2319 | "un\\(link\\|register\\)\\|whereis" |
| 2320 | "\\)\\s *(") |
| 2321 | 1 |
| 2322 | 'font-lock-keyword-face)) |
| 2323 | "Font lock keyword highlighting built in functions.") |
| 2324 | |
| 2325 | (defvar erlang-font-lock-keywords-macros |
| 2326 | (list |
| 2327 | (list (concat "?\\s *\\(" erlang-atom-regexp |
| 2328 | "\\|" erlang-variable-regexp "\\)\\>") |
| 2329 | 1 (if erlang-font-lock-modern-p |
| 2330 | 'font-lock-reference-face |
| 2331 | 'font-lock-type-face)) |
| 2332 | (list (concat "^-\\(define\\|ifn?def\\)\\s *(\\s *\\(" erlang-atom-regexp |
| 2333 | "\\|" erlang-variable-regexp "\\)\\>") |
| 2334 | 2 (if erlang-font-lock-modern-p |
| 2335 | 'font-lock-reference-face |
| 2336 | 'font-lock-type-face))) |
| 2337 | "Font lock keyword highlighting macros. |
| 2338 | This must be placed in front of `erlang-font-lock-keywords-vars'.") |
| 2339 | |
| 2340 | (defvar erlang-font-lock-keywords-records |
| 2341 | (list |
| 2342 | (list (concat "#\\s *" erlang-atom-regexp "\\>") |
| 2343 | 1 'font-lock-type-face) |
| 2344 | ;; Don't highlight numerical constants. |
| 2345 | (list "\\<[0-9][0-9]?#\\([0-9a-fA_F]+\\)\\>" |
| 2346 | 1 nil t) |
| 2347 | (list (concat "^-record(\\s *" erlang-atom-regexp "\\>") |
| 2348 | 1 'font-lock-type-face)) |
| 2349 | "Font lock keyword highlighting Erlang records. |
| 2350 | This must be placed in front of `erlang-font-lock-keywords-vars'.") |
| 2351 | |
| 2352 | (defvar erlang-font-lock-keywords-vars |
| 2353 | (list |
| 2354 | (list (concat "\\<" erlang-variable-regexp "\\>") |
| 2355 | 1 (if erlang-font-lock-modern-p |
| 2356 | 'font-lock-variable-name-face |
| 2357 | 'font-lock-type-face))) |
| 2358 | "Font lock keyword highlighting Erlang variables. |
| 2359 | Must be preceded by `erlang-font-lock-keywords-macros' and `-records' |
| 2360 | to work properly.") |
| 2361 | |
| 2362 | |
| 2363 | (defvar erlang-font-lock-keywords-1 |
| 2364 | (append erlang-font-lock-keywords-func |
| 2365 | erlang-font-lock-keywords-dollar |
| 2366 | erlang-font-lock-keywords-arrow |
| 2367 | erlang-font-lock-keywords-keywords) |
| 2368 | ;; DocStringOrig: erlang-font-lock-keywords |
| 2369 | "Font-lock keywords used by Erlang Mode. |
| 2370 | |
| 2371 | There exists three levels of Font Lock keywords for Erlang: |
| 2372 | `erlang-font-lock-keywords-1' - Function headers and reserved keywords. |
| 2373 | `erlang-font-lock-keywords-2' - Bifs, guards and `singel quotes'. |
| 2374 | `erlang-font-lock-keywords-3' - Variables, macros and records. |
| 2375 | |
| 2376 | To use a specific level, please set the variable |
| 2377 | `font-lock-maximum-decoration' to the appropriate level. Note that the |
| 2378 | variable must be set before Erlang mode is activated. |
| 2379 | |
| 2380 | Example: |
| 2381 | (setq font-lock-maximum-decoration 2)") |
| 2382 | |
| 2383 | |
| 2384 | (defvar erlang-font-lock-keywords-2 |
| 2385 | (append erlang-font-lock-keywords-1 |
| 2386 | erlang-font-lock-keywords-attr |
| 2387 | erlang-font-lock-keywords-quotes |
| 2388 | erlang-font-lock-keywords-guards |
| 2389 | erlang-font-lock-keywords-bifs) |
| 2390 | ;; DocStringCopy: erlang-font-lock-keywords |
| 2391 | "Font-lock keywords used by Erlang Mode. |
| 2392 | |
| 2393 | There exists three levels of Font Lock keywords for Erlang: |
| 2394 | `erlang-font-lock-keywords-1' - Function headers and reserved keywords. |
| 2395 | `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. |
| 2396 | `erlang-font-lock-keywords-3' - Variables, macros and records. |
| 2397 | |
| 2398 | To use a specific level, please set the variable |
| 2399 | `font-lock-maximum-decoration' to the appropriate level. Note that the |
| 2400 | variable must be set before Erlang mode is activated. |
| 2401 | |
| 2402 | Example: |
| 2403 | (setq font-lock-maximum-decoration 2)") |
| 2404 | |
| 2405 | |
| 2406 | (defvar erlang-font-lock-keywords-3 |
| 2407 | (append erlang-font-lock-keywords-2 |
| 2408 | erlang-font-lock-keywords-macros |
| 2409 | erlang-font-lock-keywords-records |
| 2410 | erlang-font-lock-keywords-vars) |
| 2411 | ;; DocStringCopy: erlang-font-lock-keywords |
| 2412 | "Font-lock keywords used by Erlang Mode. |
| 2413 | |
| 2414 | There exists three levels of Font Lock keywords for Erlang: |
| 2415 | `erlang-font-lock-keywords-1' - Function headers and reserved keywords. |
| 2416 | `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. |
| 2417 | `erlang-font-lock-keywords-3' - Variables, macros and records. |
| 2418 | |
| 2419 | To use a specific level, please set the variable |
| 2420 | `font-lock-maximum-decoration' to the appropriate level. Note that the |
| 2421 | variable must be set before Erlang mode is activated. |
| 2422 | |
| 2423 | Example: |
| 2424 | (setq font-lock-maximum-decoration 2)") |
| 2425 | |
| 2426 | |
| 2427 | (defvar erlang-font-lock-keywords erlang-font-lock-keywords-3 |
| 2428 | ;; DocStringCopy: erlang-font-lock-keywords |
| 2429 | "Font-lock keywords used by Erlang Mode. |
| 2430 | |
| 2431 | There exists three levels of Font Lock keywords for Erlang: |
| 2432 | `erlang-font-lock-keywords-1' - Function headers and reserved keywords. |
| 2433 | `erlang-font-lock-keywords-2' - Bifs, guards and `single quotes'. |
| 2434 | `erlang-font-lock-keywords-3' - Variables, macros and records. |
| 2435 | |
| 2436 | To use a specific level, please set the variable |
| 2437 | `font-lock-maximum-decoration' to the appropriate level. Note that the |
| 2438 | variable must be set before Erlang mode is activated. |
| 2439 | |
| 2440 | Example: |
| 2441 | (setq font-lock-maximum-decoration 2)") |
| 2442 | |
| 2443 | |
| 2444 | (defvar erlang-font-lock-syntax-table nil |
| 2445 | "Syntax table used by Font Lock mode. |
| 2446 | |
| 2447 | The difference between this and the standard Erlang Mode |
| 2448 | syntax table is that `_' is treated as part of words by |
| 2449 | this syntax table. |
| 2450 | |
| 2451 | Unfortuantely, XEmacs hasn't got support for a special Font |
| 2452 | Lock syntax table. The effect is that `apply' in the atom |
| 2453 | `foo_apply' will be highlighted as a bif.") |
| 2454 | |
| 2455 | |
| 2456 | ;;; Avoid errors while compiling this file. |
| 2457 | |
| 2458 | ;; `eval-when-compile' is not defined in Emacs 18. We define it as a |
| 2459 | ;; no-op. |
| 2460 | (or (fboundp 'eval-when-compile) |
| 2461 | (defmacro eval-when-compile (&rest rest) nil)) |
| 2462 | |
| 2463 | ;; These umm...functions are new in Emacs 20. And, yes, until version |
| 2464 | ;; 19.27 Emacs backquotes were this ugly. |
| 2465 | |
| 2466 | (or (fboundp 'unless) |
| 2467 | (defmacro unless (condition &rest body) |
| 2468 | "(unless CONDITION BODY...): If CONDITION is false, do BODY, else return nil." |
| 2469 | (` (if (, condition) |
| 2470 | nil |
| 2471 | (,@ body))))) |
| 2472 | |
| 2473 | (or (fboundp 'when) |
| 2474 | (defmacro when (condition &rest body) |
| 2475 | "(when CONDITION BODY...): If CONDITION is true, do BODY, else return nil." |
| 2476 | (` (if (, condition) |
| 2477 | (progn (,@ body)) |
| 2478 | nil)))) |
| 2479 | |
| 2480 | (or (fboundp 'char-before) |
| 2481 | (defmacro char-before (&optional pos) |
| 2482 | "Return the character in the current buffer just before POS." |
| 2483 | (` (char-after (1- (or (, pos) (point))))))) |
| 2484 | |
| 2485 | (or (fboundp 'regexp-opt) |
| 2486 | (defun regexp-opt (strings &optional paren) |
| 2487 | "Return a regular expression that matches any string in |
| 2488 | STRINGS. If PAREN is true, it will always enclose the regular |
| 2489 | expression in parentheses. |
| 2490 | |
| 2491 | Unlike its Emacs-20 namesake, it will not optimize the generated |
| 2492 | expression." |
| 2493 | ;; This stop-gap definition is taken from |
| 2494 | ;; _GNU_Emacs_Lisp_Reference_Manual_, ed 2.5, for Emacs 20.3. |
| 2495 | (let ((open (if paren "\\(" "")) |
| 2496 | (close (if paren "\\)" ""))) |
| 2497 | (concat open |
| 2498 | (mapconcat 'regexp-quote strings "\\|") |
| 2499 | close)))) |
| 2500 | |
| 2501 | (eval-when-compile |
| 2502 | (if (or (featurep 'bytecomp) |
| 2503 | (featurep 'byte-compile)) |
| 2504 | (progn |
| 2505 | (cond ((string-match "Lucid\\|XEmacs" emacs-version) |
| 2506 | (put 'comment-indent-hook 'byte-obsolete-variable nil) |
| 2507 | ;; Do not warn for unused variables |
| 2508 | ;; when compiling under XEmacs. |
| 2509 | (setq byte-compile-warnings |
| 2510 | '(free-vars unresolved callargs redefine)))) |
| 2511 | (require 'comint) |
| 2512 | (require 'compile)))) |
| 2513 | |
| 2514 | |
| 2515 | (defun erlang-version () |
| 2516 | "Return the current version of Erlang mode." |
| 2517 | (interactive) |
| 2518 | (if (interactive-p) |
| 2519 | (message "Erlang mode version %s, written by Anders Lindgren" |
| 2520 | erlang-version)) |
| 2521 | erlang-version) |
| 2522 | |
| 2523 | |
| 2524 | ;;;###autoload |
| 2525 | (defun erlang-mode () |
| 2526 | "Major mode for editing Erlang source files in Emacs. |
| 2527 | It knows about syntax and comment, it can indent code, it is capable |
| 2528 | of fontifying the source file, the TAGS commands are aware of Erlang |
| 2529 | modules, and the Erlang man pages can be accessed. |
| 2530 | |
| 2531 | Should this module, \"erlang.el\", be installed properly, Erlang mode |
| 2532 | is activated whenever an Erlang source or header file is loaded into |
| 2533 | Emacs. To indicate this, the mode line should contain the word |
| 2534 | \"Erlang\". |
| 2535 | |
| 2536 | The main feature of Erlang mode is indentation, press TAB and the |
| 2537 | current line will be indented correctly. |
| 2538 | |
| 2539 | Comments starting with only one `%' are indented to the column stored |
| 2540 | in the variable `comment-column'. Comments starting with two `%':s |
| 2541 | are indented with the same indentation as code. Comments starting |
| 2542 | with at least three `%':s are indented to the first column. |
| 2543 | |
| 2544 | However, Erlang mode contains much more, this is a list of the most |
| 2545 | useful commands: |
| 2546 | TAB - Indent the line. |
| 2547 | C-c C-q - Indent current function. |
| 2548 | M-; - Create a comment at the end of the line. |
| 2549 | M-q - Fill a comment, i.e. wrap lines so that they (hopefully) |
| 2550 | will look better. |
| 2551 | M-a - Goto the beginning of an Erlang clause. |
| 2552 | M-C-a - Ditto for function. |
| 2553 | M-e - Goto the end of an Erlang clause. |
| 2554 | M-C-e - Ditto for function. |
| 2555 | M-h - Mark current Erlang clause. |
| 2556 | M-C-h - Ditto for function. |
| 2557 | C-c C-z - Start, or switch to, an inferior Erlang shell. |
| 2558 | C-c C-k - Compile current file. |
| 2559 | C-x ` - Next error. |
| 2560 | , - Electric comma. |
| 2561 | ; - Electric semicolon. |
| 2562 | |
| 2563 | Erlang mode check the name of the file against the module name when |
| 2564 | saving, whenever a mismatch occurs Erlang mode offers to modify the |
| 2565 | source. |
| 2566 | |
| 2567 | The variable `erlang-electric-commands' controls the electric |
| 2568 | commands. To deactivate all of them, set it to nil. |
| 2569 | |
| 2570 | There exists a large number of commands and variables in the Erlang |
| 2571 | module. Please press `M-x apropos RET erlang RET' to see a complete |
| 2572 | list. Press `C-h f name-of-function RET' and `C-h v name-of-variable |
| 2573 | RET'to see the full description of functions and variables, |
| 2574 | respectively. |
| 2575 | |
| 2576 | On entry to this mode the contents of the hook `erlang-mode-hook' is |
| 2577 | executed. |
| 2578 | |
| 2579 | Please see the beginning of the file `erlang.el' for more information |
| 2580 | and examples of hooks. |
| 2581 | |
| 2582 | Other commands: |
| 2583 | \\{erlang-mode-map}" |
| 2584 | (interactive) |
| 2585 | (kill-all-local-variables) |
| 2586 | (setq major-mode 'erlang-mode) |
| 2587 | (setq mode-name "Erlang") |
| 2588 | (erlang-syntax-table-init) |
| 2589 | (erlang-keymap-init) |
| 2590 | (erlang-electric-init) |
| 2591 | (erlang-menu-init) |
| 2592 | (erlang-mode-variables) |
| 2593 | (erlang-check-module-name-init) |
| 2594 | (erlang-add-compilation-alist erlang-error-regexp-alist) |
| 2595 | (erlang-man-init) |
| 2596 | (erlang-tags-init) |
| 2597 | (erlang-font-lock-init) |
| 2598 | (erlang-skel-init) |
| 2599 | (run-hooks 'erlang-mode-hook) |
| 2600 | (if (zerop (buffer-size)) |
| 2601 | (run-hooks 'erlang-new-file-hook))) |
| 2602 | |
| 2603 | |
| 2604 | (defun erlang-syntax-table-init () |
| 2605 | (if (null erlang-mode-syntax-table) |
| 2606 | (let ((table (make-syntax-table))) |
| 2607 | (modify-syntax-entry ?\n ">" table) |
| 2608 | (modify-syntax-entry ?\" "\"" table) |
| 2609 | (modify-syntax-entry ?# "." table) |
| 2610 | (modify-syntax-entry ?$ "/" table) |
| 2611 | (modify-syntax-entry ?% "<" table) |
| 2612 | (modify-syntax-entry ?& "." table) |
| 2613 | (modify-syntax-entry ?\' "\"" table) |
| 2614 | (modify-syntax-entry ?* "." table) |
| 2615 | (modify-syntax-entry ?+ "." table) |
| 2616 | (modify-syntax-entry ?- "." table) |
| 2617 | (modify-syntax-entry ?/ "." table) |
| 2618 | (modify-syntax-entry ?: "." table) |
| 2619 | (modify-syntax-entry ?< "." table) |
| 2620 | (modify-syntax-entry ?= "." table) |
| 2621 | (modify-syntax-entry ?> "." table) |
| 2622 | (modify-syntax-entry ?\\ "\\" table) |
| 2623 | (modify-syntax-entry ?_ "_" table) |
| 2624 | (modify-syntax-entry ?| "." table) |
| 2625 | (modify-syntax-entry ?^ "/" table) |
| 2626 | |
| 2627 | ;; Pseudo bit-syntax: Latin1 double angle quotes as parens. |
| 2628 | ;;(modify-syntax-entry ?\253 "(?\273" table) |
| 2629 | ;;(modify-syntax-entry ?\273 ")?\253" table) |
| 2630 | |
| 2631 | (setq erlang-mode-syntax-table table))) |
| 2632 | |
| 2633 | (set-syntax-table erlang-mode-syntax-table)) |
| 2634 | |
| 2635 | |
| 2636 | (defun erlang-keymap-init () |
| 2637 | (if erlang-mode-map |
| 2638 | nil |
| 2639 | (setq erlang-mode-map (make-sparse-keymap)) |
| 2640 | (erlang-mode-commands erlang-mode-map)) |
| 2641 | (use-local-map erlang-mode-map)) |
| 2642 | |
| 2643 | |
| 2644 | (defun erlang-mode-commands (map) |
| 2645 | (define-key map "\t" 'erlang-indent-command) |
| 2646 | (define-key map ";" 'erlang-electric-semicolon) |
| 2647 | (define-key map "," 'erlang-electric-comma) |
| 2648 | (define-key map "<" 'erlang-electric-lt) |
| 2649 | (define-key map ">" 'erlang-electric-gt) |
| 2650 | (define-key map "\C-m" 'erlang-electric-newline) |
| 2651 | (define-key map "\177" 'backward-delete-char-untabify) |
| 2652 | (define-key map "\M-q" 'erlang-fill-paragraph) |
| 2653 | (define-key map "\M-\C-a" 'erlang-beginning-of-function) |
| 2654 | (define-key map "\M-\C-e" 'erlang-end-of-function) |
| 2655 | (define-key map "\M-\C-h" 'erlang-mark-function) |
| 2656 | (define-key map "\M-\t" 'erlang-complete-tag) |
| 2657 | (define-key map "\C-c\M-\t" 'tempo-complete-tag) |
| 2658 | (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) |
| 2659 | (define-key map "\C-c\M-b" 'tempo-backward-mark) |
| 2660 | (define-key map "\C-c\M-e" 'erlang-end-of-clause) |
| 2661 | (define-key map "\C-c\M-f" 'tempo-forward-mark) |
| 2662 | (define-key map "\C-c\M-h" 'erlang-mark-clause) |
| 2663 | (define-key map "\C-c\C-c" 'comment-region) |
| 2664 | (define-key map "\C-c\C-j" 'erlang-generate-new-clause) |
| 2665 | (define-key map "\C-c\C-k" 'erlang-compile) |
| 2666 | (define-key map "\C-c\C-l" 'erlang-compile-display) |
| 2667 | (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) |
| 2668 | (define-key map "\C-c\C-q" 'erlang-indent-function) |
| 2669 | (define-key map "\C-c\C-u" 'erlang-uncomment-region) |
| 2670 | (define-key map "\C-c\C-y" 'erlang-clone-arguments) |
| 2671 | (define-key map "\C-c\C-z" 'erlang-shell-display) |
| 2672 | (define-key map "\C-x`" 'erlang-next-error)) |
| 2673 | |
| 2674 | |
| 2675 | (defun erlang-electric-init () |
| 2676 | ;; Set up electric character functions to work with |
| 2677 | ;; delsel/pending-del mode. Also, set up text properties for bit |
| 2678 | ;; syntax handling. |
| 2679 | (mapcar #'(lambda (cmd) |
| 2680 | (put cmd 'delete-selection t) ;for delsel (Emacs) |
| 2681 | (put cmd 'pending-delete t)) ;for pending-del (XEmacs) |
| 2682 | '(erlang-electric-semicolon |
| 2683 | erlang-electric-comma |
| 2684 | erlang-electric-gt)) |
| 2685 | |
| 2686 | (put 'bitsyntax-open-outer 'syntax-table '(4 . ?>)) |
| 2687 | (put 'bitsyntax-open-outer 'rear-nonsticky '(category)) |
| 2688 | (put 'bitsyntax-open-inner 'rear-nonsticky '(category)) |
| 2689 | (put 'bitsyntax-close-inner 'rear-nonsticky '(category)) |
| 2690 | (put 'bitsyntax-close-outer 'syntax-table '(5 . ?<)) |
| 2691 | (put 'bitsyntax-close-outer 'rear-nonsticky '(category)) |
| 2692 | (setq parse-sexp-lookup-properties 't)) |
| 2693 | |
| 2694 | |
| 2695 | |
| 2696 | (defun erlang-mode-variables () |
| 2697 | (or erlang-mode-abbrev-table |
| 2698 | (define-abbrev-table 'erlang-mode-abbrev-table ())) |
| 2699 | (setq local-abbrev-table erlang-mode-abbrev-table) |
| 2700 | (make-local-variable 'paragraph-start) |
| 2701 | (setq paragraph-start (concat "^$\\|" page-delimiter)) |
| 2702 | (make-local-variable 'paragraph-separate) |
| 2703 | (setq paragraph-separate paragraph-start) |
| 2704 | (make-local-variable 'paragraph-ignore-fill-prefix) |
| 2705 | (setq paragraph-ignore-fill-prefix t) |
| 2706 | (make-local-variable 'require-final-newline) |
| 2707 | (setq require-final-newline t) |
| 2708 | (make-local-variable 'defun-prompt-regexp) |
| 2709 | (setq defun-prompt-regexp erlang-defun-prompt-regexp) |
| 2710 | (make-local-variable 'comment-start) |
| 2711 | (setq comment-start "%") |
| 2712 | (make-local-variable 'comment-start-skip) |
| 2713 | (setq comment-start-skip "%+\\s *") |
| 2714 | (make-local-variable 'comment-column) |
| 2715 | (setq comment-column 48) |
| 2716 | (make-local-variable 'indent-line-function) |
| 2717 | (setq indent-line-function 'erlang-indent-command) |
| 2718 | (make-local-variable 'indent-region-function) |
| 2719 | (setq indent-region-function 'erlang-indent-region) |
| 2720 | (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) |
| 2721 | (if (<= erlang-emacs-major-version 18) |
| 2722 | (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) |
| 2723 | (set (make-local-variable 'parse-sexp-ignore-comments) t) |
| 2724 | (set (make-local-variable 'dabbrev-case-fold-search) nil) |
| 2725 | (set (make-local-variable 'imenu-prev-index-position-function) |
| 2726 | 'erlang-beginning-of-function) |
| 2727 | (set (make-local-variable 'imenu-extract-index-name-function) |
| 2728 | 'erlang-get-function-name) |
| 2729 | (set (make-local-variable 'tempo-match-finder) |
| 2730 | "[^-a-zA-Z0-9_]\\([-a-zA-Z0-9_]*\\)\\=")) |
| 2731 | |
| 2732 | |
| 2733 | ;; Compilation. |
| 2734 | ;; |
| 2735 | ;; The following code is compatible with the standard package `compilation', |
| 2736 | ;; making it possible to go to errors using `erlang-next-error'. |
| 2737 | ;; |
| 2738 | ;; The normal `compile' command works ofcourse. For best result, please |
| 2739 | ;; execute `make' with the `-w' flag. |
| 2740 | ;; |
| 2741 | ;; Please see the variables named `compiling-..' above. |
| 2742 | |
| 2743 | (defun erlang-add-compilation-alist (alist) |
| 2744 | (require 'compile) |
| 2745 | (cond ((boundp 'compilation-error-regexp-alist) ; Emacs 19 |
| 2746 | (while alist |
| 2747 | (or (assoc (car (car alist)) compilation-error-regexp-alist) |
| 2748 | (setq compilation-error-regexp-alist |
| 2749 | (cons (car alist) compilation-error-regexp-alist))) |
| 2750 | (setq alist (cdr alist)))) |
| 2751 | ((boundp 'compilation-error-regexp) |
| 2752 | ;; Emacs 18, Only one regexp is allowed. |
| 2753 | (funcall (symbol-function 'set) |
| 2754 | 'compilation-error-regexp (car (car alist)))))) |
| 2755 | |
| 2756 | (defun erlang-font-lock-init () |
| 2757 | "Initialize Font Lock for Erlang mode." |
| 2758 | (or erlang-font-lock-syntax-table |
| 2759 | (setq erlang-font-lock-syntax-table |
| 2760 | (let ((table (copy-syntax-table erlang-mode-syntax-table))) |
| 2761 | (modify-syntax-entry ?_ "w" table) |
| 2762 | table))) |
| 2763 | (set (make-local-variable 'font-lock-syntax-table) |
| 2764 | erlang-font-lock-syntax-table) |
| 2765 | (set (make-local-variable 'font-lock-beginning-of-syntax-function) |
| 2766 | 'erlang-beginning-of-clause) |
| 2767 | (make-local-variable 'font-lock-keywords) |
| 2768 | (let ((level (cond ((boundp 'font-lock-maximum-decoration) |
| 2769 | (symbol-value 'font-lock-maximum-decoration)) |
| 2770 | ((boundp 'font-lock-use-maximal-decoration) |
| 2771 | (symbol-value 'font-lock-use-maximal-decoration)) |
| 2772 | (t nil)))) |
| 2773 | (if (consp level) |
| 2774 | (setq level (cdr-safe (or (assq 'erlang-mode level) |
| 2775 | (assq t level))))) |
| 2776 | ;; `level' can here be: |
| 2777 | ;; A number - The fontification level |
| 2778 | ;; nil - Use the default |
| 2779 | ;; t - Use maximum |
| 2780 | (cond ((eq level nil) |
| 2781 | (set 'font-lock-keywords erlang-font-lock-keywords)) |
| 2782 | ((eq level 1) |
| 2783 | (set 'font-lock-keywords erlang-font-lock-keywords-1)) |
| 2784 | ((eq level 2) |
| 2785 | (set 'font-lock-keywords erlang-font-lock-keywords-2)) |
| 2786 | (t |
| 2787 | (set 'font-lock-keywords erlang-font-lock-keywords-3)))) |
| 2788 | |
| 2789 | ;; Modern font-locks can handle the above much more elegant: |
| 2790 | (set (make-local-variable 'font-lock-defaults) |
| 2791 | '((erlang-font-lock-keywords erlang-font-lock-keywords-1 |
| 2792 | erlang-font-lock-keywords-2 erlang-font-lock-keywords-3) |
| 2793 | nil nil ((?_ . "w")) erlang-beginning-of-clause |
| 2794 | (font-lock-comment-start-regexp . "%") |
| 2795 | (font-lock-mark-block-function . erlang-mark-clause)))) |
| 2796 | |
| 2797 | |
| 2798 | |
| 2799 | ;; Useful when definig yout own keywords. |
| 2800 | (defun erlang-font-lock-set-face (ks &rest faces) |
| 2801 | "Replace the face components in a list of keywords. |
| 2802 | |
| 2803 | The first argument, KS, is a list of keywords. The rest of the |
| 2804 | arguments are expressions to replace the face information with. The |
| 2805 | first expression replaces the face of the first keyword, the second |
| 2806 | expression the second keyword etc. |
| 2807 | |
| 2808 | Should an expression be nil, the face of the corresponding keyword is |
| 2809 | not changed. |
| 2810 | |
| 2811 | Should fewer expressions than keywords be given, the last expression |
| 2812 | is used for all remaining keywords. |
| 2813 | |
| 2814 | Normally, the expressions are just atoms representing the new face. |
| 2815 | They could however be more complex, returning different faces in |
| 2816 | different situations. |
| 2817 | |
| 2818 | This function does only handle keywords with elements on the forms: |
| 2819 | (REGEXP NUMBER FACE) |
| 2820 | (REGEXP NUMBER FACE OVERWRITE) |
| 2821 | |
| 2822 | This could be used when defining your own special font-lock setup, e.g: |
| 2823 | |
| 2824 | \(setq my-font-lock-keywords |
| 2825 | (append erlang-font-lock-keywords-func |
| 2826 | erlang-font-lock-keywords-dollar |
| 2827 | (erlang-font-lock-set-face |
| 2828 | erlang-font-lock-keywords-macros 'my-neon-green-face) |
| 2829 | (erlang-font-lock-set-face |
| 2830 | erlang-font-lock-keywords-lc 'my-deep-red 'my-light-red) |
| 2831 | erlang-font-lock-keywords-attr)) |
| 2832 | |
| 2833 | For a more elaborate example, please see the beginning of the file |
| 2834 | `erlang.el'." |
| 2835 | (let ((res '())) |
| 2836 | (while ks |
| 2837 | (let* ((regexp (car (car ks))) |
| 2838 | (number (car (cdr (car ks)))) |
| 2839 | (new-face (if (and faces (car faces)) |
| 2840 | (car faces) |
| 2841 | (car (cdr (cdr (car ks)))))) |
| 2842 | (overwrite (car (cdr (cdr (cdr (car ks)))))) |
| 2843 | (new-keyword (list regexp number new-face))) |
| 2844 | (if overwrite (nconc new-keyword (list overwrite))) |
| 2845 | (setq res (cons new-keyword res)) |
| 2846 | (setq ks (cdr ks)) |
| 2847 | (if (and faces (cdr faces)) |
| 2848 | (setq faces (cdr faces))))) |
| 2849 | (nreverse res))) |
| 2850 | |
| 2851 | |
| 2852 | (defun erlang-font-lock-level-0 () |
| 2853 | ;; DocStringOrig: font-cmd |
| 2854 | "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). |
| 2855 | |
| 2856 | The following fontification level exists: |
| 2857 | 0 - No fontification |
| 2858 | 1 - Function headers, reserved keywords, strings and comments. |
| 2859 | 2 - Bifs, guards and `single quotes'. |
| 2860 | 3 - Variables, macros and records. |
| 2861 | |
| 2862 | To automatically activate font lock mode, place the following lines |
| 2863 | in your ~/.emacs file: |
| 2864 | |
| 2865 | \(defun my-erlang-mode-hook () |
| 2866 | (cond (window-system |
| 2867 | (font-lock-mode 1)))) |
| 2868 | \(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) |
| 2869 | \(setq font-lock-maximum-decoration t)" |
| 2870 | (interactive) |
| 2871 | (font-lock-mode 0)) |
| 2872 | |
| 2873 | |
| 2874 | (defun erlang-font-lock-level-1 () |
| 2875 | ;; DocStringCopy: font-cmd |
| 2876 | "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). |
| 2877 | |
| 2878 | The following fontification level exists: |
| 2879 | 0 - No fontification |
| 2880 | 1 - Function headers, reserved keywords, strings and comments. |
| 2881 | 2 - Bifs, guards and `single quotes'. |
| 2882 | 3 - Variables, macros and records. |
| 2883 | |
| 2884 | To automatically activate font lock mode, place the following lines |
| 2885 | in your ~/.emacs file: |
| 2886 | |
| 2887 | \(defun my-erlang-mode-hook () |
| 2888 | (cond (window-system |
| 2889 | (font-lock-mode 1)))) |
| 2890 | \(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) |
| 2891 | \(setq font-lock-maximum-decoration t)" |
| 2892 | (interactive) |
| 2893 | (require 'font-lock) |
| 2894 | (set 'font-lock-keywords erlang-font-lock-keywords-1) |
| 2895 | (font-lock-mode 1) |
| 2896 | (funcall (symbol-function 'font-lock-fontify-buffer))) |
| 2897 | |
| 2898 | |
| 2899 | (defun erlang-font-lock-level-2 () |
| 2900 | ;; DocStringCopy: font-cmd |
| 2901 | "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). |
| 2902 | |
| 2903 | The following fontification level exists: |
| 2904 | 0 - No fontification |
| 2905 | 1 - Function headers, reserved keywords, strings and comments. |
| 2906 | 2 - Bifs, guards and `single quotes'. |
| 2907 | 3 - Variables, macros and records. |
| 2908 | |
| 2909 | To automatically activate font lock mode, place the following lines |
| 2910 | in your ~/.emacs file: |
| 2911 | |
| 2912 | \(defun my-erlang-mode-hook () |
| 2913 | (cond (window-system |
| 2914 | (font-lock-mode 1)))) |
| 2915 | \(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) |
| 2916 | \(setq font-lock-maximum-decoration t)" |
| 2917 | (interactive) |
| 2918 | (require 'font-lock) |
| 2919 | (set 'font-lock-keywords erlang-font-lock-keywords-2) |
| 2920 | (font-lock-mode 1) |
| 2921 | (funcall (symbol-function 'font-lock-fontify-buffer))) |
| 2922 | |
| 2923 | |
| 2924 | (defun erlang-font-lock-level-3 () |
| 2925 | ;; DocStringCopy: font-cmd |
| 2926 | "Fontify current buffer. Level ranges from 0 (off) to 3 (Christmas Tree). |
| 2927 | |
| 2928 | The following fontification level exists: |
| 2929 | 0 - No fontification |
| 2930 | 1 - Function headers, reserved keywords, strings and comments. |
| 2931 | 2 - Bifs, guards and `single quotes'. |
| 2932 | 3 - Variables, macros and records. |
| 2933 | |
| 2934 | To automatically activate font lock mode, place the following lines |
| 2935 | in your ~/.emacs file: |
| 2936 | |
| 2937 | \(defun my-erlang-mode-hook () |
| 2938 | (cond (window-system |
| 2939 | (font-lock-mode 1)))) |
| 2940 | \(add-hook 'erlang-mode-hook 'my-erlang-mode-hook) |
| 2941 | \(setq font-lock-maximum-decoration t)" |
| 2942 | (interactive) |
| 2943 | (require 'font-lock) |
| 2944 | (set 'font-lock-keywords erlang-font-lock-keywords-3) |
| 2945 | (font-lock-mode 1) |
| 2946 | (funcall (symbol-function 'font-lock-fontify-buffer))) |
| 2947 | |
| 2948 | |
| 2949 | (defun erlang-menu-init () |
| 2950 | "Init menus for Erlang mode. |
| 2951 | |
| 2952 | The variable `erlang-menu-items' contain a description of the Erlang |
| 2953 | mode menu. Normally, the list contains atoms, representing variables |
| 2954 | bound to pieces of the menu. |
| 2955 | |
| 2956 | Personal extentions could be added to `erlang-menu-personal-items'. |
| 2957 | |
| 2958 | Should any variable describing the menu configuration, this function |
| 2959 | should be called." |
| 2960 | (erlang-menu-install "Erlang" erlang-menu-items erlang-mode-map t)) |
| 2961 | |
| 2962 | |
| 2963 | (defun erlang-menu-install (name items keymap &optional popup) |
| 2964 | "Install a menu on Emacs 19 or XEmacs based on an abstract description. |
| 2965 | |
| 2966 | NAME is the name of the menu. |
| 2967 | |
| 2968 | ITEMS is a list. The elements are either nil representing a horisontal |
| 2969 | line or a list with two or three elements. The first is the name of |
| 2970 | the menu item, the second the function to call, or a submenu, on the |
| 2971 | same same form as ITEMS. The third optional element is an expression |
| 2972 | which is evaluated every time the menu is displayed. Should the |
| 2973 | expression evaluate to nil the menu item is ghosted. |
| 2974 | |
| 2975 | KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu |
| 2976 | will only be visible when this meny is the global, the local, or an |
| 2977 | activated minor mode keymap.) |
| 2978 | |
| 2979 | If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu' |
| 2980 | variable, i.e. it will popup when pressing the right mouse button. |
| 2981 | |
| 2982 | Please see the variable `erlang-menu-base-items'." |
| 2983 | (cond (erlang-xemacs-p |
| 2984 | (let ((menu (erlang-menu-xemacs name items keymap))) |
| 2985 | ;; We add the menu to the global menubar. |
| 2986 | ;;(funcall (symbol-function 'set-buffer-menubar) |
| 2987 | ;; (symbol-value 'current-menubar)) |
| 2988 | (funcall (symbol-function 'add-submenu) nil menu) |
| 2989 | (setcdr erlang-xemacs-popup-menu (cdr menu)) |
| 2990 | (if (and popup (boundp 'mode-popup-menu)) |
| 2991 | (funcall (symbol-function 'set) |
| 2992 | 'mode-popup-menu erlang-xemacs-popup-menu)))) |
| 2993 | ((>= erlang-emacs-major-version 19) |
| 2994 | (define-key keymap (vector 'menu-bar (intern name)) |
| 2995 | (erlang-menu-make-keymap name items))) |
| 2996 | (t nil))) |
| 2997 | |
| 2998 | |
| 2999 | (defun erlang-menu-make-keymap (name items) |
| 3000 | "Build a menu for Emacs 19." |
| 3001 | (let ((menumap (funcall (symbol-function 'make-sparse-keymap) |
| 3002 | name)) |
| 3003 | (count 0) |
| 3004 | id def first second third) |
| 3005 | (setq items (reverse items)) |
| 3006 | (while items |
| 3007 | ;; Replace any occurence of atoms by their value. |
| 3008 | (while (and items (atom (car items)) (not (null (car items)))) |
| 3009 | (if (and (boundp (car items)) |
| 3010 | (listp (symbol-value (car items)))) |
| 3011 | (setq items (append (reverse (symbol-value (car items))) |
| 3012 | (cdr items))) |
| 3013 | (setq items (cdr items)))) |
| 3014 | (setq first (car-safe (car items))) |
| 3015 | (setq second (car-safe (cdr-safe (car items)))) |
| 3016 | (setq third (car-safe (cdr-safe (cdr-safe (car items))))) |
| 3017 | (cond ((null first) |
| 3018 | (setq count (+ count 1)) |
| 3019 | (setq id (intern (format "separator-%d" count))) |
| 3020 | (setq def '("--" . nil))) |
| 3021 | ((and (consp second) (eq (car second) 'lambda)) |
| 3022 | (setq count (+ count 1)) |
| 3023 | (setq id (intern (format "lambda-%d" count))) |
| 3024 | (setq def (cons first second))) |
| 3025 | ((symbolp second) |
| 3026 | (setq id second) |
| 3027 | (setq def (cons first second))) |
| 3028 | (t |
| 3029 | (setq count (+ count 1)) |
| 3030 | (setq id (intern (format "submenu-%d" count))) |
| 3031 | (setq def (erlang-menu-make-keymap first second)))) |
| 3032 | (define-key menumap (vector id) def) |
| 3033 | (if third |
| 3034 | (put id 'menu-enable third)) |
| 3035 | (setq items (cdr items))) |
| 3036 | (cons name menumap))) |
| 3037 | |
| 3038 | |
| 3039 | (defun erlang-menu-xemacs (name items &optional keymap) |
| 3040 | "Build a menu for XEmacs." |
| 3041 | (let ((res '()) |
| 3042 | first second third entry) |
| 3043 | (while items |
| 3044 | ;; Replace any occurence of atoms by their value. |
| 3045 | (while (and items (atom (car items)) (not (null (car items)))) |
| 3046 | (if (and (boundp (car items)) |
| 3047 | (listp (symbol-value (car items)))) |
| 3048 | (setq items (append (reverse (symbol-value (car items))) |
| 3049 | (cdr items))) |
| 3050 | (setq items (cdr items)))) |
| 3051 | (setq first (car-safe (car items))) |
| 3052 | (setq second (car-safe (cdr-safe (car items)))) |
| 3053 | (setq third (car-safe (cdr-safe (cdr-safe (car items))))) |
| 3054 | (cond ((null first) |
| 3055 | (setq res (cons "------" res))) |
| 3056 | ((symbolp second) |
| 3057 | (setq res (cons (vector first second (or third t)) res))) |
| 3058 | ((and (consp second) (eq (car second) 'lambda)) |
| 3059 | (setq res (cons (vector first (list 'call-interactively second) |
| 3060 | (or third t)) res))) |
| 3061 | (t |
| 3062 | (setq res (cons (cons first |
| 3063 | (cdr (erlang-menu-xemacs |
| 3064 | first second))) |
| 3065 | res)))) |
| 3066 | (setq items (cdr items))) |
| 3067 | (setq res (reverse res)) |
| 3068 | ;; When adding a menu to a minor-mode keymap under Emacs 19, |
| 3069 | ;; it disappears when the mode is disabled. The expression |
| 3070 | ;; generated below imitates this behaviour. |
| 3071 | ;; (This could be expressed much clearer using backquotes, |
| 3072 | ;; but I don't want to pull in every package.) |
| 3073 | (if keymap |
| 3074 | (let ((expr (list 'or |
| 3075 | (list 'eq keymap 'global-map) |
| 3076 | (list 'eq keymap (list 'current-local-map)) |
| 3077 | (list 'symbol-value |
| 3078 | (list 'car-safe |
| 3079 | (list 'rassq |
| 3080 | keymap |
| 3081 | 'minor-mode-map-alist)))))) |
| 3082 | (setq res (cons ':included (cons expr res))))) |
| 3083 | (cons name res))) |
| 3084 | |
| 3085 | |
| 3086 | (defun erlang-menu-substitute (items alist) |
| 3087 | "Substitute functions in menu described by ITEMS. |
| 3088 | |
| 3089 | The menu ITEMS is updated destructively. |
| 3090 | |
| 3091 | ALIST is list of pairs where the car is the old function and cdr the new." |
| 3092 | (let (first second pair) |
| 3093 | (while items |
| 3094 | (setq first (car-safe (car items))) |
| 3095 | (setq second (car-safe (cdr-safe (car items)))) |
| 3096 | (cond ((null first)) |
| 3097 | ((symbolp second) |
| 3098 | (setq pair (and second (assq second alist))) |
| 3099 | (if pair |
| 3100 | (setcar (cdr (car items)) (cdr pair)))) |
| 3101 | ((and (consp second) (eq (car second) 'lambda))) |
| 3102 | (t |
| 3103 | (erlang-menu-substitute second alist))) |
| 3104 | (setq items (cdr items))))) |
| 3105 | |
| 3106 | |
| 3107 | (defun erlang-menu-add-above (entry above items) |
| 3108 | "Add menu ENTRY above menu entry ABOVE in menu ITEMS. |
| 3109 | Do nothing if the items already should be in the menu. |
| 3110 | Should ABOVE not be in the list, the entry is added at |
| 3111 | the bottom of the menu. |
| 3112 | |
| 3113 | The new menu is returned. No guarantee is given that the original |
| 3114 | menu is left unchanged. |
| 3115 | |
| 3116 | The equality test is performed by `eq'. |
| 3117 | |
| 3118 | Example: (erlang-menu-add-above 'my-erlang-menu-items |
| 3119 | 'erlang-menu-man-items)" |
| 3120 | (erlang-menu-add-below entry above items t)) |
| 3121 | |
| 3122 | |
| 3123 | (defun erlang-menu-add-below (entry below items &optional above-p) |
| 3124 | "Add menu ENTRY below menu items BELOW in the Erlang menu. |
| 3125 | Do nothing if the items already should be in the menu. |
| 3126 | Should BELOW not be in the list, items is added at the bottom |
| 3127 | of the menu. |
| 3128 | |
| 3129 | The new menu is returned. No guarantee is given that the original |
| 3130 | menu is left unchanged. |
| 3131 | |
| 3132 | The equality test is performed by `eq'. |
| 3133 | |
| 3134 | Example: |
| 3135 | |
| 3136 | \(setq erlang-menu-items |
| 3137 | (erlang-menu-add-below 'my-erlang-menu-items |
| 3138 | 'erlang-menu-base-items |
| 3139 | erlang-menu-items))" |
| 3140 | (if (memq entry items) |
| 3141 | items ; Return the original menu. |
| 3142 | (let ((head '()) |
| 3143 | (done nil) |
| 3144 | res) |
| 3145 | (while (not done) |
| 3146 | (cond ((null items) |
| 3147 | (setq res (append head (list entry))) |
| 3148 | (setq done t)) |
| 3149 | ((eq below (car items)) |
| 3150 | (setq res |
| 3151 | (if above-p |
| 3152 | (append head (cons entry items)) |
| 3153 | (append head (cons (car items) |
| 3154 | (cons entry (cdr items)))))) |
| 3155 | (setq done t)) |
| 3156 | (t |
| 3157 | (setq head (append head (list (car items)))) |
| 3158 | (setq items (cdr items))))) |
| 3159 | res))) |
| 3160 | |
| 3161 | (defun erlang-menu-delete (entry items) |
| 3162 | "Delete ENTRY from menu ITEMS. |
| 3163 | |
| 3164 | The new menu is returned. No guarantee is given that the original |
| 3165 | menu is left unchanged." |
| 3166 | (delq entry items)) |
| 3167 | |
| 3168 | ;; Man code: |
| 3169 | |
| 3170 | (defun erlang-man-init () |
| 3171 | "Add menus containing the manual pages of the Erlang. |
| 3172 | |
| 3173 | The variable `erlang-man-dirs' contains entries describing |
| 3174 | the location of the manual pages." |
| 3175 | (interactive) |
| 3176 | (if erlang-man-inhibit |
| 3177 | () |
| 3178 | (setq erlang-menu-man-items |
| 3179 | '(nil |
| 3180 | ("Man - Function" erlang-man-function))) |
| 3181 | (if erlang-man-dirs |
| 3182 | (setq erlang-menu-man-items |
| 3183 | (append erlang-menu-man-items |
| 3184 | (erlang-man-make-top-menu erlang-man-dirs)))) |
| 3185 | (setq erlang-menu-items |
| 3186 | (erlang-menu-add-above 'erlang-menu-man-items |
| 3187 | 'erlang-menu-version-items |
| 3188 | erlang-menu-items)) |
| 3189 | (erlang-menu-init))) |
| 3190 | |
| 3191 | |
| 3192 | (defun erlang-man-uninstall () |
| 3193 | "Remove the man pages from the Erlang mode." |
| 3194 | (interactive) |
| 3195 | (setq erlang-menu-items |
| 3196 | (erlang-menu-delete 'erlang-menu-man-items erlang-menu-items)) |
| 3197 | (erlang-menu-init)) |
| 3198 | |
| 3199 | |
| 3200 | ;; The man menu is a hierarchal structure, with the manual sections |
| 3201 | ;; at the top, described by `erlang-man-dirs'. The next level could |
| 3202 | ;; either be the manual pages if not to many, otherwise it is an index |
| 3203 | ;; menu whose submenus will contain up to `erlang-man-max-menu-size' |
| 3204 | ;; manual pages. |
| 3205 | |
| 3206 | (defun erlang-man-make-top-menu (dir-list) |
| 3207 | "Create one menu entry per element of DIR-LIST. |
| 3208 | The format is described in the documentation of `erlang-man-dirs'." |
| 3209 | (let ((menu '()) |
| 3210 | dir) |
| 3211 | (while dir-list |
| 3212 | (setq dir (cond ((nth 2 (car dir-list)) |
| 3213 | ;; Relative to `erlang-root-dir'. |
| 3214 | (and (stringp erlang-root-dir) |
| 3215 | (concat erlang-root-dir (nth 1 (car dir-list))))) |
| 3216 | (t |
| 3217 | ;; Absolute |
| 3218 | (nth 1 (car dir-list))))) |
| 3219 | (if (and dir |
| 3220 | (file-readable-p dir)) |
| 3221 | (setq menu (cons (list (car (car dir-list)) |
| 3222 | (erlang-man-make-middle-menu |
| 3223 | (erlang-man-get-files dir))) |
| 3224 | menu))) |
| 3225 | (setq dir-list (cdr dir-list))) |
| 3226 | ;; Should no menus be found, generate a menu item which |
| 3227 | ;; will display a help text, when selected. |
| 3228 | (if menu |
| 3229 | (nreverse menu) |
| 3230 | '(("Man Pages" |
| 3231 | (("Error! Why?" erlang-man-describe-error))))))) |
| 3232 | |
| 3233 | |
| 3234 | ;; Should the menu be to long, let's split it into a number of |
| 3235 | ;; smaller menus. Warning, this code contains beatiful |
| 3236 | ;; destructive operations! |
| 3237 | (defun erlang-man-make-middle-menu (filelist) |
| 3238 | "Create the second level menu from FILELIST. |
| 3239 | |
| 3240 | Should the list be longer than `erlang-man-max-menu-size', a tree of |
| 3241 | menus is created." |
| 3242 | (if (<= (length filelist) erlang-man-max-menu-size) |
| 3243 | (erlang-man-make-menu filelist) |
| 3244 | (let ((menu '()) |
| 3245 | (filelist (copy-sequence filelist)) |
| 3246 | segment submenu pair) |
| 3247 | (while filelist |
| 3248 | (setq pair (nthcdr (- erlang-man-max-menu-size 1) filelist)) |
| 3249 | (setq segment filelist) |
| 3250 | (if (null pair) |
| 3251 | (setq filelist nil) |
| 3252 | (setq filelist (cdr pair)) |
| 3253 | (setcdr pair nil)) |
| 3254 | (setq submenu (erlang-man-make-menu segment)) |
| 3255 | (setq menu (cons (list (concat (car (car submenu)) |
| 3256 | " -- " |
| 3257 | (car (car (reverse submenu)))) |
| 3258 | submenu) |
| 3259 | menu))) |
| 3260 | (nreverse menu)))) |
| 3261 | |
| 3262 | |
| 3263 | (defun erlang-man-make-menu (filelist) |
| 3264 | "Make a leaf menu based on FILELIST." |
| 3265 | (let ((menu '()) |
| 3266 | item) |
| 3267 | (while filelist |
| 3268 | (setq item (erlang-man-make-menu-item (car filelist))) |
| 3269 | (if item |
| 3270 | (setq menu (cons item menu))) |
| 3271 | (setq filelist (cdr filelist))) |
| 3272 | (nreverse menu))) |
| 3273 | |
| 3274 | |
| 3275 | (defun erlang-man-make-menu-item (file) |
| 3276 | "Create a menu item containing the name of the man page." |
| 3277 | (and (string-match ".*/\\([^/]+\\)\\.[^.]$" file) |
| 3278 | (let ((page (substring file (match-beginning 1) (match-end 1)))) |
| 3279 | (list (capitalize page) |
| 3280 | (list 'lambda '() |
| 3281 | '(interactive) |
| 3282 | (list 'funcall 'erlang-man-display-function |
| 3283 | file)))))) |
| 3284 | |
| 3285 | |
| 3286 | (defun erlang-man-get-files (dir) |
| 3287 | "Return files in directory DIR." |
| 3288 | (directory-files dir t ".*\\.[0-9]\\'")) |
| 3289 | |
| 3290 | |
| 3291 | (defun erlang-man-module (&optional module) |
| 3292 | "Find manual page for MODULE, defaults to module of function under point. |
| 3293 | This function is aware of imported functions." |
| 3294 | (interactive |
| 3295 | (list (let* ((mod (car-safe (erlang-get-function-under-point))) |
| 3296 | (input (read-string |
| 3297 | (format "Manual entry for module%s: " |
| 3298 | (if (or (null mod) (string= mod "")) |
| 3299 | "" |
| 3300 | (format " (default %s)" mod)))))) |
| 3301 | (if (string= input "") |
| 3302 | mod |
| 3303 | input)))) |
| 3304 | (or module (setq module (car (erlang-get-function-under-point)))) |
| 3305 | (if (or (null module) (string= module "")) |
| 3306 | (error "No Erlang module name given")) |
| 3307 | (let ((dir-list erlang-man-dirs) |
| 3308 | (pat (concat "\\b" (regexp-quote module) "\\.[^.]$")) |
| 3309 | (file nil) |
| 3310 | file-list) |
| 3311 | (while (and dir-list (null file)) |
| 3312 | (setq file-list (erlang-man-get-files |
| 3313 | (if (nth 2 (car dir-list)) |
| 3314 | (concat erlang-root-dir (nth 1 (car dir-list))) |
| 3315 | (nth 1 (car dir-list))))) |
| 3316 | (while (and file-list (null file)) |
| 3317 | (if (string-match pat (car file-list)) |
| 3318 | (setq file (car file-list))) |
| 3319 | (setq file-list (cdr file-list))) |
| 3320 | (setq dir-list (cdr dir-list))) |
| 3321 | (if file |
| 3322 | (funcall erlang-man-display-function file) |
| 3323 | (error "No manual page for module %s found." module)))) |
| 3324 | |
| 3325 | |
| 3326 | ;; Warning, the function `erlang-man-function' is a hack! |
| 3327 | ;; It links itself into the man code in a non-clean way. I have |
| 3328 | ;; choosed to keep it since it provides a very useful functionality |
| 3329 | ;; which is not possible to achive using a clean approach. |
| 3330 | ;; / AndersL |
| 3331 | |
| 3332 | (defvar erlang-man-function-name nil |
| 3333 | "Name of function for last `erlang-man-function' call. |
| 3334 | Used for commnication between `erlang-man-function' and the |
| 3335 | patch to `Man-notify-when-ready'.") |
| 3336 | |
| 3337 | (defun erlang-man-function (&optional name) |
| 3338 | "Find manual page for NAME, where NAME is module:function. |
| 3339 | The entry for `function' is displayed. |
| 3340 | |
| 3341 | This function is aware of imported functions." |
| 3342 | (interactive |
| 3343 | (list (let* ((mod-func (erlang-get-function-under-point)) |
| 3344 | (mod (car-safe mod-func)) |
| 3345 | (func (nth 1 mod-func)) |
| 3346 | (input (read-string |
| 3347 | (format |
| 3348 | "Manual entry for `module:func' or `module'%s: " |
| 3349 | (if (or (null mod) (string= mod "")) |
| 3350 | "" |
| 3351 | (format " (default %s:%s)" mod func)))))) |
| 3352 | (if (string= input "") |
| 3353 | (if (and mod func) |
| 3354 | (concat mod ":" func) |
| 3355 | mod) |
| 3356 | input)))) |
| 3357 | ;; Emacs 18 doesn't provide `man'... |
| 3358 | (condition-case nil |
| 3359 | (require 'man) |
| 3360 | (error nil)) |
| 3361 | (let ((modname nil) |
| 3362 | (funcname nil)) |
| 3363 | (cond ((null name) |
| 3364 | (let ((mod-func (erlang-get-function-under-point))) |
| 3365 | (setq modname (car-safe mod-func)) |
| 3366 | (setq funcname (nth 1 mod-func)))) |
| 3367 | ((string-match ":" name) |
| 3368 | (setq modname (substring name 0 (match-beginning 0))) |
| 3369 | (setq funcname (substring name (match-end 0) nil))) |
| 3370 | ((stringp name) |
| 3371 | (setq modname name))) |
| 3372 | (if (or (null modname) (string= modname "")) |
| 3373 | (error "No Erlang module name given")) |
| 3374 | (cond ((fboundp 'Man-notify-when-ready) |
| 3375 | ;; Emacs 19: The man command could possibly start an |
| 3376 | ;; asyncronous process, i.e. we must hook ourselves into |
| 3377 | ;; the system to be activated when the man-process |
| 3378 | ;; terminates. |
| 3379 | (if (null funcname) |
| 3380 | () |
| 3381 | (erlang-man-patch-notify) |
| 3382 | (setq erlang-man-function-name funcname)) |
| 3383 | (condition-case nil |
| 3384 | (erlang-man-module modname) |
| 3385 | (error (setq erlang-man-function-name nil)))) |
| 3386 | (t |
| 3387 | (erlang-man-module modname) |
| 3388 | (if funcname |
| 3389 | (erlang-man-find-function |
| 3390 | (or (get-buffer "*Manual Entry*") ; Emacs 18 |
| 3391 | (current-buffer)) ; XEmacs |
| 3392 | funcname)))))) |
| 3393 | |
| 3394 | |
| 3395 | ;; Should the defadvice be at the top level, the package `advice' would |
| 3396 | ;; be required. Now it is only required when this functionality |
| 3397 | ;; is used. (Emacs 19 specific.) |
| 3398 | (defun erlang-man-patch-notify () |
| 3399 | "Patch the function `Man-notify-when-ready' to search for function. |
| 3400 | The variable `erlang-man-function-name' is assumed to be bound to |
| 3401 | the function name, or to nil. |
| 3402 | |
| 3403 | The reason for patching a function is that under Emacs 19, the man |
| 3404 | command is executed asynchronously." |
| 3405 | (condition-case nil |
| 3406 | (require 'advice) |
| 3407 | ;; This should never happend since this is only called when |
| 3408 | ;; running under Emacs 19. |
| 3409 | (error (error (concat "This commands needs the package `advice', " |
| 3410 | "please upgrade your Emacs.")))) |
| 3411 | (require 'man) |
| 3412 | (defadvice Man-notify-when-ready |
| 3413 | (after erlang-Man-notify-when-ready activate) |
| 3414 | "Sets point at the documentation of the function name in |
| 3415 | erlang-man-function-name when the man-page is displayed." |
| 3416 | (if erlang-man-function-name |
| 3417 | (erlang-man-find-function (ad-get-arg 0) erlang-man-function-name)) |
| 3418 | (setq erlang-man-function-name nil))) |
| 3419 | |
| 3420 | |
| 3421 | (defun erlang-man-find-function (buf func) |
| 3422 | "Find manual page for function in `erlang-man-function-name' in buffer BUF." |
| 3423 | (if func |
| 3424 | (let ((win (get-buffer-window buf))) |
| 3425 | (if win |
| 3426 | (progn |
| 3427 | (set-buffer buf) |
| 3428 | (goto-char (point-min)) |
| 3429 | (if (re-search-forward |
| 3430 | (concat "^[ \t]+" func " ?(") |
| 3431 | (point-max) t) |
| 3432 | (progn |
| 3433 | (forward-word -1) |
| 3434 | (set-window-point win (point))) |
| 3435 | (message "Could not find function `%s'" func))))))) |
| 3436 | |
| 3437 | |
| 3438 | (defun erlang-man-display (file) |
| 3439 | "Display FILE as a `man' file. |
| 3440 | This is de default manual page display function. |
| 3441 | The variables `erlang-man-display-function' contains the function |
| 3442 | to be used." |
| 3443 | ;; Emacs 18 doesn't `provide' man. |
| 3444 | (condition-case nil |
| 3445 | (require 'man) |
| 3446 | (error nil)) |
| 3447 | (if file |
| 3448 | (let ((process-environment (copy-sequence process-environment))) |
| 3449 | (if (string-match "\\(.*\\)/man[^/]*/\\([^/]+\\)\\.[^.]$" file) |
| 3450 | (let ((dir (substring file (match-beginning 1) (match-end 1))) |
| 3451 | (page (substring file (match-beginning 2) (match-end 2)))) |
| 3452 | (if (fboundp 'setenv) |
| 3453 | (setenv "MANPATH" dir) |
| 3454 | ;; Emacs 18 |
| 3455 | (setq process-environment (cons (concat "MANPATH=" dir) |
| 3456 | process-environment))) |
| 3457 | (cond ((not (and (not erlang-xemacs-p) |
| 3458 | (= erlang-emacs-major-version 19) |
| 3459 | (< erlang-emacs-minor-version 29))) |
| 3460 | (manual-entry page)) |
| 3461 | (t |
| 3462 | ;; Emacs 19.28 and earlier versions of 19: |
| 3463 | ;; The manual-entry command unconditionally prompts |
| 3464 | ;; the user :-( |
| 3465 | (funcall (symbol-function 'Man-getpage-in-background) |
| 3466 | page)))) |
| 3467 | (error "Can't find man page for %s\n" file))))) |
| 3468 | |
| 3469 | |
| 3470 | (defun erlang-man-describe-error () |
| 3471 | "Describe why the manual pages weren't found." |
| 3472 | (interactive) |
| 3473 | (with-output-to-temp-buffer "*Erlang Man Error*" |
| 3474 | (princ "Normally, this menu should contain Erlang manual pages. |
| 3475 | |
| 3476 | In order to find the manual pages, the variable `erlang-root-dir' |
| 3477 | should be bound to the name of the directory containing the Erlang |
| 3478 | installation. The name should not include the final slash. |
| 3479 | |
| 3480 | Practically, you should add a line on the following form to |
| 3481 | your ~/.emacs, or ask your system administrator to add it to |
| 3482 | the site init file: |
| 3483 | (setq erlang-root-dir \"/the/erlang/root/dir/goes/here\") |
| 3484 | |
| 3485 | For example: |
| 3486 | (setq erlang-root-dir \"/usr/local/erlang\") |
| 3487 | |
| 3488 | After installing the line, kill and restart Emacs, or restart Erlang |
| 3489 | mode with the command `M-x erlang-mode RET'."))) |
| 3490 | |
| 3491 | ;; Skeleton code: |
| 3492 | |
| 3493 | ;; This code is based on the package `tempo' which is part of modern |
| 3494 | ;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.) |
| 3495 | |
| 3496 | (defun erlang-skel-init () |
| 3497 | "Generate the skeleton functions and menu items. |
| 3498 | The variable `erlang-skel' contains the name and descriptions of |
| 3499 | all skeletons. |
| 3500 | |
| 3501 | The skeleton routines are based on the `tempo' package. Should this |
| 3502 | package not be present, this function does nothing." |
| 3503 | (interactive) |
| 3504 | (condition-case nil |
| 3505 | (require 'tempo) |
| 3506 | (error t)) |
| 3507 | (if (featurep 'tempo) |
| 3508 | (let ((skel erlang-skel) |
| 3509 | (menu '())) |
| 3510 | (while skel |
| 3511 | (cond ((null (car skel)) |
| 3512 | (setq menu (cons nil menu))) |
| 3513 | (t |
| 3514 | (funcall (symbol-function 'tempo-define-template) |
| 3515 | (concat "erlang-" (nth 1 (car skel))) |
| 3516 | ;; The tempo template used contains an `include' |
| 3517 | ;; function call only, hence changes to the |
| 3518 | ;; variables describing the templates take effect |
| 3519 | ;; immdiately. |
| 3520 | (list (list 'erlang-skel-include (nth 2 (car skel)))) |
| 3521 | (nth 1 (car skel))) |
| 3522 | (setq menu (cons (erlang-skel-make-menu-item |
| 3523 | (car skel)) menu)))) |
| 3524 | (setq skel (cdr skel))) |
| 3525 | (setq erlang-menu-skel-items |
| 3526 | (list nil (list "Skeletons" (nreverse menu)))) |
| 3527 | (setq erlang-menu-items |
| 3528 | (erlang-menu-add-above 'erlang-menu-skel-items |
| 3529 | 'erlang-menu-version-items |
| 3530 | erlang-menu-items)) |
| 3531 | (erlang-menu-init)))) |
| 3532 | |
| 3533 | (defun erlang-skel-make-menu-item (skel) |
| 3534 | (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel))))) |
| 3535 | (cond ((null (nth 3 skel)) |
| 3536 | (list (car skel) func)) |
| 3537 | (t |
| 3538 | (list (car skel) |
| 3539 | (list 'lambda '() |
| 3540 | '(interactive) |
| 3541 | (list 'funcall |
| 3542 | (list 'quote (nth 3 skel)) |
| 3543 | (list 'quote func)))))))) |
| 3544 | |
| 3545 | ;; Functions designed to be added to the skeleton menu. |
| 3546 | ;; (Not normally used) |
| 3547 | (defun erlang-skel-insert (func) |
| 3548 | "Insert skeleton generated by FUNC and goto first tempo mark." |
| 3549 | (save-excursion (funcall func)) |
| 3550 | (funcall (symbol-function 'tempo-forward-mark))) |
| 3551 | |
| 3552 | (defun erlang-skel-header (func) |
| 3553 | "Insert the header generated by FUNC at the beginning of the buffer." |
| 3554 | (goto-char (point-min)) |
| 3555 | (save-excursion (funcall func)) |
| 3556 | (funcall (symbol-function 'tempo-forward-mark))) |
| 3557 | |
| 3558 | |
| 3559 | ;; Functions used inside the skeleton descriptions. |
| 3560 | (defun erlang-skel-skip-blank () |
| 3561 | (skip-chars-backward " \t") |
| 3562 | nil) |
| 3563 | |
| 3564 | (defun erlang-skel-include (&rest args) |
| 3565 | "Include a template inside another template. |
| 3566 | |
| 3567 | Example of use, assuming that `erlang-skel-func' is defined: |
| 3568 | |
| 3569 | (defvar foo-skeleton '(\"%%% New function:\" |
| 3570 | (erlang-skel-include erlang-skel-func))) |
| 3571 | |
| 3572 | Techically, this function returns the `tempo' attribute`(l ...)' which |
| 3573 | can contain other `tempo' attributes. Please see the function |
| 3574 | `tempo-define-template' for a description of the `(l ...)' attribute." |
| 3575 | (let ((res '()) |
| 3576 | entry) |
| 3577 | (while args |
| 3578 | (setq entry (car args)) |
| 3579 | (while entry |
| 3580 | (setq res (cons (car entry) res)) |
| 3581 | (setq entry (cdr entry))) |
| 3582 | (setq args (cdr args))) |
| 3583 | (cons 'l (nreverse res)))) |
| 3584 | |
| 3585 | (defun erlang-skel-separator (&optional percent) |
| 3586 | "Return a comment separator." |
| 3587 | (let ((percent (or percent 3))) |
| 3588 | (concat (make-string percent ?%) |
| 3589 | (make-string (- 70 percent) ?-) |
| 3590 | "\n"))) |
| 3591 | |
| 3592 | (defun erlang-skel-double-separator (&optional percent) |
| 3593 | "Return a comment separator." |
| 3594 | (let ((percent (or percent 3))) |
| 3595 | (concat (make-string percent ?%) |
| 3596 | (make-string (- 70 percent) ?=) |
| 3597 | "\n"))) |
| 3598 | |
| 3599 | (defun erlang-skel-dd-mmm-yyyy () |
| 3600 | "Return the current date as a string in \"DD Mon YYYY\" form. |
| 3601 | The first character of DD is space if the value is less than 10." |
| 3602 | (let ((date (current-time-string))) |
| 3603 | (format "%2d %s %s" |
| 3604 | (string-to-int (substring date 8 10)) |
| 3605 | (substring date 4 7) |
| 3606 | (substring date -4)))) |
| 3607 | |
| 3608 | ;; Indentation code: |
| 3609 | |
| 3610 | (defun erlang-indent-command (&optional whole-exp) |
| 3611 | "Indent current line as Erlang code. |
| 3612 | With argument, indent any additional lines of the same clause |
| 3613 | rigidly along with this one." |
| 3614 | (interactive "P") |
| 3615 | (if whole-exp |
| 3616 | ;; If arg, alwys indent this line as Erlang |
| 3617 | ;; and shift remaining lines of clause the same amount. |
| 3618 | (let ((shift-amt (erlang-indent-line)) |
| 3619 | beg end) |
| 3620 | (save-excursion |
| 3621 | (if erlang-tab-always-indent |
| 3622 | (beginning-of-line)) |
| 3623 | (setq beg (point)) |
| 3624 | (erlang-end-of-clause 1) |
| 3625 | (setq end (point)) |
| 3626 | (goto-char beg) |
| 3627 | (forward-line 1) |
| 3628 | (setq beg (point))) |
| 3629 | (if (> end beg) |
| 3630 | (indent-code-rigidly beg end shift-amt "\n"))) |
| 3631 | (if (and (not erlang-tab-always-indent) |
| 3632 | (save-excursion |
| 3633 | (skip-chars-backward " \t") |
| 3634 | (not (bolp)))) |
| 3635 | (insert-tab) |
| 3636 | (erlang-indent-line)))) |
| 3637 | |
| 3638 | |
| 3639 | (defun erlang-indent-line () |
| 3640 | "Indent current line as Erlang code. |
| 3641 | Return the amount the indentation changed by." |
| 3642 | (let ((pos (- (point-max) (point))) |
| 3643 | indent beg |
| 3644 | shift-amt) |
| 3645 | (beginning-of-line 1) |
| 3646 | (setq beg (point)) |
| 3647 | (skip-chars-forward " \t") |
| 3648 | (cond ((looking-at "%") |
| 3649 | (setq indent (funcall comment-indent-function)) |
| 3650 | (setq shift-amt (- indent (current-column)))) |
| 3651 | (t |
| 3652 | (setq indent (erlang-calculate-indent)) |
| 3653 | (cond ((null indent) |
| 3654 | (setq indent (current-indentation))) |
| 3655 | ((eq indent t) |
| 3656 | ;; This should never occur here. |
| 3657 | (error "Erlang mode error")) |
| 3658 | ((= (char-syntax (following-char)) ?\)) |
| 3659 | (setq indent (1- indent)))) |
| 3660 | (setq shift-amt (- indent (current-column))))) |
| 3661 | (if (zerop shift-amt) |
| 3662 | nil |
| 3663 | (delete-region beg (point)) |
| 3664 | (indent-to indent)) |
| 3665 | ;; If initial point was within line's indentation, position |
| 3666 | ;; after the indentation. Else stay at same point in text. |
| 3667 | (if (> (- (point-max) pos) (point)) |
| 3668 | (goto-char (- (point-max) pos))) |
| 3669 | shift-amt)) |
| 3670 | |
| 3671 | |
| 3672 | (defun erlang-indent-region (beg end) |
| 3673 | "Indent region of erlang code. |
| 3674 | |
| 3675 | This is automagically called by the user level function `indent-region'." |
| 3676 | (interactive "r") |
| 3677 | (save-excursion |
| 3678 | (let ((case-fold-search nil) |
| 3679 | (continue t) |
| 3680 | (from-end (- (point-max) end)) |
| 3681 | indent-point ;; The beginning of the current line |
| 3682 | indent ;; The indent amount |
| 3683 | state) |
| 3684 | (goto-char beg) |
| 3685 | (beginning-of-line) |
| 3686 | (setq indent-point (point)) |
| 3687 | (erlang-beginning-of-clause) |
| 3688 | ;; Parse the Erlang code from the beginning of the clause to |
| 3689 | ;; the beginning of the region. |
| 3690 | (while (< (point) indent-point) |
| 3691 | (setq state (erlang-partial-parse (point) indent-point state))) |
| 3692 | ;; Indent every line in the region |
| 3693 | (while continue |
| 3694 | (goto-char indent-point) |
| 3695 | (skip-chars-forward " \t") |
| 3696 | (cond ((looking-at "%") |
| 3697 | ;; Do not use our stack to help the user to customize |
| 3698 | ;; comment indentation. |
| 3699 | (setq indent (funcall comment-indent-function))) |
| 3700 | ((looking-at "$") |
| 3701 | ;; Don't indent empty lines. |
| 3702 | (setq indent 0)) |
| 3703 | (t |
| 3704 | (setq indent |
| 3705 | (save-excursion |
| 3706 | (erlang-calculate-stack-indent (point) state))) |
| 3707 | (cond ((null indent) |
| 3708 | (setq indent (current-indentation))) |
| 3709 | ((eq indent t) |
| 3710 | ;; This should never occur here. |
| 3711 | (error "Erlang mode error")) |
| 3712 | ((= (char-syntax (following-char)) ?\)) |
| 3713 | (setq indent (1- indent)))))) |
| 3714 | (if (zerop (- indent (current-column))) |
| 3715 | nil |
| 3716 | (delete-region indent-point (point)) |
| 3717 | (indent-to indent)) |
| 3718 | ;; Find the next line in the region |
| 3719 | (goto-char indent-point) |
| 3720 | (save-excursion |
| 3721 | (forward-line 1) |
| 3722 | (setq indent-point (point))) |
| 3723 | (if (>= from-end (- (point-max) indent-point)) |
| 3724 | (setq continue nil) |
| 3725 | (while (< (point) indent-point) |
| 3726 | (setq state (erlang-partial-parse |
| 3727 | (point) indent-point state)))))))) |
| 3728 | |
| 3729 | |
| 3730 | (defun erlang-indent-current-buffer () |
| 3731 | "Indent current buffer as Erlang code." |
| 3732 | (interactive) |
| 3733 | (save-excursion |
| 3734 | (save-restriction |
| 3735 | (widen) |
| 3736 | (erlang-indent-region (point-min) (point-max))))) |
| 3737 | |
| 3738 | |
| 3739 | (defun erlang-indent-function () |
| 3740 | "Indent current Erlang function." |
| 3741 | (interactive) |
| 3742 | (save-excursion |
| 3743 | (let ((end (progn (erlang-end-of-function 1) (point))) |
| 3744 | (beg (progn (erlang-beginning-of-function 1) (point)))) |
| 3745 | (erlang-indent-region beg end)))) |
| 3746 | |
| 3747 | |
| 3748 | (defun erlang-indent-clause () |
| 3749 | "Indent current Erlang clause." |
| 3750 | (interactive) |
| 3751 | (save-excursion |
| 3752 | (let ((end (progn (erlang-end-of-clause 1) (point))) |
| 3753 | (beg (progn (erlang-beginning-of-clause 1) (point)))) |
| 3754 | (erlang-indent-region beg end)))) |
| 3755 | |
| 3756 | |
| 3757 | (defmacro erlang-push (x stack) (list 'setq stack (list 'cons x stack))) |
| 3758 | (defmacro erlang-pop (stack) (list 'setq stack (list 'cdr stack))) |
| 3759 | ;; Would much prefer to make caddr a macro but this clashes. |
| 3760 | (defun erlang-caddr (x) (car (cdr (cdr x)))) |
| 3761 | |
| 3762 | |
| 3763 | (defun erlang-calculate-indent (&optional parse-start) |
| 3764 | "Compute appropriate indentation for current line as Erlang code. |
| 3765 | Return nil if line starts inside string, t if in a comment." |
| 3766 | (save-excursion |
| 3767 | (let ((indent-point (point)) |
| 3768 | (case-fold-search nil) |
| 3769 | (state nil)) |
| 3770 | (if parse-start |
| 3771 | (goto-char parse-start) |
| 3772 | (erlang-beginning-of-clause)) |
| 3773 | (while (< (point) indent-point) |
| 3774 | (setq state (erlang-partial-parse (point) indent-point state))) |
| 3775 | (erlang-calculate-stack-indent indent-point state)))) |
| 3776 | |
| 3777 | (defun erlang-show-syntactic-information () |
| 3778 | "Show syntactic information for current line." |
| 3779 | |
| 3780 | (interactive) |
| 3781 | |
| 3782 | (save-excursion |
| 3783 | (let ((starting-point (point)) |
| 3784 | (case-fold-search nil) |
| 3785 | (state nil)) |
| 3786 | (erlang-beginning-of-clause) |
| 3787 | (while (< (point) starting-point) |
| 3788 | (setq state (erlang-partial-parse (point) starting-point state))) |
| 3789 | (message "%S" state)))) |
| 3790 | |
| 3791 | |
| 3792 | (defun erlang-partial-parse (from to &optional state) |
| 3793 | "Parse Erlang syntax starting at FROM until TO, with an optional STATE. |
| 3794 | Value is list (stack token-start token-type in-what)." |
| 3795 | (goto-char from) ; Start at the beginning |
| 3796 | (erlang-skip-blank to) |
| 3797 | (let ((cs (char-syntax (following-char))) |
| 3798 | (stack (car state)) |
| 3799 | (token (point)) |
| 3800 | in-what) |
| 3801 | (cond |
| 3802 | |
| 3803 | ;; Done: Return previous state. |
| 3804 | ((>= token to) |
| 3805 | (setq token (nth 1 state)) |
| 3806 | (setq cs (nth 2 state)) |
| 3807 | (setq in-what (nth 3 state))) |
| 3808 | ;; Word constituent: check and handle keywords. |
| 3809 | ((= cs ?w) |
| 3810 | (if (looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]") |
| 3811 | ;; Must pop top icr layer, `after' will push a new |
| 3812 | ;; layer next. |
| 3813 | (progn |
| 3814 | (while (and stack (eq (car (car stack)) '->)) |
| 3815 | (erlang-pop stack)) |
| 3816 | (if (and stack (memq (car (car stack)) '(icr begin))) |
| 3817 | (erlang-pop stack)))) |
| 3818 | (cond ((looking-at |
| 3819 | "\\(if\\|case\\|receive\\|after\\)[^_a-zA-Z0-9]") |
| 3820 | ;; Must push a new icr (if/case/receive) layer. |
| 3821 | (erlang-push (list 'icr token (current-column)) stack)) |
| 3822 | ((looking-at "\\(fun\\)[^_a-zA-Z0-9]") |
| 3823 | ;; Puch a new icr layer if we are defining a `fun' |
| 3824 | ;; expression, not when we are refering an existing |
| 3825 | ;; function. |
| 3826 | (if (save-excursion |
| 3827 | (goto-char (match-end 1)) |
| 3828 | (erlang-skip-blank to) |
| 3829 | (eq (following-char) ?\()) |
| 3830 | (erlang-push (list 'icr token (current-column)) stack))) |
| 3831 | ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]") |
| 3832 | (erlang-push (list 'begin token (current-column)) stack)) |
| 3833 | ((looking-at "when[^_a-zA-Z0-9]") |
| 3834 | (erlang-push (list 'when token (current-column)) stack))) |
| 3835 | (forward-sexp 1)) |
| 3836 | |
| 3837 | ;; String: Try to skip over it. (Catch error if not complete.) |
| 3838 | ((= cs ?\") |
| 3839 | (condition-case nil |
| 3840 | (progn |
| 3841 | (forward-sexp 1) |
| 3842 | (if (> (point) to) |
| 3843 | (progn |
| 3844 | (setq in-what 'string) |
| 3845 | (goto-char to)))) |
| 3846 | (error |
| 3847 | (setq in-what 'string) |
| 3848 | (goto-char to)))) |
| 3849 | |
| 3850 | ;; Symbol constituent, punctuation, or expression prefix? |
| 3851 | ((memq cs '(?. ?_ ?')) |
| 3852 | (cond |
| 3853 | |
| 3854 | ;; Clause end |
| 3855 | ((= (following-char) ?\;) |
| 3856 | (if (and stack (eq (car (car stack)) '->)) |
| 3857 | (erlang-pop stack)) |
| 3858 | (forward-char 1)) |
| 3859 | |
| 3860 | ;; Function end |
| 3861 | ((looking-at "\\.\\(\\s \\|\n\\|\\s<\\)") |
| 3862 | (setq stack nil) |
| 3863 | (forward-char 1)) |
| 3864 | |
| 3865 | ;; Function head |
| 3866 | ((looking-at "->\\|:-") |
| 3867 | (if (and stack (eq (car (car stack)) 'when)) |
| 3868 | (erlang-pop stack)) |
| 3869 | (erlang-push (list '-> token (current-column)) stack) |
| 3870 | (forward-char 2)) |
| 3871 | |
| 3872 | ;; List-comprehension divider |
| 3873 | ((looking-at "||") |
| 3874 | (erlang-push (list '|| token (current-column)) stack) |
| 3875 | (forward-char 2)) |
| 3876 | |
| 3877 | ;; Bit-syntax open paren |
| 3878 | ((looking-at "<<") |
| 3879 | (erlang-push (list '\( token (current-column)) stack) |
| 3880 | (forward-char 2)) |
| 3881 | |
| 3882 | ;; Bbit-syntax close paren |
| 3883 | ((looking-at ">>") |
| 3884 | (while (memq (car (car stack)) '(|| ->)) |
| 3885 | (erlang-pop stack)) |
| 3886 | (cond ((eq (car (car stack)) '\() |
| 3887 | (erlang-pop stack)) |
| 3888 | ((memq (car (car stack)) '(icr begin)) |
| 3889 | (error "Missing `end'")) |
| 3890 | (t |
| 3891 | (error "Unbalanced parentheses"))) |
| 3892 | (forward-char 2)) |
| 3893 | |
| 3894 | ;; Macro |
| 3895 | ((= (following-char) ??) |
| 3896 | ;; Skip over macro name and any following whitespace. |
| 3897 | (forward-word 1) |
| 3898 | (skip-syntax-forward "-" to) |
| 3899 | ;; Macro might have an argument list. Skip it too. |
| 3900 | (when (= (following-char) ?\() |
| 3901 | (forward-list 1))) |
| 3902 | |
| 3903 | ;; Other punctuation: Skip over it and any following punctuation |
| 3904 | ((= cs ?.) |
| 3905 | ;; Skip over all characters in the operand. |
| 3906 | (skip-syntax-forward ".")) |
| 3907 | |
| 3908 | ;; Other char: Skip over it. |
| 3909 | (t |
| 3910 | (forward-char 1)))) |
| 3911 | |
| 3912 | ;; Open parenthesis |
| 3913 | ((= cs ?\() |
| 3914 | (erlang-push (list '\( token (current-column)) stack) |
| 3915 | (forward-char 1)) |
| 3916 | |
| 3917 | ;; Close parenthesis |
| 3918 | ((= cs ?\)) |
| 3919 | (while (memq (car (car stack)) '(|| ->)) |
| 3920 | (erlang-pop stack)) |
| 3921 | (cond ((eq (car (car stack)) '\() |
| 3922 | (erlang-pop stack)) |
| 3923 | ((memq (car (car stack)) '(icr begin)) |
| 3924 | (error "Missing `end'")) |
| 3925 | (t |
| 3926 | (error "Unbalanced parenthesis"))) |
| 3927 | (forward-char 1)) |
| 3928 | |
| 3929 | ;; Character quote: Skip it and the quoted char. |
| 3930 | ((= cs ?/) |
| 3931 | (forward-char 2)) |
| 3932 | |
| 3933 | ;; Character escape: Skip it and the escape sequence. |
| 3934 | ((= cs ?\\) |
| 3935 | (forward-char 1) |
| 3936 | (skip-syntax-forward "w")) |
| 3937 | |
| 3938 | ;; Everything else |
| 3939 | (t |
| 3940 | (forward-char 1))) |
| 3941 | (list stack token cs in-what))) |
| 3942 | |
| 3943 | |
| 3944 | (defun erlang-calculate-stack-indent (indent-point state) |
| 3945 | "From the given last position and state (stack) calculate indentation. |
| 3946 | Return nil if inside string, t if in a comment." |
| 3947 | (let* ((stack (and state (car state))) |
| 3948 | (token (nth 1 state)) |
| 3949 | (stack-top (and stack (car stack)))) |
| 3950 | (cond ((null state) ;No state |
| 3951 | 0) |
| 3952 | ((nth 3 state) |
| 3953 | ;; Return nil or t. |
| 3954 | (eq (nth 3 state) 'comment)) |
| 3955 | ((null stack) |
| 3956 | (if (looking-at "when[^_a-zA-Z0-9]") |
| 3957 | erlang-indent-guard |
| 3958 | 0)) |
| 3959 | ((eq (car stack-top) '\() |
| 3960 | ;; Element of list, tuple or part of an expression, |
| 3961 | (if (null erlang-argument-indent) |
| 3962 | ;; indent to next column. |
| 3963 | (1+ (nth 2 stack-top)) |
| 3964 | (goto-char (nth 1 stack-top)) |
| 3965 | (cond ((looking-at "[({]\\s *\\($\\|%\\)") |
| 3966 | ;; Line ends with parenthesis. |
| 3967 | (+ (erlang-indent-find-preceding-expr) |
| 3968 | erlang-argument-indent)) |
| 3969 | (t |
| 3970 | ;; Indent to the same column as the first |
| 3971 | ;; argument. |
| 3972 | (goto-char (1+ (nth 1 stack-top))) |
| 3973 | (skip-chars-forward " \t") |
| 3974 | (current-column))))) |
| 3975 | ((eq (car stack-top) 'icr) |
| 3976 | ;; The default indentation is the column of the option |
| 3977 | ;; directly following the keyword. (This does not apply to |
| 3978 | ;; `case'.) Should no option be on the same line, the |
| 3979 | ;; indentation is the indentation of the keyword + |
| 3980 | ;; `erlang-indent-level'. |
| 3981 | ;; |
| 3982 | ;; `after' should be indentated to the save level as the |
| 3983 | ;; corresponding receive. |
| 3984 | (if (looking-at "after[^_a-zA-Z0-9]") |
| 3985 | (nth 2 stack-top) |
| 3986 | (save-excursion |
| 3987 | (goto-char (nth 1 stack-top)) |
| 3988 | (if (looking-at "case[^_a-zA-Z0-9]") |
| 3989 | (+ (nth 2 stack-top) erlang-indent-level) |
| 3990 | (skip-chars-forward "a-z") |
| 3991 | (skip-chars-forward " \t") |
| 3992 | (if (memq (following-char) '(?% ?\n)) |
| 3993 | (+ (nth 2 stack-top) erlang-indent-level) |
| 3994 | (current-column)))))) |
| 3995 | ;; Real indentation, where operators create extra indentation etc. |
| 3996 | ((memq (car stack-top) '(-> || begin)) |
| 3997 | (goto-char (nth 1 stack-top)) |
| 3998 | ;; Check if there is more code after the '->' on the |
| 3999 | ;; same line. If so use this indentation as base, else |
| 4000 | ;; use parent indentation + 2 * level as base. |
| 4001 | (let ((off erlang-indent-level) |
| 4002 | (skip 2)) |
| 4003 | (cond ((null (cdr stack))) ; Top level in function. |
| 4004 | ((eq (car stack-top) 'begin) |
| 4005 | (setq skip 5)) |
| 4006 | ((eq (car stack-top) '->) |
| 4007 | (setq off (* 2 erlang-indent-level)))) |
| 4008 | (let ((base (erlang-indent-find-base stack indent-point off skip))) |
| 4009 | ;; Look at last thing to see how we are to move relative |
| 4010 | ;; to the base. |
| 4011 | (goto-char token) |
| 4012 | (cond ((looking-at "||\\|,\\|->\\|:-") |
| 4013 | base) |
| 4014 | ((erlang-at-keyword) |
| 4015 | (+ (current-column) erlang-indent-level)) |
| 4016 | ((or (= (char-syntax (following-char)) ?.) |
| 4017 | (erlang-at-operator)) |
| 4018 | (+ base erlang-indent-level)) |
| 4019 | (t |
| 4020 | (goto-char indent-point) |
| 4021 | (cond ((memq (following-char) '(?\( ?{)) |
| 4022 | ;; Function application or record. |
| 4023 | (+ (erlang-indent-find-preceding-expr) |
| 4024 | erlang-argument-indent)) |
| 4025 | ;; Empty line, or end; treat it as the end of |
| 4026 | ;; the block. (Here we have a choice: should |
| 4027 | ;; the user be forced to reindent continued |
| 4028 | ;; lines, or should the "end" be reindented?) |
| 4029 | ((looking-at "\\(end\\|after\\)[^_a-zA-Z0-9]\\|$") |
| 4030 | (if (eq (car (car stack)) '->) |
| 4031 | (erlang-pop stack)) |
| 4032 | (if stack |
| 4033 | (erlang-caddr (car stack)) |
| 4034 | 0)) |
| 4035 | ;; Avoid trating comments a continued line. |
| 4036 | ((= (following-char) ?%) |
| 4037 | base) |
| 4038 | ;; Continued line (e.g. line beginning |
| 4039 | ;; with an operator.) |
| 4040 | (t (+ base erlang-indent-level)))))))) |
| 4041 | ((eq (car stack-top) 'when) |
| 4042 | (goto-char (nth 1 stack-top)) |
| 4043 | (if (looking-at "when\\s *\\($\\|%\\)") |
| 4044 | (progn |
| 4045 | (erlang-pop stack) |
| 4046 | (if (and stack (eq (nth 0 (car stack)) 'icr)) |
| 4047 | (progn |
| 4048 | (goto-char (nth 1 (car stack))) |
| 4049 | (+ (nth 2 (car stack)) erlang-indent-guard |
| 4050 | ;; receive XYZ or receive |
| 4051 | ;; XYZ |
| 4052 | (if (looking-at "[a-z]+\\s *\\($\\|%\\)") |
| 4053 | erlang-indent-level |
| 4054 | (* 2 erlang-indent-level)))) |
| 4055 | erlang-indent-guard)) |
| 4056 | ;; "when" is followed by code, let's indent to the same |
| 4057 | ;; column. |
| 4058 | (forward-char 4) ; Skip "when" |
| 4059 | (skip-chars-forward " \t") |
| 4060 | (current-column)))))) |
| 4061 | |
| 4062 | |
| 4063 | (defun erlang-indent-find-base (stack indent-point &optional offset skip) |
| 4064 | "Find the base column for current stack." |
| 4065 | (or skip (setq skip 2)) |
| 4066 | (or offset (setq offset erlang-indent-level)) |
| 4067 | (save-excursion |
| 4068 | (let* ((stack-top (car stack))) |
| 4069 | (goto-char (nth 1 stack-top)) |
| 4070 | (forward-char skip) |
| 4071 | (if (looking-at "\\s *\\($\\|%\\)") |
| 4072 | (progn |
| 4073 | (if (memq (car stack-top) '(-> ||)) |
| 4074 | (erlang-pop stack)) |
| 4075 | ;; Take parent identation + offset, |
| 4076 | ;; else just erlang-indent-level if no parent |
| 4077 | (if stack |
| 4078 | (+ (erlang-caddr (car stack)) |
| 4079 | offset) |
| 4080 | erlang-indent-level)) |
| 4081 | (erlang-skip-blank indent-point) |
| 4082 | (current-column))))) |
| 4083 | |
| 4084 | |
| 4085 | ;; Does not handle `begin' .. `end'. |
| 4086 | (defun erlang-indent-find-preceding-expr () |
| 4087 | "Return the first column of the preceding expression. |
| 4088 | This assumes that the preceding expression is either simple |
| 4089 | \(i.e. an atom) or parenthesized." |
| 4090 | (save-excursion |
| 4091 | (forward-sexp -1) |
| 4092 | (let ((col (current-column))) |
| 4093 | (skip-chars-backward " \t") |
| 4094 | ;; Needed to match the colon in "'foo':'bar'". |
| 4095 | (if (not (memq (preceding-char) '(?# ?:))) |
| 4096 | col |
| 4097 | (backward-char 1) |
| 4098 | (forward-sexp -1) |
| 4099 | (current-column))))) |
| 4100 | |
| 4101 | |
| 4102 | (defun erlang-skip-blank (&optional lim) |
| 4103 | "Skip over whitespace and comments until limit reached." |
| 4104 | (or lim (setq lim (point-max))) |
| 4105 | (let (stop) |
| 4106 | (while (and (not stop) (< (point) lim)) |
| 4107 | (cond ((= (following-char) ?%) |
| 4108 | (skip-chars-forward "^\n" lim)) |
| 4109 | ((= (following-char) ?\n) |
| 4110 | (skip-chars-forward "\n" lim)) |
| 4111 | ((looking-at "\\s ") |
| 4112 | (if (re-search-forward "\\S " lim 'move) |
| 4113 | (forward-char -1))) |
| 4114 | (t |
| 4115 | (setq stop t)))) |
| 4116 | stop)) |
| 4117 | |
| 4118 | (defun erlang-at-keyword () |
| 4119 | "Are we looking at an Erlang keyword which will increase indentation?" |
| 4120 | (looking-at (concat "\\(when\\|if\\|fun\\|case\\|begin\\|query\\|" |
| 4121 | "of\\|receive\\|after\\|catch\\)[^_a-zA-Z0-9]"))) |
| 4122 | |
| 4123 | (defun erlang-at-operator () |
| 4124 | "Are we looking at an Erlang operator?" |
| 4125 | (looking-at |
| 4126 | "\\(bnot\\|div\\|mod\\|band\\|bor\\|bxor\\|bsl\\|bsr\\)[^_a-zA-Z0-9]")) |
| 4127 | |
| 4128 | (defun erlang-comment-indent () |
| 4129 | "Compute erlang comment indentation. |
| 4130 | |
| 4131 | Used both by `indent-for-comment' and the erlang specific indentation |
| 4132 | commands." |
| 4133 | (cond ((looking-at "%%%") 0) |
| 4134 | ((looking-at "%%") |
| 4135 | (or (erlang-calculate-indent) |
| 4136 | (current-indentation))) |
| 4137 | (t |
| 4138 | (save-excursion |
| 4139 | (skip-chars-backward " \t") |
| 4140 | (max (if (bolp) 0 (1+ (current-column))) |
| 4141 | comment-column))))) |
| 4142 | |
| 4143 | ;;; Erlang movement commands |
| 4144 | |
| 4145 | ;; All commands below work as movement commands. I.e. if the point is |
| 4146 | ;; at the end of the clause, and the command `erlang-end-of-clause' is |
| 4147 | ;; executed, the point is moved to the end of the NEXT clause. (This |
| 4148 | ;; mimics the behaviour of `end-of-defun'.) |
| 4149 | ;; |
| 4150 | ;; Personally I would like to rewrite them to be "pure", and add a set |
| 4151 | ;; of movement functions, like `erlang-next-clause', |
| 4152 | ;; `erlang-previous-clause', and the same for functions. |
| 4153 | ;; |
| 4154 | ;; The current implementation makes it hopeless to use the functions as |
| 4155 | ;; subroutines in more complex commands. /andersl |
| 4156 | |
| 4157 | (defun erlang-beginning-of-clause (&optional arg) |
| 4158 | "Move backward to previous start of clause. |
| 4159 | With argument, do this that many times. |
| 4160 | Return t unless search stops due to end of buffer." |
| 4161 | (interactive "p") |
| 4162 | (or arg (setq arg 1)) |
| 4163 | (if (< arg 0) |
| 4164 | ;; Step back to the end of the previous line, unless we are at |
| 4165 | ;; the beginning of the buffer. The reason for this move is |
| 4166 | ;; that the regexp below includes the last character of the |
| 4167 | ;; previous line. |
| 4168 | (if (bobp) |
| 4169 | (or (looking-at "\n") |
| 4170 | (forward-char 1)) |
| 4171 | (forward-char -1) |
| 4172 | (if (looking-at "\\`\n") |
| 4173 | (forward-char 1)))) |
| 4174 | ;; The regexp matches a function header that isn't |
| 4175 | ;; included in a string. |
| 4176 | (and (re-search-forward "\\(\\`\\|\\`\n\\|[^\\]\n\\)\\([a-z]\\|'\\|-\\)" |
| 4177 | nil 'move (- arg)) |
| 4178 | (let ((beg (match-beginning 2))) |
| 4179 | (and beg (goto-char beg)) |
| 4180 | t))) |
| 4181 | |
| 4182 | (defun erlang-end-of-clause (&optional arg) |
| 4183 | "Move to the end of the current clause. |
| 4184 | With argument, do this that many times." |
| 4185 | (interactive "p") |
| 4186 | (or arg (setq arg 1)) |
| 4187 | (while (and (looking-at "[ \t]*[%\n]") |
| 4188 | (zerop (forward-line 1)))) |
| 4189 | ;; Move to the next clause. |
| 4190 | (erlang-beginning-of-clause (- arg)) |
| 4191 | (beginning-of-line) ;; Just to be sure... |
| 4192 | (let ((continue t)) |
| 4193 | (while (and (not (bobp)) continue) |
| 4194 | (forward-line -1) |
| 4195 | (skip-chars-forward " \t") |
| 4196 | (if (looking-at "[%\n]") |
| 4197 | nil |
| 4198 | (end-of-line) |
| 4199 | (setq continue nil))))) |
| 4200 | |
| 4201 | (defun erlang-mark-clause () |
| 4202 | "Put mark at end of clause, point at beginning." |
| 4203 | (interactive) |
| 4204 | (push-mark (point)) |
| 4205 | (erlang-end-of-clause 1) |
| 4206 | ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate |
| 4207 | ;; the region. |
| 4208 | (condition-case nil |
| 4209 | (push-mark (point) nil t) |
| 4210 | (error (push-mark (point)))) |
| 4211 | (erlang-beginning-of-clause 1) |
| 4212 | ;; The above function deactivates the mark. |
| 4213 | (if (boundp 'deactivate-mark) |
| 4214 | (funcall (symbol-function 'set) 'deactivate-mark nil))) |
| 4215 | |
| 4216 | (defun erlang-beginning-of-function (&optional arg) |
| 4217 | "Move backward to previous start of function. |
| 4218 | With positive argument, do this that many times. |
| 4219 | With negative argument, search forward. |
| 4220 | |
| 4221 | Return t unless search stops due to end of buffer." |
| 4222 | (interactive "p") |
| 4223 | (or arg (setq arg 1)) |
| 4224 | (cond |
| 4225 | ;; Search backward |
| 4226 | ((> arg 0) |
| 4227 | (while (and (> arg 0) |
| 4228 | (and (erlang-beginning-of-clause 1) |
| 4229 | (let ((start (point)) |
| 4230 | (name (erlang-name-of-function)) |
| 4231 | (arity (erlang-get-function-arity))) |
| 4232 | ;; Note: "arity" is nil for e.g. "-import", hence |
| 4233 | ;; two "-import" clauses are not considered to |
| 4234 | ;; be part of the same function. |
| 4235 | (while (and (erlang-beginning-of-clause 1) |
| 4236 | (string-equal name |
| 4237 | (erlang-name-of-function)) |
| 4238 | arity |
| 4239 | (equal arity |
| 4240 | (erlang-get-function-arity))) |
| 4241 | (setq start (point))) |
| 4242 | (goto-char start) |
| 4243 | t))) |
| 4244 | (setq arg (1- arg)))) |
| 4245 | ;; Search forward |
| 4246 | ((< arg 0) |
| 4247 | (end-of-line) |
| 4248 | (erlang-beginning-of-clause 1) |
| 4249 | ;; Step -arg functions forward. |
| 4250 | (while (and (< arg 0) |
| 4251 | ;; Step one function forward, or stop if the end of |
| 4252 | ;; the buffer was reached. Return t if we found the |
| 4253 | ;; function. |
| 4254 | (let ((name (erlang-name-of-function)) |
| 4255 | (arity (erlang-get-function-arity)) |
| 4256 | (found (erlang-beginning-of-clause -1))) |
| 4257 | (while (and found |
| 4258 | (string-equal name (erlang-name-of-function)) |
| 4259 | arity |
| 4260 | (equal arity |
| 4261 | (erlang-get-function-arity))) |
| 4262 | (setq found (erlang-beginning-of-clause -1))) |
| 4263 | found)) |
| 4264 | (setq arg (1+ arg))))) |
| 4265 | (zerop arg)) |
| 4266 | |
| 4267 | |
| 4268 | (defun erlang-end-of-function (&optional arg) |
| 4269 | "Move forward to next end of function. |
| 4270 | |
| 4271 | With argument, do this that many times. |
| 4272 | With negative argument go towards the beginning of the buffer." |
| 4273 | (interactive "p") |
| 4274 | (or arg (setq arg 1)) |
| 4275 | (let ((first t)) |
| 4276 | ;; Forward |
| 4277 | (while (and (> arg 0) (< (point) (point-max))) |
| 4278 | (let ((pos (point))) |
| 4279 | (while (progn |
| 4280 | (if (and first |
| 4281 | (progn |
| 4282 | (forward-char 1) |
| 4283 | (erlang-beginning-of-clause 1))) |
| 4284 | nil |
| 4285 | (or (bobp) (forward-char -1)) |
| 4286 | (erlang-beginning-of-clause -1)) |
| 4287 | (setq first nil) |
| 4288 | (erlang-pass-over-function) |
| 4289 | (skip-chars-forward " \t") |
| 4290 | (if (looking-at "[%\n]") |
| 4291 | (forward-line 1)) |
| 4292 | (<= (point) pos)))) |
| 4293 | (setq arg (1- arg))) |
| 4294 | ;; Backward |
| 4295 | (while (< arg 0) |
| 4296 | (let ((pos (point))) |
| 4297 | (erlang-beginning-of-clause 1) |
| 4298 | (erlang-pass-over-function) |
| 4299 | (forward-line 1) |
| 4300 | (if (>= (point) pos) |
| 4301 | (if (erlang-beginning-of-function 2) |
| 4302 | (progn |
| 4303 | (erlang-pass-over-function) |
| 4304 | (skip-chars-forward " \t") |
| 4305 | (if (looking-at "[%\n]") |
| 4306 | (forward-line 1))) |
| 4307 | (goto-char (point-min))))) |
| 4308 | (setq arg (1+ arg))))) |
| 4309 | |
| 4310 | (defun erlang-mark-function () |
| 4311 | "Put mark at end of function, point at beginning." |
| 4312 | (interactive) |
| 4313 | (push-mark (point)) |
| 4314 | (erlang-end-of-function 1) |
| 4315 | ;; Sets the region. In Emacs 19 and XEmacs, we wants to activate |
| 4316 | ;; the region. |
| 4317 | (condition-case nil |
| 4318 | (push-mark (point) nil t) |
| 4319 | (error (push-mark (point)))) |
| 4320 | (erlang-beginning-of-function 1) |
| 4321 | ;; The above function deactivates the mark. |
| 4322 | (if (boundp 'deactivate-mark) |
| 4323 | (funcall (symbol-function 'set) 'deactivate-mark nil))) |
| 4324 | |
| 4325 | (defun erlang-pass-over-function () |
| 4326 | (while (progn |
| 4327 | (erlang-skip-blank) |
| 4328 | (and (not (looking-at "\\.\\(\\s \\|\n\\|\\s<\\)")) |
| 4329 | (not (eobp)))) |
| 4330 | (forward-sexp 1)) |
| 4331 | (if (not (eobp)) |
| 4332 | (forward-char 1))) |
| 4333 | |
| 4334 | (defun erlang-name-of-function () |
| 4335 | (save-excursion |
| 4336 | ;; Skip over attribute leader. |
| 4337 | (if (looking-at "-[ \t]*") |
| 4338 | (re-search-forward "-[ \t]*" nil 'move)) |
| 4339 | (let ((start (point))) |
| 4340 | (forward-sexp 1) |
| 4341 | (buffer-substring start (point))))) |
| 4342 | |
| 4343 | |
| 4344 | ;;; Miscellaneous |
| 4345 | |
| 4346 | (defun erlang-fill-paragraph (&optional justify) |
| 4347 | "Like \\[fill-paragraph], but handle Erlang comments. |
| 4348 | If any of the current line is a comment, fill the comment or the |
| 4349 | paragraph of it that point is in, preserving the comment's indentation |
| 4350 | and initial `%':s." |
| 4351 | (interactive "P") |
| 4352 | (let ((has-comment nil) |
| 4353 | ;; If has-comment, the appropriate fill-prefix for the comment. |
| 4354 | comment-fill-prefix) |
| 4355 | ;; Figure out what kind of comment we are looking at. |
| 4356 | (save-excursion |
| 4357 | (beginning-of-line) |
| 4358 | (cond |
| 4359 | ;; Find the command prefix. |
| 4360 | ((looking-at (concat "\\s *" comment-start-skip)) |
| 4361 | (setq has-comment t) |
| 4362 | (setq comment-fill-prefix (buffer-substring (match-beginning 0) |
| 4363 | (match-end 0)))) |
| 4364 | ;; A line with some code, followed by a comment? Remember that the |
| 4365 | ;; % which starts the comment shouldn't be part of a string or |
| 4366 | ;; character. |
| 4367 | ((progn |
| 4368 | (while (not (looking-at "%\\|$")) |
| 4369 | (skip-chars-forward "^%\n\"\\\\") |
| 4370 | (cond |
| 4371 | ((eq (char-after (point)) ?\\) (forward-char 2)) |
| 4372 | ((eq (char-after (point)) ?\") (forward-sexp 1)))) |
| 4373 | (looking-at comment-start-skip)) |
| 4374 | (setq has-comment t) |
| 4375 | (setq comment-fill-prefix |
| 4376 | (concat (make-string (current-column) ? ) |
| 4377 | (buffer-substring (match-beginning 0) (match-end 0))))))) |
| 4378 | (if (not has-comment) |
| 4379 | (fill-paragraph justify) |
| 4380 | ;; Narrow to include only the comment, and then fill the region. |
| 4381 | (save-restriction |
| 4382 | (narrow-to-region |
| 4383 | ;; Find the first line we should include in the region to fill. |
| 4384 | (save-excursion |
| 4385 | (while (and (zerop (forward-line -1)) |
| 4386 | (looking-at "^\\s *%"))) |
| 4387 | ;; We may have gone to far. Go forward again. |
| 4388 | (or (looking-at "^\\s *%") |
| 4389 | (forward-line 1)) |
| 4390 | (point)) |
| 4391 | ;; Find the beginning of the first line past the region to fill. |
| 4392 | (save-excursion |
| 4393 | (while (progn (forward-line 1) |
| 4394 | (looking-at "^\\s *%"))) |
| 4395 | (point))) |
| 4396 | ;; Lines with only % on them can be paragraph boundaries. |
| 4397 | (let ((paragraph-start (concat paragraph-start "\\|^[ \t%]*$")) |
| 4398 | (paragraph-separate (concat paragraph-start "\\|^[ \t%]*$")) |
| 4399 | (fill-prefix comment-fill-prefix)) |
| 4400 | (fill-paragraph justify)))))) |
| 4401 | |
| 4402 | |
| 4403 | (defun erlang-uncomment-region (beg end) |
| 4404 | "Uncomment all commented lines in the region." |
| 4405 | (interactive "r") |
| 4406 | (comment-region beg end -1)) |
| 4407 | |
| 4408 | |
| 4409 | (defun erlang-generate-new-clause () |
| 4410 | "Create additional Erlang clause header. |
| 4411 | |
| 4412 | Parses the source file for the name of the current Erlang function. |
| 4413 | Create the header containing the name, A pair of parentheses, |
| 4414 | and an arrow. The space between the function name and the |
| 4415 | first parenthesis is preserved. The point is placed between |
| 4416 | the parentheses." |
| 4417 | (interactive) |
| 4418 | (let ((name (save-excursion |
| 4419 | (and (erlang-beginning-of-clause) |
| 4420 | (erlang-get-function-name t)))) |
| 4421 | (arrow (save-excursion |
| 4422 | (and (erlang-beginning-of-clause) |
| 4423 | (erlang-get-function-arrow))))) |
| 4424 | (if (or (null arrow) (null name)) |
| 4425 | (error "Can't find name of current Erlang function.")) |
| 4426 | (if (and (bolp) (eolp)) |
| 4427 | nil |
| 4428 | (end-of-line) |
| 4429 | (newline)) |
| 4430 | (insert name) |
| 4431 | (save-excursion |
| 4432 | (insert (concat ") " arrow))) |
| 4433 | (if erlang-new-clause-with-arguments |
| 4434 | (erlang-clone-arguments)))) |
| 4435 | |
| 4436 | |
| 4437 | (defun erlang-clone-arguments () |
| 4438 | "Insert, at the point, the argument list of the previous clause. |
| 4439 | |
| 4440 | The mark is set at the beginning of the inserted text, the point |
| 4441 | at the end." |
| 4442 | (interactive) |
| 4443 | (let ((args (save-excursion |
| 4444 | (beginning-of-line) |
| 4445 | (and (erlang-beginning-of-clause) |
| 4446 | (erlang-get-function-arguments)))) |
| 4447 | (p (point))) |
| 4448 | (if (null args) |
| 4449 | (error "Can't clone argument list.")) |
| 4450 | (insert args) |
| 4451 | (set-mark p))) |
| 4452 | |
| 4453 | ;;; Information retreival functions. |
| 4454 | |
| 4455 | (defun erlang-buffer-substring (beg end) |
| 4456 | "Like `buffer-substring-no-properties'. |
| 4457 | Although, this function works on all versions of Emacs." |
| 4458 | (if (fboundp 'buffer-substring-no-properties) |
| 4459 | (funcall (symbol-function 'buffer-substring-no-properties) beg end) |
| 4460 | (buffer-substring beg end))) |
| 4461 | |
| 4462 | |
| 4463 | (defun erlang-get-module () |
| 4464 | "Return the name of the module as specified by `-module'. |
| 4465 | |
| 4466 | Return nil if file contains no `-module' attribute." |
| 4467 | (save-excursion |
| 4468 | (save-restriction |
| 4469 | (widen) |
| 4470 | (goto-char (point-min)) |
| 4471 | (let ((md (match-data))) |
| 4472 | (unwind-protect |
| 4473 | (if (re-search-forward |
| 4474 | (concat "^-module\\s *(\\s *\\(\\(" |
| 4475 | erlang-atom-regexp |
| 4476 | "\\)?\\)\\s *)\\s *\\.") |
| 4477 | (point-max) t) |
| 4478 | (erlang-remove-quotes |
| 4479 | (erlang-buffer-substring (match-beginning 1) |
| 4480 | (match-end 1))) |
| 4481 | nil) |
| 4482 | (store-match-data md)))))) |
| 4483 | |
| 4484 | |
| 4485 | (defun erlang-get-module-from-file-name (&optional file) |
| 4486 | "Extract the module name from a file name. |
| 4487 | |
| 4488 | First, the directory part is removed. Second, the part of the file name |
| 4489 | matching `erlang-file-name-extension-regexp' is removed. |
| 4490 | |
| 4491 | Should the match fail, nil is returned. |
| 4492 | |
| 4493 | By modifying `erlang-file-name-extension-regexp' to match files other |
| 4494 | than Erlang source files, Erlang specific functions could be applied on |
| 4495 | non-Erlang files. Most notably; the support for Erlang modules in the |
| 4496 | tags system could be used by files written in other languages." |
| 4497 | (or file (setq file buffer-file-name)) |
| 4498 | (if (null file) |
| 4499 | nil |
| 4500 | (setq file (file-name-nondirectory file)) |
| 4501 | (if (string-match erlang-file-name-extension-regexp file) |
| 4502 | (substring file 0 (match-beginning 0)) |
| 4503 | nil))) |
| 4504 | |
| 4505 | |
| 4506 | ;; Used by `erlang-get-export' and `erlang-get-import'. |
| 4507 | |
| 4508 | (defun erlang-get-function-arity-list () |
| 4509 | "Parses list of `function/arity' as used by `-import' and `-export'. |
| 4510 | |
| 4511 | The point must be placed at before the opening bracket. When the |
| 4512 | function returns the point will be placed after the closing bracket. |
| 4513 | |
| 4514 | The function does not return an error if the list is incorrectly |
| 4515 | formatted. |
| 4516 | |
| 4517 | Return list of (function . arity). The order of the returned list |
| 4518 | corresponds to the order of the parsed Erlang list." |
| 4519 | (let ((res '())) |
| 4520 | (erlang-skip-blank) |
| 4521 | (forward-char 1) |
| 4522 | (if (not (eq (preceding-char) ?\[)) |
| 4523 | '() ; Not looking at an Erlang list. |
| 4524 | (while ; Note: `while' has no body. |
| 4525 | (progn |
| 4526 | (erlang-skip-blank) |
| 4527 | (and (looking-at (concat erlang-atom-regexp |
| 4528 | "/\\([0-9]+\\)\\>")) |
| 4529 | (progn |
| 4530 | (setq res (cons |
| 4531 | (cons |
| 4532 | (erlang-remove-quotes |
| 4533 | (erlang-buffer-substring |
| 4534 | (match-beginning 1) (match-end 1))) |
| 4535 | (string-to-int |
| 4536 | (erlang-buffer-substring |
| 4537 | (match-beginning |
| 4538 | (+ 1 erlang-atom-regexp-matches)) |
| 4539 | (match-end |
| 4540 | (+ 1 erlang-atom-regexp-matches))))) |
| 4541 | res)) |
| 4542 | (goto-char (match-end 0)) |
| 4543 | (erlang-skip-blank) |
| 4544 | (forward-char 1) |
| 4545 | ;; Test if there are more exported functions. |
| 4546 | (eq (preceding-char) ?,)))))) |
| 4547 | (nreverse res))) |
| 4548 | |
| 4549 | |
| 4550 | ;;; Note that `-export' and the open parenthesis must be written on |
| 4551 | ;;; the same line. |
| 4552 | |
| 4553 | (defun erlang-get-export () |
| 4554 | "Return a list of `(function . arity)' as specified by `-export'." |
| 4555 | (save-excursion |
| 4556 | (goto-char (point-min)) |
| 4557 | (let ((md (match-data)) |
| 4558 | (res '())) |
| 4559 | (unwind-protect |
| 4560 | (progn |
| 4561 | (while (re-search-forward "^-export\\s *(" (point-max) t) |
| 4562 | (erlang-skip-blank) |
| 4563 | (setq res (nconc res (erlang-get-function-arity-list)))) |
| 4564 | res) |
| 4565 | (store-match-data md))))) |
| 4566 | |
| 4567 | |
| 4568 | (defun erlang-get-import () |
| 4569 | "Parse an Erlang source file for imported functions. |
| 4570 | |
| 4571 | Return an alist with module name as car part and list of conses containing |
| 4572 | function and arity as cdr part." |
| 4573 | (save-excursion |
| 4574 | (goto-char (point-min)) |
| 4575 | (let ((md (match-data)) |
| 4576 | (res '())) |
| 4577 | (unwind-protect |
| 4578 | (progn |
| 4579 | (while (re-search-forward "^-import\\s *(" (point-max) t) |
| 4580 | (erlang-skip-blank) |
| 4581 | (if (looking-at erlang-atom-regexp) |
| 4582 | (let ((module (erlang-remove-quotes |
| 4583 | (erlang-buffer-substring |
| 4584 | (match-beginning 0) |
| 4585 | (match-end 0))))) |
| 4586 | (goto-char (match-end 0)) |
| 4587 | (erlang-skip-blank) |
| 4588 | (if (eq (following-char) ?,) |
| 4589 | (progn |
| 4590 | (forward-char 1) |
| 4591 | (erlang-skip-blank) |
| 4592 | (let ((funcs (erlang-get-function-arity-list)) |
| 4593 | (pair (assoc module res))) |
| 4594 | (if pair |
| 4595 | (setcdr pair (nconc (cdr pair) funcs)) |
| 4596 | (setq res (cons (cons module funcs) |
| 4597 | res))))))))) |
| 4598 | (nreverse res)) |
| 4599 | (store-match-data md))))) |
| 4600 | |
| 4601 | |
| 4602 | (defun erlang-get-function-name (&optional arg) |
| 4603 | "Return name of current function, or nil. |
| 4604 | |
| 4605 | If optional argument is non-nil, everything up to and including |
| 4606 | the first `(' is returned. |
| 4607 | |
| 4608 | Normally used in conjuction with `erlang-beginning-of-clause', e.g.: |
| 4609 | (save-excursion |
| 4610 | (if (not (eobp)) (forward-char 1)) |
| 4611 | (and (erlang-beginning-of-clause) |
| 4612 | (erlang-get-function-name t)))" |
| 4613 | (let ((n (if arg 0 1))) |
| 4614 | (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) |
| 4615 | (erlang-buffer-substring (match-beginning n) (match-end n))))) |
| 4616 | |
| 4617 | |
| 4618 | (defun erlang-get-function-arrow () |
| 4619 | "Return arrow of current function, could be \"->\", \":-\" or nil. |
| 4620 | |
| 4621 | The \":-\" arrow is used by mnesia queries. |
| 4622 | |
| 4623 | Normally used in conjuction with `erlang-beginning-of-clause', e.g.: |
| 4624 | (save-excursion |
| 4625 | (if (not (eobp)) (forward-char 1)) |
| 4626 | (and (erlang-beginning-of-clause) |
| 4627 | (erlang-get-function-arrow)))" |
| 4628 | (and (looking-at (concat "^" erlang-atom-regexp "\\s *\\((\\)")) |
| 4629 | (condition-case () |
| 4630 | (save-excursion |
| 4631 | (goto-char (match-beginning (+ 1 erlang-atom-regexp-matches))) |
| 4632 | (forward-sexp 1) |
| 4633 | (erlang-skip-blank) |
| 4634 | (and (looking-at "->\\|:-") |
| 4635 | (erlang-buffer-substring |
| 4636 | (match-beginning 0) (match-end 0))))))) |
| 4637 | |
| 4638 | |
| 4639 | (defun erlang-get-function-arity () |
| 4640 | "Return the number of arguments of function at point, or nil." |
| 4641 | (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) |
| 4642 | (save-excursion |
| 4643 | (goto-char (match-end 0)) |
| 4644 | (condition-case nil |
| 4645 | (let ((res 0) |
| 4646 | (cont t)) |
| 4647 | (while cont |
| 4648 | (cond ((eobp) |
| 4649 | (setq res nil) |
| 4650 | (setq cont nil)) |
| 4651 | ((looking-at "\\s *)") |
| 4652 | (setq cont nil)) |
| 4653 | ((looking-at "\\s *\\($\\|%\\)") |
| 4654 | (forward-line 1)) |
| 4655 | ((looking-at "\\s *,") |
| 4656 | (goto-char (match-end 0))) |
| 4657 | (t |
| 4658 | (setq res (+ 1 res)) |
| 4659 | (forward-sexp 1)))) |
| 4660 | res) |
| 4661 | (error nil))))) |
| 4662 | |
| 4663 | |
| 4664 | (defun erlang-get-function-arguments () |
| 4665 | "Return arguments of current function, or nil." |
| 4666 | (if (not (looking-at (concat "^" erlang-atom-regexp "\\s *("))) |
| 4667 | nil |
| 4668 | (save-excursion |
| 4669 | (condition-case nil |
| 4670 | (let ((start (match-end 0))) |
| 4671 | (goto-char (- start 1)) |
| 4672 | (forward-sexp) |
| 4673 | (erlang-buffer-substring start (- (point) 1))) |
| 4674 | (error nil))))) |
| 4675 | |
| 4676 | |
| 4677 | (defun erlang-get-function-under-point () |
| 4678 | "Return the module and function under the point, or nil. |
| 4679 | |
| 4680 | Should no explicit module name be present at the point, the |
| 4681 | list of imported functions is searched. |
| 4682 | |
| 4683 | The following could be retured: |
| 4684 | (\"module\" \"function\") -- Both module and function name found. |
| 4685 | (nil \"function\") -- No module name was found. |
| 4686 | nil -- No function name found |
| 4687 | |
| 4688 | In the future the list may contain more elements." |
| 4689 | (save-excursion |
| 4690 | (let ((md (match-data)) |
| 4691 | (res nil)) |
| 4692 | (if (eq (char-syntax (following-char)) ? ) |
| 4693 | (skip-chars-backward " \t")) |
| 4694 | (skip-chars-backward "a-zA-Z0-9_:'") |
| 4695 | (cond ((looking-at (concat erlang-atom-regexp ":" erlang-atom-regexp)) |
| 4696 | (setq res (list |
| 4697 | (erlang-remove-quotes |
| 4698 | (erlang-buffer-substring |
| 4699 | (match-beginning 1) (match-end 1))) |
| 4700 | (erlang-remove-quotes |
| 4701 | (erlang-buffer-substring |
| 4702 | (match-beginning (1+ erlang-atom-regexp-matches)) |
| 4703 | (match-end (1+ erlang-atom-regexp-matches))))))) |
| 4704 | ((looking-at erlang-atom-regexp) |
| 4705 | (let ((fk (erlang-remove-quotes |
| 4706 | (erlang-buffer-substring |
| 4707 | (match-beginning 0) (match-end 0)))) |
| 4708 | (mod nil) |
| 4709 | (imports (erlang-get-import))) |
| 4710 | (while (and imports (null mod)) |
| 4711 | (if (assoc fk (cdr (car imports))) |
| 4712 | (setq mod (car (car imports))) |
| 4713 | (setq imports (cdr imports)))) |
| 4714 | (setq res (list mod fk))))) |
| 4715 | (store-match-data md) |
| 4716 | res))) |
| 4717 | |
| 4718 | |
| 4719 | ;; TODO: Escape single quotes inside the string. |
| 4720 | (defun erlang-add-quotes-if-needed (str) |
| 4721 | "Return STR, possibly with quotes." |
| 4722 | (if (and (stringp str) |
| 4723 | (not (string-match (concat "\\`" erlang-atom-regexp "\\'") str))) |
| 4724 | (concat "'" str "'") |
| 4725 | str)) |
| 4726 | |
| 4727 | |
| 4728 | (defun erlang-remove-quotes (str) |
| 4729 | "Return STR without quotes, if present." |
| 4730 | (let ((md (match-data))) |
| 4731 | (prog1 |
| 4732 | (if (string-match "\\`'\\(.*\\)'\\'" str) |
| 4733 | (substring str (match-beginning 1) (match-end 1)) |
| 4734 | str) |
| 4735 | (store-match-data md)))) |
| 4736 | |
| 4737 | |
| 4738 | ;;; Check module name |
| 4739 | |
| 4740 | ;; I don't want to use `advice' since it is not part of Emacs 18. |
| 4741 | ;; |
| 4742 | ;; The function `write-file', bound to C-x C-w, calls |
| 4743 | ;; `set-visited-file-name' which clears the hook. :-( |
| 4744 | ;; To make sure that the hook always is present, we add a piece of |
| 4745 | ;; code to the function `set-visited-file-name'. |
| 4746 | (defun erlang-check-module-name-init () |
| 4747 | "Initialize the functionality to compare file and module names. |
| 4748 | |
| 4749 | We redefines the function `set-visited-file-name' since it clears |
| 4750 | the variable `local-write-file-hooks'. The original function definition |
| 4751 | is stored in `erlang-orig-set-visited-file-name'." |
| 4752 | (if (fboundp 'erlang-orig-set-visited-file-name) |
| 4753 | () |
| 4754 | (fset 'erlang-orig-set-visited-file-name |
| 4755 | (symbol-function 'set-visited-file-name)) |
| 4756 | (defun set-visited-file-name (&rest args) |
| 4757 | "Please see the function `erlang-orig-set-visited-file-name'." |
| 4758 | (interactive "FSet visited file name: ") |
| 4759 | (apply (symbol-function 'erlang-orig-set-visited-file-name) args) |
| 4760 | (if (eq major-mode 'erlang-mode) |
| 4761 | (add-hook 'local-write-file-hooks 'erlang-check-module-name)))) |
| 4762 | (add-hook 'local-write-file-hooks 'erlang-check-module-name)) |
| 4763 | |
| 4764 | |
| 4765 | (defun erlang-check-module-name () |
| 4766 | "If the module name doesn't match file name, ask for permission to change. |
| 4767 | |
| 4768 | The variable `erlang-check-module-name' controls the behaviour of this |
| 4769 | function. It it is nil, this function does nothing. If it is t, the |
| 4770 | source is silently changed. If it is set to the atom `ask', the user |
| 4771 | is prompted. |
| 4772 | |
| 4773 | This function is normally placed in the hook `local-write-file-hook'." |
| 4774 | (if erlang-check-module-name |
| 4775 | (let ((mn (erlang-get-module)) |
| 4776 | (fn (erlang-get-module-from-file-name (buffer-file-name)))) |
| 4777 | (if (and (stringp mn) (stringp fn)) |
| 4778 | (or (string-equal mn fn) |
| 4779 | (if (or (eq erlang-check-module-name t) |
| 4780 | (y-or-n-p |
| 4781 | "Module does not match file name. Modify source? ")) |
| 4782 | (save-excursion |
| 4783 | (save-restriction |
| 4784 | (widen) |
| 4785 | (goto-char (point-min)) |
| 4786 | (if (re-search-forward |
| 4787 | (concat "^-module\\s *(\\s *\\(\\(" |
| 4788 | erlang-atom-regexp |
| 4789 | "\\)?\\)\\s *)\\s *\\.") |
| 4790 | (point-max) t) |
| 4791 | (progn |
| 4792 | (goto-char (match-beginning 1)) |
| 4793 | (delete-region (match-beginning 1) |
| 4794 | (match-end 1)) |
| 4795 | (insert fn)))))))))) |
| 4796 | ;; Must return nil since it is added to `local-write-file-hook'. |
| 4797 | nil) |
| 4798 | |
| 4799 | |
| 4800 | ;;; Electric functions. |
| 4801 | |
| 4802 | (defun erlang-electric-semicolon (&optional arg) |
| 4803 | "Insert a semicolon character and possibly a prototype for the next line. |
| 4804 | |
| 4805 | The variable `erlang-electric-semicolon-criteria' states a critera, |
| 4806 | when fulfilled a newline is inserted, the next line is indented and a |
| 4807 | prototype for the next line is inserted. Normally the prototype |
| 4808 | consists of \" ->\". Should the semicolon end the clause a new clause |
| 4809 | header is generated. |
| 4810 | |
| 4811 | The variable `erlang-electric-semicolon-insert-blank-lines' controls |
| 4812 | the number of blank lines inserted between the current line and new |
| 4813 | function header. |
| 4814 | |
| 4815 | Behaves just like the normal semicolon when supplied with a |
| 4816 | numerical arg, point is inside string or comment, or when there are |
| 4817 | non-whitespace characters following the point on the current line." |
| 4818 | (interactive "P") |
| 4819 | (self-insert-command (prefix-numeric-value arg)) |
| 4820 | (if (or arg |
| 4821 | (and (listp erlang-electric-commands) |
| 4822 | (not (memq 'erlang-electric-semicolon |
| 4823 | erlang-electric-commands))) |
| 4824 | (erlang-in-literal) |
| 4825 | (not (looking-at "\\s *\\(%.*\\)?$")) |
| 4826 | (null (erlang-test-criteria-list |
| 4827 | erlang-electric-semicolon-criteria))) |
| 4828 | (setq erlang-electric-newline-inhibit nil) |
| 4829 | (setq erlang-electric-newline-inhibit t) |
| 4830 | (undo-boundary) |
| 4831 | (end-of-line) |
| 4832 | (newline) |
| 4833 | (if (condition-case nil |
| 4834 | (progn (erlang-indent-line) t) |
| 4835 | (error (if (bolp) (delete-backward-char 1)))) |
| 4836 | (if (not (bolp)) |
| 4837 | (save-excursion |
| 4838 | (insert " ->")) |
| 4839 | (condition-case nil |
| 4840 | (progn |
| 4841 | (erlang-generate-new-clause) |
| 4842 | (if erlang-electric-semicolon-insert-blank-lines |
| 4843 | (save-excursion |
| 4844 | (beginning-of-line) |
| 4845 | (newline |
| 4846 | erlang-electric-semicolon-insert-blank-lines)))) |
| 4847 | (error (if (bolp) (delete-backward-char 1)))))))) |
| 4848 | |
| 4849 | |
| 4850 | (defun erlang-electric-comma (&optional arg) |
| 4851 | "Insert a comma character and possibly a new indented line. |
| 4852 | The variable `erlang-electric-comma-criteria' states a critera, |
| 4853 | when fulfilled a newline is inserted and the next line is indeted. |
| 4854 | |
| 4855 | Behaves just like the normal comma when supplied with a |
| 4856 | numerical arg, point is inside string or comment, or when there are |
| 4857 | non-whitespace characters following the point on the current line." |
| 4858 | (interactive "P") |
| 4859 | |
| 4860 | (self-insert-command (prefix-numeric-value arg)) |
| 4861 | |
| 4862 | (if (or arg |
| 4863 | (and (listp erlang-electric-commands) |
| 4864 | (not (memq 'erlang-electric-comma erlang-electric-commands))) |
| 4865 | (erlang-in-literal) |
| 4866 | (not (looking-at "\\s *\\(%.*\\)?$")) |
| 4867 | (null (erlang-test-criteria-list |
| 4868 | erlang-electric-comma-criteria))) |
| 4869 | (setq erlang-electric-newline-inhibit nil) |
| 4870 | (setq erlang-electric-newline-inhibit t) |
| 4871 | (undo-boundary) |
| 4872 | (end-of-line) |
| 4873 | (newline) |
| 4874 | (condition-case nil |
| 4875 | (erlang-indent-line) |
| 4876 | (error (if (bolp) (delete-backward-char 1)))))) |
| 4877 | |
| 4878 | (defun erlang-electric-lt (&optional arg) |
| 4879 | "Insert a less-than sign, and optionally mark it as an open paren." |
| 4880 | |
| 4881 | (interactive "p") |
| 4882 | |
| 4883 | (self-insert-command arg) |
| 4884 | |
| 4885 | ;; Was this the second char in bit-syntax open (`<<')? |
| 4886 | (unless (< (point) 2) |
| 4887 | (save-excursion |
| 4888 | (backward-char 2) |
| 4889 | (when (and (eq (char-after (point)) ?<) |
| 4890 | (not (eq (get-text-property (point) 'category) |
| 4891 | 'bitsyntax-open-inner))) |
| 4892 | ;; Then mark the two chars... |
| 4893 | (put-text-property (point) (1+ (point)) |
| 4894 | 'category 'bitsyntax-open-outer) |
| 4895 | (forward-char 1) |
| 4896 | (put-text-property (point) (1+ (point)) |
| 4897 | 'category 'bitsyntax-open-inner) |
| 4898 | ;;...and unmark any subsequent less-than chars. |
| 4899 | (forward-char 1) |
| 4900 | (while (eq (char-after (point)) ?<) |
| 4901 | (remove-text-properties (point) (1+ (point)) |
| 4902 | '(category nil)) |
| 4903 | (forward-char 1)))))) |
| 4904 | |
| 4905 | (defun erlang-after-bitsyntax-close () |
| 4906 | "Returns true if point is placed immediately after a bit-syntax close parenthesis (`>>')." |
| 4907 | (and (>= (point) 2) |
| 4908 | (save-excursion |
| 4909 | (backward-char 2) |
| 4910 | (and (eq (char-after (point)) ?>) |
| 4911 | (not (eq (get-text-property (point) 'category) |
| 4912 | 'bitsyntax-close-outer)))))) |
| 4913 | |
| 4914 | (defun erlang-after-arrow () |
| 4915 | "Returns true if point is placed immediately after a function arrow (`->')." |
| 4916 | (and (>= (point) 2) |
| 4917 | (and |
| 4918 | (save-excursion |
| 4919 | (backward-char) |
| 4920 | (eq (char-before (point)) ?-)) |
| 4921 | (or (not (listp erlang-electric-commands)) |
| 4922 | (memq 'erlang-electric-gt |
| 4923 | erlang-electric-commands)) |
| 4924 | (not (erlang-in-literal)) |
| 4925 | (looking-at "\\s *\\(%.*\\)?$") |
| 4926 | (erlang-test-criteria-list erlang-electric-arrow-criteria)))) |
| 4927 | |
| 4928 | |
| 4929 | (defun erlang-electric-gt (&optional arg) |
| 4930 | "Insert a greater-than sign, and optionally mark it as a close paren." |
| 4931 | |
| 4932 | (interactive "p") |
| 4933 | |
| 4934 | (self-insert-command arg) |
| 4935 | |
| 4936 | (cond |
| 4937 | ;; Did we just write a bit-syntax close (`>>')? |
| 4938 | ((erlang-after-bitsyntax-close) |
| 4939 | (save-excursion |
| 4940 | ;; Then mark the two chars... |
| 4941 | (backward-char 2) |
| 4942 | (put-text-property (point) (1+ (point)) |
| 4943 | 'category 'bitsyntax-close-inner) |
| 4944 | (forward-char) |
| 4945 | (put-text-property (point) (1+ (point)) |
| 4946 | 'category 'bitsyntax-close-outer) |
| 4947 | ;;...and unmark any subsequent greater-than chars. |
| 4948 | (forward-char) |
| 4949 | (while (eq (char-after (point)) ?>) |
| 4950 | (remove-text-properties (point) (1+ (point)) |
| 4951 | '(category nil)) |
| 4952 | (forward-char)))) |
| 4953 | |
| 4954 | ;; Did we just write a function arrow (`->')? |
| 4955 | ((erlang-after-arrow) |
| 4956 | (let ((erlang-electric-newline-inhibit t)) |
| 4957 | (undo-boundary) |
| 4958 | (end-of-line) |
| 4959 | (newline) |
| 4960 | (condition-case nil |
| 4961 | (erlang-indent-line) |
| 4962 | (error (if (bolp) (delete-backward-char 1)))))) |
| 4963 | |
| 4964 | ;; Then it's just a plain greater-than. |
| 4965 | (t |
| 4966 | nil))) |
| 4967 | |
| 4968 | |
| 4969 | (defun erlang-electric-arrow\ off (&optional arg) |
| 4970 | "Insert a '>'-sign and possible a new indented line. |
| 4971 | |
| 4972 | This command is only `electric' when the `>' is part of an `->' arrow. |
| 4973 | The variable `erlang-electric-arrow-criteria' states a sequence of |
| 4974 | criteria, which decides when a newline should be inserted and the next |
| 4975 | line indented. |
| 4976 | |
| 4977 | It behaves just like the normal greater than sign when supplied with a |
| 4978 | numerical arg, point is inside string or comment, or when there are |
| 4979 | non-whitespace characters following the point on the current line. |
| 4980 | |
| 4981 | After being split/merged into erlang-after-arrow and |
| 4982 | erlang-electric-gt, it is now unused and disabled." |
| 4983 | (interactive "P") |
| 4984 | (let ((prec (preceding-char))) |
| 4985 | (self-insert-command (prefix-numeric-value arg)) |
| 4986 | (if (or arg |
| 4987 | (and (listp erlang-electric-commands) |
| 4988 | (not (memq 'erlang-electric-arrow |
| 4989 | erlang-electric-commands))) |
| 4990 | (not (eq prec ?-)) |
| 4991 | (erlang-in-literal) |
| 4992 | (not (looking-at "\\s *\\(%.*\\)?$")) |
| 4993 | (null (erlang-test-criteria-list |
| 4994 | erlang-electric-arrow-criteria))) |
| 4995 | (setq erlang-electric-newline-inhibit nil) |
| 4996 | (setq erlang-electric-newline-inhibit t) |
| 4997 | (undo-boundary) |
| 4998 | (end-of-line) |
| 4999 | (newline) |
| 5000 | (condition-case nil |
| 5001 | (erlang-indent-line) |
| 5002 | (error (if (bolp) (delete-backward-char 1))))))) |
| 5003 | |
| 5004 | |
| 5005 | (defun erlang-electric-newline (&optional arg) |
| 5006 | "Break line at point and indent, continuing comment if within one. |
| 5007 | The variable `erlang-electric-newline-criteria' states a critera, |
| 5008 | when fulfilled a newline is inserted and the next line is indeted. |
| 5009 | |
| 5010 | Should the current line begin with a comment, and the variable |
| 5011 | `comment-multi-line' be non-nil, a new comment start is inserted. |
| 5012 | |
| 5013 | Should the previous command be another electric command we assume that |
| 5014 | the user pressed newline out of old habit, hence we will do nothing." |
| 5015 | (interactive "P") |
| 5016 | (cond ((and (not arg) |
| 5017 | erlang-electric-newline-inhibit |
| 5018 | (memq last-command erlang-electric-newline-inhibit-list)) |
| 5019 | ()) ; Do nothing! |
| 5020 | ((or arg |
| 5021 | (and (listp erlang-electric-commands) |
| 5022 | (not (memq 'erlang-electric-newline |
| 5023 | erlang-electric-commands))) |
| 5024 | (null (erlang-test-criteria-list |
| 5025 | erlang-electric-newline-criteria))) |
| 5026 | (newline (prefix-numeric-value arg))) |
| 5027 | (t |
| 5028 | (if (and comment-multi-line |
| 5029 | (save-excursion |
| 5030 | (beginning-of-line) |
| 5031 | (looking-at (concat "\\s *" comment-start-skip)))) |
| 5032 | (let ((str (buffer-substring |
| 5033 | (or (match-end 1) (match-beginning 0)) |
| 5034 | (min (match-end 0) (point))))) |
| 5035 | (newline) |
| 5036 | (undo-boundary) |
| 5037 | (insert str)) |
| 5038 | (newline) |
| 5039 | (undo-boundary) |
| 5040 | (indent-according-to-mode))))) |
| 5041 | |
| 5042 | |
| 5043 | (defun erlang-test-criteria-list (criteria) |
| 5044 | "Given a list of criteria functions, test if criteria is fulfilled. |
| 5045 | |
| 5046 | Each element in the criteria list can a function returning nil, t or |
| 5047 | the atom `stop'. t means that the criteria is fulfilled, `stop' means |
| 5048 | that it the criteria isn't fulfilled and that the search should stop, |
| 5049 | and nil means continue searching. |
| 5050 | |
| 5051 | Should the list contain the atom t the criteria is assumed to be |
| 5052 | fulfilled, unless preceded by a function returning `stop', of course. |
| 5053 | |
| 5054 | Should the argument be the atom t instead of a list, the criteria is |
| 5055 | assumed to be trivially true. |
| 5056 | |
| 5057 | Should all function return nil, the criteria is assumed not to be |
| 5058 | fulfilled. |
| 5059 | |
| 5060 | Return t if criteria fulfilled, nil otherwise." |
| 5061 | (if (eq criteria t) |
| 5062 | t |
| 5063 | (save-excursion |
| 5064 | (let ((answer nil)) |
| 5065 | (while (and criteria (null answer)) |
| 5066 | (if (eq (car criteria) t) |
| 5067 | (setq answer t) |
| 5068 | (setq answer (funcall (car criteria)))) |
| 5069 | (setq criteria (cdr criteria))) |
| 5070 | (if (and answer (not (eq answer 'stop))) |
| 5071 | t |
| 5072 | nil))))) |
| 5073 | |
| 5074 | |
| 5075 | (defun erlang-in-literal (&optional lim) |
| 5076 | "Test if point is in string, quoted atom or comment. |
| 5077 | |
| 5078 | Return one of the three atoms `atom', `string', and `comment'. |
| 5079 | Should the point be inside none of the above mentioned types of |
| 5080 | context, nil is returned." |
| 5081 | (save-excursion |
| 5082 | (let* ((lim (or lim (save-excursion |
| 5083 | (erlang-beginning-of-clause) |
| 5084 | (point)))) |
| 5085 | (state (parse-partial-sexp lim (point)))) |
| 5086 | (cond |
| 5087 | ((eq (nth 3 state) ?') 'atom) |
| 5088 | ((nth 3 state) 'string) |
| 5089 | ((nth 4 state) 'comment) |
| 5090 | (t nil))))) |
| 5091 | |
| 5092 | |
| 5093 | (defun erlang-at-end-of-function-p () |
| 5094 | "Test if point is at end of an Erlang function. |
| 5095 | |
| 5096 | This function is designed to be a member of a criteria list." |
| 5097 | (eq (save-excursion (erlang-skip-blank) (point)) |
| 5098 | (save-excursion |
| 5099 | (erlang-beginning-of-function -1) (point)))) |
| 5100 | |
| 5101 | |
| 5102 | (defun erlang-stop-when-inside-argument-list () |
| 5103 | "Return `stop' if inside parenthesis list, nil otherwise. |
| 5104 | |
| 5105 | Knows about the list comprehension syntax. When the point is |
| 5106 | after `||', `stop' is not returned. |
| 5107 | |
| 5108 | This function is designed to be a member of a criteria list." |
| 5109 | (save-excursion |
| 5110 | (condition-case nil |
| 5111 | (let ((orig-point (point)) |
| 5112 | (state nil)) |
| 5113 | (up-list -1) |
| 5114 | (if (not (eq (following-char) ?\[)) |
| 5115 | 'stop |
| 5116 | ;; Do not return `stop' when inside a list comprehension |
| 5117 | ;; construnction. (The point must be after `||'). |
| 5118 | (while (< (point) orig-point) |
| 5119 | (setq state (erlang-partial-parse (point) orig-point state))) |
| 5120 | (if (and (car state) (eq (car (car (car state))) '||)) |
| 5121 | nil |
| 5122 | 'stop))) |
| 5123 | (error |
| 5124 | nil)))) |
| 5125 | |
| 5126 | |
| 5127 | (defun erlang-stop-when-at-guard () |
| 5128 | "Return `stop' when at function guards. |
| 5129 | |
| 5130 | This function is designed to be a member of a criteria list." |
| 5131 | (save-excursion |
| 5132 | (beginning-of-line) |
| 5133 | (if (and (looking-at (concat "^" erlang-atom-regexp "\\s *(")) |
| 5134 | (not (looking-at |
| 5135 | (concat "^" erlang-atom-regexp ".*\\(->\\|:-\\)")))) |
| 5136 | 'stop |
| 5137 | nil))) |
| 5138 | |
| 5139 | |
| 5140 | (defun erlang-next-lines-empty-p () |
| 5141 | "Return non-nil if next lines are empty. |
| 5142 | |
| 5143 | The variable `erlang-next-lines-empty-threshold' contains the number |
| 5144 | of lines required to be empty. |
| 5145 | |
| 5146 | A line containing only spaces and tabs is considered empty. |
| 5147 | |
| 5148 | This function is designed to be a member of a criteria list." |
| 5149 | (and erlang-next-lines-empty-threshold |
| 5150 | (save-excursion |
| 5151 | (let ((left erlang-next-lines-empty-threshold) |
| 5152 | (cont t)) |
| 5153 | (while (and cont (> left 0)) |
| 5154 | (forward-line 1) |
| 5155 | (setq cont (looking-at "\\s *$")) |
| 5156 | (setq left (- left 1))) |
| 5157 | cont)))) |
| 5158 | |
| 5159 | |
| 5160 | (defun erlang-at-keyword-end-p () |
| 5161 | "Test if next readable token is the keyword end. |
| 5162 | |
| 5163 | This function is designed to be a member of a criteria list." |
| 5164 | (save-excursion |
| 5165 | (erlang-skip-blank) |
| 5166 | (looking-at "end[^_a-zA-Z0-9]"))) |
| 5167 | |
| 5168 | |
| 5169 | ;; Erlang tags support which is aware of erlang modules. |
| 5170 | ;; |
| 5171 | ;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags |
| 5172 | ;; package work under XEmacs.) |
| 5173 | |
| 5174 | (eval-when-compile |
| 5175 | (if (or (featurep 'bytecomp) |
| 5176 | (featurep 'byte-compile)) |
| 5177 | (progn |
| 5178 | (require 'etags)))) |
| 5179 | |
| 5180 | |
| 5181 | ;; Variables: |
| 5182 | |
| 5183 | (defvar erlang-tags-function-alist |
| 5184 | '((find-tag . erlang-find-tag) |
| 5185 | (find-tag-other-window . erlang-find-tag-other-window) |
| 5186 | (find-tag-regexp . erlang-find-tag-regexp) |
| 5187 | (find-tag-other-frame . erlang-find-tag-other-frame)) |
| 5188 | "Alist of old tags commands and the replacement functions.") |
| 5189 | |
| 5190 | (defvar erlang-tags-installed nil |
| 5191 | "Non-nil when the Erlang tags system is installed.") |
| 5192 | (defvar erlang-tags-file-list '() |
| 5193 | "List of files in tag list. Used when finding tag on form `module:'.") |
| 5194 | (defvar erlang-tags-completion-table nil |
| 5195 | "Like `tags-completion-table', this table contains `tag' and `module:tag'.") |
| 5196 | (defvar erlang-tags-buffer-installed-p nil |
| 5197 | "Non-nil when erlang module recognising functions installed.") |
| 5198 | (defvar erlang-tags-buffer-list '() |
| 5199 | "Temporary list of buffers.") |
| 5200 | (defvar erlang-tags-orig-completion-table nil |
| 5201 | "Temporary storage for `tags-completion-table'.") |
| 5202 | (defvar erlang-tags-orig-tag-order nil |
| 5203 | "Temporary storage for `find-tag-tag-order'.") |
| 5204 | (defvar erlang-tags-orig-regexp-tag-order nil |
| 5205 | "Temporary storage for `find-tag-regexp-tag-order'.") |
| 5206 | (defvar erlang-tags-orig-search-function nil |
| 5207 | "Temporary storage for `find-tag-search-function'.") |
| 5208 | (defvar erlang-tags-orig-regexp-search-function nil |
| 5209 | "Temporary storage for `find-tag-regexp-search-function'.") |
| 5210 | (defvar erlang-tags-orig-format-hooks nil |
| 5211 | "Temporary storage for `tags-table-format-hooks'.") |
| 5212 | |
| 5213 | (defun erlang-tags-init () |
| 5214 | "Install an alternate version of tags, aware of Erlang modules. |
| 5215 | |
| 5216 | After calling this function, the tags functions are aware of |
| 5217 | Erlang modules. Tags can be entered on the for `module:tag' aswell |
| 5218 | as on the old form `tag'. |
| 5219 | |
| 5220 | In the completion list, `module:tag' and `module:' shows up. |
| 5221 | |
| 5222 | Call this function from an appropriate init file, or add it to |
| 5223 | Erlang mode hook with the commands: |
| 5224 | (add-hook 'erlang-mode-hook 'erlang-tags-init) |
| 5225 | (add-hook 'erlang-shell-mode-hook 'erlang-tags-init) |
| 5226 | |
| 5227 | This function only works under Emacs 18 and Emacs 19. Currently, It |
| 5228 | is not implemented under XEmacs. (Hint: The Emacs 19 etags module |
| 5229 | works under XEmacs.)" |
| 5230 | (interactive) |
| 5231 | (cond ((= erlang-emacs-major-version 18) |
| 5232 | (require 'tags) |
| 5233 | (erlang-tags-define-keys (current-local-map)) |
| 5234 | (setq erlang-tags-installed t)) |
| 5235 | (t |
| 5236 | (require 'etags) |
| 5237 | ;; Test on a function available in the Emacs 19 version |
| 5238 | ;; of tags but not in the XEmacs version. |
| 5239 | (if (not (fboundp 'find-tag-noselect)) |
| 5240 | () |
| 5241 | (erlang-tags-define-keys (current-local-map)) |
| 5242 | (setq erlang-tags-installed t))))) |
| 5243 | |
| 5244 | |
| 5245 | ;; Set all keys bound to `find-tag' et.al. in the global map and the |
| 5246 | ;; menu to `erlang-find-tag' et.al. in `map'. |
| 5247 | ;; |
| 5248 | ;; The function `substitute-key-definition' does not work properly |
| 5249 | ;; in all version of Emacs. |
| 5250 | |
| 5251 | (defun erlang-tags-define-keys (map) |
| 5252 | "Bind tags commands to keymap MAP aware of Erlang modules." |
| 5253 | (let ((alist erlang-tags-function-alist)) |
| 5254 | (while alist |
| 5255 | (let* ((old (car (car alist))) |
| 5256 | (new (cdr (car alist))) |
| 5257 | (keys (append (where-is-internal old global-map)))) |
| 5258 | (while keys |
| 5259 | (define-key map (car keys) new) |
| 5260 | (setq keys (cdr keys)))) |
| 5261 | (setq alist (cdr alist)))) |
| 5262 | ;; Update the menu. |
| 5263 | (erlang-menu-substitute erlang-menu-base-items erlang-tags-function-alist) |
| 5264 | (erlang-menu-init)) |
| 5265 | |
| 5266 | |
| 5267 | ;; There exists a variable `find-tag-default-function'. It is not used |
| 5268 | ;; since `complete-tag' uses it to get current word under point. In that |
| 5269 | ;; situation we doesn't want the module to be prepended. |
| 5270 | |
| 5271 | (defun erlang-find-tag-default () |
| 5272 | "Return the default tag, searches `-import' list of imported functions. |
| 5273 | Single quotes has been stripped away." |
| 5274 | (let ((mod-func (erlang-get-function-under-point))) |
| 5275 | (cond ((null mod-func) |
| 5276 | nil) |
| 5277 | ((null (car mod-func)) |
| 5278 | (nth 1 mod-func)) |
| 5279 | (t |
| 5280 | (concat (car mod-func) ":" (nth 1 mod-func)))))) |
| 5281 | |
| 5282 | |
| 5283 | ;; Return `t' since it is used inside `tags-loop-form'. |
| 5284 | ;;;###autoload |
| 5285 | (defun erlang-find-tag (modtagname &optional next-p regexp-p) |
| 5286 | "Like `find-tag'. Capable of retreiving Erlang modules. |
| 5287 | |
| 5288 | Tags can be given on the forms `tag', `module:', `module:tag'." |
| 5289 | (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) |
| 5290 | (switch-to-buffer (erlang-find-tag-noselect modtagname next-p regexp-p)) |
| 5291 | t) |
| 5292 | |
| 5293 | |
| 5294 | ;; Code mainly from `find-tag-other-window' in `etags.el'. |
| 5295 | ;;;###autoload |
| 5296 | (defun erlang-find-tag-other-window (tagname &optional next-p regexp-p) |
| 5297 | "Like `find-tag-other-window' but aware of Erlang modules." |
| 5298 | (interactive (erlang-tag-interactive |
| 5299 | "Find `module:tag' or `tag' other window: ")) |
| 5300 | |
| 5301 | ;; This is to deal with the case where the tag is found in the |
| 5302 | ;; selected window's buffer; without this, point is moved in both |
| 5303 | ;; windows. To prevent this, we save the selected window's point |
| 5304 | ;; before doing find-tag-noselect, and restore it afterwards. |
| 5305 | (let* ((window-point (window-point (selected-window))) |
| 5306 | (tagbuf (erlang-find-tag-noselect tagname next-p regexp-p)) |
| 5307 | (tagpoint (progn (set-buffer tagbuf) (point)))) |
| 5308 | (set-window-point (prog1 |
| 5309 | (selected-window) |
| 5310 | (switch-to-buffer-other-window tagbuf) |
| 5311 | ;; We have to set this new window's point; it |
| 5312 | ;; might already have been displaying a |
| 5313 | ;; different portion of tagbuf, in which case |
| 5314 | ;; switch-to-buffer-other-window doesn't set |
| 5315 | ;; the window's point from the buffer. |
| 5316 | (set-window-point (selected-window) tagpoint)) |
| 5317 | window-point))) |
| 5318 | |
| 5319 | |
| 5320 | (defun erlang-find-tag-other-frame (tagname &optional next-p) |
| 5321 | "Like `find-tag-other-frame' but aware of Erlang modules." |
| 5322 | (interactive (erlang-tag-interactive |
| 5323 | "Find `module:tag' or `tag' other frame: ")) |
| 5324 | (let ((pop-up-frames t)) |
| 5325 | (erlang-find-tag-other-window tagname next-p))) |
| 5326 | |
| 5327 | |
| 5328 | (defun erlang-find-tag-regexp (regexp &optional next-p other-window) |
| 5329 | "Like `find-tag-regexp' but aware of Erlang modules." |
| 5330 | (interactive (if (fboundp 'find-tag-regexp) |
| 5331 | (erlang-tag-interactive |
| 5332 | "Find `module:regexp' or `regexp': ") |
| 5333 | (error "This version of Emacs can't find tags by regexps."))) |
| 5334 | (funcall (if other-window |
| 5335 | 'erlang-find-tag-other-window |
| 5336 | 'erlang-find-tag) |
| 5337 | regexp next-p t)) |
| 5338 | |
| 5339 | |
| 5340 | ;; Just like C-u M-. This could be added to the menu. |
| 5341 | (defun erlang-find-next-tag () |
| 5342 | (interactive) |
| 5343 | (let ((current-prefix-arg '(4))) |
| 5344 | (if erlang-tags-installed |
| 5345 | (call-interactively 'erlang-find-tag) |
| 5346 | (call-interactively 'find-tag)))) |
| 5347 | |
| 5348 | |
| 5349 | ;; Mimics `find-tag-noselect' found in `etags.el', but uses `find-tag' to |
| 5350 | ;; be compatible with `tags.el'. |
| 5351 | ;; |
| 5352 | ;; Handles three cases: |
| 5353 | ;; * `module:' Loop over all possible filen-ames. Stop if a file-name |
| 5354 | ;; without extension and directory matches the module. |
| 5355 | ;; |
| 5356 | ;; * `module:tag' |
| 5357 | ;; Emacs 19: Replace testfunctions with functions aware of |
| 5358 | ;; Erlang modules. Tricky because the etags system wasn't |
| 5359 | ;; built for these kind of operations... |
| 5360 | ;; |
| 5361 | ;; Emacs 18: We loop over `find-tag' until we find a file |
| 5362 | ;; whose module matches the requested module. The |
| 5363 | ;; drawback is that a lot of files could be loaded into |
| 5364 | ;; Emacs. |
| 5365 | ;; |
| 5366 | ;; * `tag' Just give it to `find-tag'. |
| 5367 | |
| 5368 | (defun erlang-find-tag-noselect (modtagname &optional next-p regexp-p) |
| 5369 | "Like `find-tag-noselect' but aware of Erlang modules." |
| 5370 | (interactive (erlang-tag-interactive "Find `module:tag' or `tag': ")) |
| 5371 | (or modtagname |
| 5372 | (setq modtagname (symbol-value 'last-tag))) |
| 5373 | (funcall (symbol-function 'set) 'last-tag modtagname) |
| 5374 | ;; `tags.el' uses this variable to record how M-, would |
| 5375 | ;; know where to restart a tags command. |
| 5376 | (if (boundp 'tags-loop-form) |
| 5377 | (funcall (symbol-function 'set) |
| 5378 | 'tags-loop-form '(erlang-find-tag nil t))) |
| 5379 | (save-window-excursion |
| 5380 | (cond |
| 5381 | ((string-match ":$" modtagname) |
| 5382 | ;; Only the module name was given. Read all files whose file name |
| 5383 | ;; match. |
| 5384 | (let ((modname (substring modtagname 0 (match-beginning 0))) |
| 5385 | (file nil)) |
| 5386 | (if (not next-p) |
| 5387 | (save-excursion |
| 5388 | (visit-tags-table-buffer) |
| 5389 | (setq erlang-tags-file-list |
| 5390 | (funcall (symbol-function 'tags-table-files))))) |
| 5391 | (while (null file) |
| 5392 | (or erlang-tags-file-list |
| 5393 | (save-excursion |
| 5394 | (if (and (featurep 'etags) |
| 5395 | (funcall |
| 5396 | (symbol-function 'visit-tags-table-buffer) 'same) |
| 5397 | (funcall |
| 5398 | (symbol-function 'visit-tags-table-buffer) t)) |
| 5399 | (setq erlang-tags-file-list |
| 5400 | (funcall (symbol-function 'tags-table-files))) |
| 5401 | (error "No %stags containing %s" (if next-p "more " "") |
| 5402 | modtagname)))) |
| 5403 | (if erlang-tags-file-list |
| 5404 | (let ((this-module (erlang-get-module-from-file-name |
| 5405 | (car erlang-tags-file-list)))) |
| 5406 | (if (and (stringp this-module) |
| 5407 | (string= modname this-module)) |
| 5408 | (setq file (car erlang-tags-file-list))) |
| 5409 | (setq erlang-tags-file-list (cdr erlang-tags-file-list))))) |
| 5410 | (set-buffer (or (get-file-buffer file) |
| 5411 | (find-file-noselect file))))) |
| 5412 | |
| 5413 | ((string-match ":" modtagname) |
| 5414 | (if (boundp 'find-tag-tag-order) |
| 5415 | ;; Method one: Add module-recognising functions to the |
| 5416 | ;; list of order functions. However, the tags system |
| 5417 | ;; from Emacs 18, and derives thereof (read: XEmacs) |
| 5418 | ;; hasn't got this feature. |
| 5419 | (progn |
| 5420 | (erlang-tags-install-module-check) |
| 5421 | (unwind-protect |
| 5422 | (funcall (symbol-function 'find-tag) |
| 5423 | modtagname next-p regexp-p) |
| 5424 | (erlang-tags-remove-module-check))) |
| 5425 | ;; Method two: Call the tags system until a file matching |
| 5426 | ;; the module is found. This could result in that many |
| 5427 | ;; files are read. (e.g. The tag "foo:file" will take a |
| 5428 | ;; while to process.) |
| 5429 | (let* ((modname (substring modtagname 0 (match-beginning 0))) |
| 5430 | (tagname (substring modtagname (match-end 0) nil)) |
| 5431 | (last-tag tagname) |
| 5432 | file) |
| 5433 | (while |
| 5434 | (progn |
| 5435 | (funcall (symbol-function 'find-tag) tagname next-p regexp-p) |
| 5436 | (setq next-p t) |
| 5437 | ;; Determine the module form the file name. (The |
| 5438 | ;; alternative, to check `-module', would make this |
| 5439 | ;; code useless for non-Erlang programs.) |
| 5440 | (setq file (erlang-get-module-from-file-name buffer-file-name)) |
| 5441 | (not (and (stringp file) |
| 5442 | (string= modname file)))))))) |
| 5443 | (t |
| 5444 | (funcall (symbol-function 'find-tag) modtagname next-p regexp-p))) |
| 5445 | (current-buffer))) ; Return the new buffer. |
| 5446 | |
| 5447 | |
| 5448 | ;; Process interactive arguments for erlang-find-tag-*. |
| 5449 | ;; |
| 5450 | ;; Negative arguments work only for `etags', not `tags'. This is not |
| 5451 | ;; a problem since negative arguments means step back into the |
| 5452 | ;; history list, a feature not implemented in `tags'. |
| 5453 | |
| 5454 | (defun erlang-tag-interactive (prompt) |
| 5455 | (condition-case nil |
| 5456 | (require 'etags) |
| 5457 | (error |
| 5458 | (require 'tags))) |
| 5459 | (if current-prefix-arg |
| 5460 | (list nil (if (< (prefix-numeric-value current-prefix-arg) 0) |
| 5461 | '- |
| 5462 | t)) |
| 5463 | (let* ((default (erlang-find-tag-default)) |
| 5464 | (prompt (if default |
| 5465 | (format "%s(default %s) " prompt default) |
| 5466 | prompt)) |
| 5467 | (spec (if (featurep 'etags) |
| 5468 | (completing-read prompt 'erlang-tags-complete-tag) |
| 5469 | (read-string prompt)))) |
| 5470 | (list (if (equal spec "") |
| 5471 | (or default (error "There is no default tag")) |
| 5472 | spec))))) |
| 5473 | |
| 5474 | |
| 5475 | ;; Search tag functions which are aware of Erlang modules. The tactic |
| 5476 | ;; is to store new search functions into the local variabels of the |
| 5477 | ;; TAGS buffers. The variables are restored directly after the |
| 5478 | ;; search. The situation is complicated by the fact that new TAGS |
| 5479 | ;; files can be loaded during the search. |
| 5480 | ;; |
| 5481 | ;; This code is Emacs 19 `etags' specific. |
| 5482 | |
| 5483 | (defun erlang-tags-install-module-check () |
| 5484 | "Install our own tag search functions." |
| 5485 | ;; Make sure our functions are installed in TAGS files loaded |
| 5486 | ;; into Emacs while searching. |
| 5487 | (setq erlang-tags-orig-format-hooks |
| 5488 | (symbol-value 'tags-table-format-hooks)) |
| 5489 | (funcall (symbol-function 'set) 'tags-table-format-hooks |
| 5490 | (cons 'erlang-tags-recognize-tags-table |
| 5491 | erlang-tags-orig-format-hooks)) |
| 5492 | (setq erlang-tags-buffer-list '()) |
| 5493 | ;; Install our functions in the TAGS files already resident. |
| 5494 | (save-excursion |
| 5495 | (let ((files (symbol-value 'tags-table-computed-list))) |
| 5496 | (while files |
| 5497 | (if (stringp (car files)) |
| 5498 | (if (get-file-buffer (car files)) |
| 5499 | (progn |
| 5500 | (set-buffer (get-file-buffer (car files))) |
| 5501 | (erlang-tags-install-local)))) |
| 5502 | (setq files (cdr files)))))) |
| 5503 | |
| 5504 | |
| 5505 | (defun erlang-tags-install-local () |
| 5506 | "Install our tag search functions in current buffer." |
| 5507 | (if erlang-tags-buffer-installed-p |
| 5508 | () |
| 5509 | ;; Mark this buffer as "installed" and record. |
| 5510 | (set (make-local-variable 'erlang-tags-buffer-installed-p) t) |
| 5511 | (setq erlang-tags-buffer-list |
| 5512 | (cons (current-buffer) erlang-tags-buffer-list)) |
| 5513 | |
| 5514 | ;; Save the original values. |
| 5515 | (set (make-local-variable 'erlang-tags-orig-tag-order) |
| 5516 | (symbol-value 'find-tag-tag-order)) |
| 5517 | (set (make-local-variable 'erlang-tags-orig-regexp-tag-order) |
| 5518 | (symbol-value 'find-tag-regexp-tag-order)) |
| 5519 | (set (make-local-variable 'erlang-tags-orig-search-function) |
| 5520 | (symbol-value 'find-tag-search-function)) |
| 5521 | (set (make-local-variable 'erlang-tags-orig-regexp-search-function) |
| 5522 | (symbol-value 'find-tag-regexp-search-function)) |
| 5523 | |
| 5524 | ;; Install our own functions. |
| 5525 | (set (make-local-variable 'find-tag-search-function) |
| 5526 | 'erlang-tags-search-forward) |
| 5527 | (set (make-local-variable 'find-tag-regexp-search-function) |
| 5528 | 'erlang-tags-regexp-search-forward) |
| 5529 | (set (make-local-variable 'find-tag-tag-order) |
| 5530 | '(erlang-tag-match-module-p)) |
| 5531 | (set (make-local-variable 'find-tag-regexp-tag-order) |
| 5532 | '(erlang-tag-match-module-regexp-p)))) |
| 5533 | |
| 5534 | |
| 5535 | (defun erlang-tags-remove-module-check () |
| 5536 | "Remove our own tags search functions." |
| 5537 | (funcall (symbol-function 'set) |
| 5538 | 'tags-table-format-hooks |
| 5539 | erlang-tags-orig-format-hooks) |
| 5540 | ;; Remove our functions from the TAGS files. (Note that |
| 5541 | ;; `tags-table-computed-list' need not be the same list as when |
| 5542 | ;; the search was started.) |
| 5543 | (save-excursion |
| 5544 | (let ((buffers erlang-tags-buffer-list)) |
| 5545 | (while buffers |
| 5546 | (if (buffer-name (car buffers)) |
| 5547 | (progn |
| 5548 | (set-buffer (car buffers)) |
| 5549 | (erlang-tags-remove-local))) |
| 5550 | (setq buffers (cdr buffers)))))) |
| 5551 | |
| 5552 | |
| 5553 | (defun erlang-tags-remove-local () |
| 5554 | "Remove our tag search functions from current buffer." |
| 5555 | (if (null erlang-tags-buffer-installed-p) |
| 5556 | () |
| 5557 | (funcall (symbol-function 'set) 'erlang-tags-buffer-installed-p nil) |
| 5558 | (funcall (symbol-function 'set) |
| 5559 | 'find-tag-tag-order erlang-tags-orig-tag-order) |
| 5560 | (funcall (symbol-function 'set) |
| 5561 | 'find-tag-regexp-tag-order erlang-tags-orig-regexp-tag-order) |
| 5562 | (funcall (symbol-function 'set) |
| 5563 | 'find-tag-search-function erlang-tags-orig-search-function) |
| 5564 | (funcall (symbol-function 'set) |
| 5565 | 'find-tag-regexp-search-function |
| 5566 | erlang-tags-orig-regexp-search-function))) |
| 5567 | |
| 5568 | |
| 5569 | (defun erlang-tags-recognize-tags-table () |
| 5570 | "Install our functions in all loaded TAGS files. |
| 5571 | |
| 5572 | This function is added to `tags-table-format-hooks' when searching |
| 5573 | for a tag on the form `module:tag'." |
| 5574 | (if (null (funcall (symbol-function 'etags-recognize-tags-table))) |
| 5575 | nil |
| 5576 | (erlang-tags-install-local) |
| 5577 | t)) |
| 5578 | |
| 5579 | |
| 5580 | (defun erlang-tags-search-forward (tag &optional bound noerror count) |
| 5581 | "Forward search function, aware of Erlang module prefix." |
| 5582 | (if (string-match ":" tag) |
| 5583 | (setq tag (substring tag (match-end 0) nil))) |
| 5584 | ;; Avoid uninteded recursion. |
| 5585 | (if (eq erlang-tags-orig-search-function 'erlang-tags-search-forward) |
| 5586 | (search-forward tag bound noerror count) |
| 5587 | (funcall erlang-tags-orig-search-function tag bound noerror count))) |
| 5588 | |
| 5589 | |
| 5590 | (defun erlang-tags-regexp-search-forward (tag &optional bound noerror count) |
| 5591 | "Forward regexp search function, aware of Erlang module prefix." |
| 5592 | (if (string-match ":" tag) |
| 5593 | (setq tag (substring tag (match-end 0) nil))) |
| 5594 | (if (eq erlang-tags-orig-regexp-search-function |
| 5595 | 'erlang-tags-regexp-search-forward) |
| 5596 | (re-search-forward tag bound noerror count) |
| 5597 | (funcall erlang-tags-orig-regexp-search-function |
| 5598 | tag bound noerror count))) |
| 5599 | |
| 5600 | |
| 5601 | ;; t if point is at a tag line that matches TAG, containing |
| 5602 | ;; module information. Assumes that all other order functions |
| 5603 | ;; are stored in `erlang-tags-orig-[regex]-tag-order'. |
| 5604 | |
| 5605 | (defun erlang-tag-match-module-p (tag) |
| 5606 | (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order)) |
| 5607 | |
| 5608 | (defun erlang-tag-match-module-regexp-p (tag) |
| 5609 | (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order)) |
| 5610 | |
| 5611 | (defun erlang-tag-match-module-common-p (tag order) |
| 5612 | (let ((mod nil) |
| 5613 | (found nil)) |
| 5614 | (if (string-match ":" tag) |
| 5615 | (progn |
| 5616 | (setq mod (substring tag 0 (match-beginning 0))) |
| 5617 | (setq tag (substring tag (match-end 0) nil)))) |
| 5618 | (while (and order (not found)) |
| 5619 | (setq found |
| 5620 | (and (not (memq (car order) |
| 5621 | '(erlang-tag-match-module-p |
| 5622 | erlang-tag-match-module-regexp-p))) |
| 5623 | (funcall (car order) tag))) |
| 5624 | (setq order (cdr order))) |
| 5625 | (and found |
| 5626 | (or (null mod) |
| 5627 | (string= mod (erlang-get-module-from-file-name |
| 5628 | (file-of-tag))))))) |
| 5629 | |
| 5630 | |
| 5631 | ;;; Tags completion, Emacs 19 `etags' specific. |
| 5632 | ;;; |
| 5633 | ;;; The basic idea is to create a second completion table `erlang-tags- |
| 5634 | ;;; completion-table' containing all normal tags plus tags on the form |
| 5635 | ;;; `module:tag'. |
| 5636 | |
| 5637 | |
| 5638 | (defun erlang-complete-tag () |
| 5639 | "Perform tags completion on the text around point. |
| 5640 | Completes to the set of names listed in the current tags table. |
| 5641 | |
| 5642 | Should the Erlang tags system be installed this command knows |
| 5643 | about Erlang modules." |
| 5644 | (interactive) |
| 5645 | (condition-case nil |
| 5646 | (require 'etags) |
| 5647 | (error nil)) |
| 5648 | (cond ((and erlang-tags-installed |
| 5649 | (fboundp 'complete-tag)) ; Emacs 19 |
| 5650 | (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) |
| 5651 | (fset 'tags-complete-tag |
| 5652 | (symbol-function 'erlang-tags-complete-tag)) |
| 5653 | (unwind-protect |
| 5654 | (funcall (symbol-function 'complete-tag)) |
| 5655 | (fset 'tags-complete-tag orig-tags-complete-tag)))) |
| 5656 | ((fboundp 'complete-tag) ; Emacs 19 |
| 5657 | (funcall (symbol-function 'complete-tag))) |
| 5658 | ((fboundp 'tag-complete-symbol) ; XEmacs |
| 5659 | (funcall (symbol-function 'tag-complete-symbol))) |
| 5660 | (t |
| 5661 | (error "This version of Emacs can't complete tags.")))) |
| 5662 | |
| 5663 | |
| 5664 | ;; Based on `tags-complete-tag', but this one uses |
| 5665 | ;; `erlang-tag-completion-table' instead of `tag-completion-table'. |
| 5666 | ;; |
| 5667 | ;; This is the entry-point called by system function `completing-read'. |
| 5668 | (defun erlang-tags-complete-tag (string predicate what) |
| 5669 | (save-excursion |
| 5670 | ;; If we need to ask for the tag table, allow that. |
| 5671 | (let ((enable-recursive-minibuffers t)) |
| 5672 | (visit-tags-table-buffer)) |
| 5673 | (if (eq what t) |
| 5674 | (all-completions string (erlang-tags-completion-table) predicate) |
| 5675 | (try-completion string (erlang-tags-completion-table) predicate)))) |
| 5676 | |
| 5677 | |
| 5678 | ;; `tags-completion-table' calls itself recursively, make it |
| 5679 | ;; call our own wedge instead. Note that the recursive call |
| 5680 | ;; is very rare; it only occurs when a tags-file contains |
| 5681 | ;; `include'-statements. |
| 5682 | (defun erlang-tags-completion-table () |
| 5683 | "Build completion table. Tags on the form `tag' or `module:tag'." |
| 5684 | (setq erlang-tags-orig-completion-table |
| 5685 | (symbol-function 'tags-completion-table)) |
| 5686 | (fset 'tags-completion-table |
| 5687 | (symbol-function 'erlang-tags-completion-table-1)) |
| 5688 | (unwind-protect |
| 5689 | (erlang-tags-completion-table-1) |
| 5690 | (fset 'tags-completion-table |
| 5691 | erlang-tags-orig-completion-table))) |
| 5692 | |
| 5693 | |
| 5694 | (defun erlang-tags-completion-table-1 () |
| 5695 | (make-local-variable 'erlang-tags-completion-table) |
| 5696 | (or erlang-tags-completion-table |
| 5697 | (let ((tags-completion-table nil) |
| 5698 | (tags-completion-table-function |
| 5699 | 'erlang-etags-tags-completion-table)) |
| 5700 | (funcall erlang-tags-orig-completion-table) |
| 5701 | (setq erlang-tags-completion-table tags-completion-table)))) |
| 5702 | |
| 5703 | |
| 5704 | ;; Based on `etags-tags-completion-table'. The difference is that we |
| 5705 | ;; adds three symbols to the vector, the tag, module: and module:tag. |
| 5706 | ;; The module is extracted from the file name of a tag. (This one |
| 5707 | ;; only works if we are looking at an `etags' file. However, this is |
| 5708 | ;; the only format supported by Emacs, so far.) |
| 5709 | (defun erlang-etags-tags-completion-table () |
| 5710 | (let ((table (make-vector 511 0)) |
| 5711 | (file nil)) |
| 5712 | (save-excursion |
| 5713 | (goto-char (point-min)) |
| 5714 | ;; This monster regexp matches an etags tag line. |
| 5715 | ;; \1 is the string to match; |
| 5716 | ;; \2 is not interesting; |
| 5717 | ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN |
| 5718 | ;; \4 is not interesting; |
| 5719 | ;; \5 is the explicitly-specified tag name. |
| 5720 | ;; \6 is the line to start searching at; |
| 5721 | ;; \7 is the char to start searching at. |
| 5722 | (while (progn |
| 5723 | (while (and |
| 5724 | (eq (following-char) ?\f) |
| 5725 | (looking-at "\f\n\\([^,\n]*\\),.*\n")) |
| 5726 | (setq file (buffer-substring |
| 5727 | (match-beginning 1) (match-end 1))) |
| 5728 | (goto-char (match-end 0))) |
| 5729 | (re-search-forward |
| 5730 | "\ |
| 5731 | ^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ |
| 5732 | \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ |
| 5733 | \\([0-9]+\\)?,\\([0-9]+\\)?\n" |
| 5734 | nil t)) |
| 5735 | (let ((tag (if (match-beginning 5) |
| 5736 | ;; There is an explicit tag name. |
| 5737 | (buffer-substring (match-beginning 5) (match-end 5)) |
| 5738 | ;; No explicit tag name. Best guess. |
| 5739 | (buffer-substring (match-beginning 3) (match-end 3)))) |
| 5740 | (module (and file |
| 5741 | (erlang-get-module-from-file-name file)))) |
| 5742 | (intern tag table) |
| 5743 | (if (stringp module) |
| 5744 | (progn |
| 5745 | (intern (concat module ":" tag) table) |
| 5746 | ;; Only the first one will be stored in the table. |
| 5747 | (intern (concat module ":") table)))))) |
| 5748 | table)) |
| 5749 | |
| 5750 | ;;; |
| 5751 | ;;; Prepare for other methods to run an Erlang slave process. |
| 5752 | ;;; |
| 5753 | |
| 5754 | (defvar erlang-shell-function 'inferior-erlang |
| 5755 | "Command to execute start a new Erlang shell. |
| 5756 | |
| 5757 | Change this variable to use your favorite |
| 5758 | Erlang compilation package.") |
| 5759 | |
| 5760 | (defvar erlang-shell-display-function 'inferior-erlang-run-or-select |
| 5761 | "Command to execute to display Erlang shell. |
| 5762 | |
| 5763 | Change this variable to use your favorite |
| 5764 | Erlang compilation package.") |
| 5765 | |
| 5766 | (defvar erlang-compile-function 'inferior-erlang-compile |
| 5767 | "Command to execute to compile current buffer. |
| 5768 | |
| 5769 | Change this variable to use your favorite |
| 5770 | Erlang compilation package.") |
| 5771 | |
| 5772 | (defvar erlang-compile-display-function 'inferior-erlang-run-or-select |
| 5773 | "Command to execute to view last compilation. |
| 5774 | |
| 5775 | Change this variable to use your favorite |
| 5776 | Erlang compilation package.") |
| 5777 | |
| 5778 | (defvar erlang-next-error-function 'inferior-erlang-next-error |
| 5779 | "Command to execute to go to the next error. |
| 5780 | |
| 5781 | Change this variable to use your favorite |
| 5782 | Erlang compilation package.") |
| 5783 | |
| 5784 | |
| 5785 | ;;;###autoload |
| 5786 | (defun erlang-shell () |
| 5787 | "Start a new Erlang shell. |
| 5788 | |
| 5789 | The variable `erlang-shell-function' decides which method to use, |
| 5790 | default is to start a new Erlang host. It is possible that, in the |
| 5791 | future, a new shell on an already running host will be started." |
| 5792 | (interactive) |
| 5793 | (call-interactively erlang-shell-function)) |
| 5794 | |
| 5795 | |
| 5796 | ;;;###autoload (autoload 'run-erlang "erlang" "Start a new Erlang shell." t) |
| 5797 | |
| 5798 | ;; It is customary for Emacs packages to supply a function on this |
| 5799 | ;; form, even though it violates the `erlang-*' name convention. |
| 5800 | (fset 'run-erlang 'erlang-shell) |
| 5801 | |
| 5802 | |
| 5803 | (defun erlang-shell-display () |
| 5804 | "Display an Erlang shell, or start a new." |
| 5805 | (interactive) |
| 5806 | (call-interactively erlang-shell-display-function)) |
| 5807 | |
| 5808 | |
| 5809 | ;;;###autoload |
| 5810 | (defun erlang-compile () |
| 5811 | "Compile Erlang module in current buffer." |
| 5812 | (interactive) |
| 5813 | (call-interactively erlang-compile-function)) |
| 5814 | |
| 5815 | |
| 5816 | (defun erlang-compile-display () |
| 5817 | "Display compilation output." |
| 5818 | (interactive) |
| 5819 | (call-interactively erlang-compile-display-function)) |
| 5820 | |
| 5821 | |
| 5822 | (defun erlang-next-error () |
| 5823 | "Display next error message from the latest compilation." |
| 5824 | (interactive) |
| 5825 | (call-interactively erlang-next-error-function)) |
| 5826 | |
| 5827 | |
| 5828 | |
| 5829 | ;;; |
| 5830 | ;;; Erlang Shell Mode -- Major mode used for Erlang shells. |
| 5831 | ;;; |
| 5832 | |
| 5833 | ;; This mode is designed to be implementation independent, |
| 5834 | ;; e.g. it does not assume that we are running an inferior |
| 5835 | ;; Erlang, there exists a lot of other possibilities. |
| 5836 | |
| 5837 | |
| 5838 | (defvar erlang-shell-buffer-name "*erlang*" |
| 5839 | "*The name of the Erlang link shell buffer.") |
| 5840 | |
| 5841 | |
| 5842 | (defvar erlang-shell-mode-map nil |
| 5843 | "*Keymap used by Erlang shells.") |
| 5844 | |
| 5845 | |
| 5846 | (defvar erlang-shell-mode-hook nil |
| 5847 | "*User functions to run when an Erlang shell is started. |
| 5848 | |
| 5849 | This hook is used to change the behaviour of Erlang mode. It is |
| 5850 | normally used by the user to personalise the programming environment. |
| 5851 | When used in a site init file, it could be used to customise Erlang |
| 5852 | mode for all users on the system. |
| 5853 | |
| 5854 | The functioned added to this hook is runed every time a new Erlang |
| 5855 | shell is started. |
| 5856 | |
| 5857 | See also `erlang-load-hook', a hook which is runed once, when Erlang |
| 5858 | mode is loaded, and `erlang-mode-hook' which is runed every time a new |
| 5859 | Erlang source file is loaded into Emacs.") |
| 5860 | |
| 5861 | |
| 5862 | (defvar erlang-input-ring-file-name "~/.erlang_history" |
| 5863 | "*When non-nil, file name used to store erlang shell history information.") |
| 5864 | |
| 5865 | |
| 5866 | (defun erlang-shell-mode () |
| 5867 | "Major mode for interacting with an Erlang shell. |
| 5868 | |
| 5869 | We assume that we already are in comint-mode. |
| 5870 | |
| 5871 | The following special commands are available: |
| 5872 | \\{erlang-shell-mode-map}" |
| 5873 | (interactive) |
| 5874 | (setq major-mode 'erlang-shell-mode) |
| 5875 | (setq mode-name "Erlang Shell") |
| 5876 | (erlang-mode-variables) |
| 5877 | (if erlang-shell-mode-map |
| 5878 | nil |
| 5879 | (setq erlang-shell-mode-map (copy-keymap comint-mode-map)) |
| 5880 | (erlang-shell-mode-commands erlang-shell-mode-map)) |
| 5881 | (use-local-map erlang-shell-mode-map) |
| 5882 | (set (make-local-variable 'compilation-parsing-end) 1) |
| 5883 | (set (make-local-variable 'compilation-error-list) nil) |
| 5884 | (set (make-local-variable 'compilation-old-error-list) nil) |
| 5885 | ;; Needed when compiling directly from the Erlang shell. |
| 5886 | (setq compilation-last-buffer (current-buffer)) |
| 5887 | (erlang-add-compilation-alist erlang-error-regexp-alist) |
| 5888 | (setq comint-prompt-regexp "^[^>=]*> *") |
| 5889 | (setq comint-eol-on-send t) |
| 5890 | (setq comint-input-ignoredups t) |
| 5891 | (setq comint-scroll-show-maximum-output t) |
| 5892 | (setq comint-scroll-to-bottom-on-output t) |
| 5893 | ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If |
| 5894 | ;; the call fails, just call the normal `add-hook'. |
| 5895 | (condition-case nil |
| 5896 | (progn |
| 5897 | (funcall (symbol-function 'add-hook) 'comint-output-filter-functions |
| 5898 | 'inferior-erlang-strip-delete nil t) |
| 5899 | (funcall (symbol-function 'add-hook) 'comint-output-filter-functions |
| 5900 | 'inferior-erlang-strip-ctrl-m nil t)) |
| 5901 | (error |
| 5902 | (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete) |
| 5903 | (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m))) |
| 5904 | ;; Some older versions of comint doesn't have an input ring. |
| 5905 | (if (fboundp 'comint-read-input-ring) |
| 5906 | (progn |
| 5907 | (setq comint-input-ring-file-name erlang-input-ring-file-name) |
| 5908 | (comint-read-input-ring t) |
| 5909 | (make-local-variable 'kill-buffer-hook) |
| 5910 | (add-hook 'kill-buffer-hook 'comint-write-input-ring))) |
| 5911 | (run-hooks 'erlang-shell-mode-hook)) |
| 5912 | |
| 5913 | |
| 5914 | (defun erlang-shell-mode-commands (map) |
| 5915 | (define-key map "\M-\t" 'erlang-complete-tag) |
| 5916 | (define-key map "\C-a" 'comint-bol) ; Normally the other way around. |
| 5917 | (define-key map "\C-c\C-a" 'beginning-of-line) |
| 5918 | (define-key map "\C-d" nil) ; Was `comint-delchar-or-maybe-eof' |
| 5919 | (define-key map "\C-x`" 'erlang-next-error)) |
| 5920 | |
| 5921 | ;;; |
| 5922 | ;;; Inferior Erlang -- Run an Erlang shell as a subprocess. |
| 5923 | ;;; |
| 5924 | |
| 5925 | (defvar inferior-erlang-display-buffer-any-frame nil |
| 5926 | "*When nil, `inferior-erlang-display-buffer' use only selected frame. |
| 5927 | When t, all frames are searched. When 'raise, the frame is raised.") |
| 5928 | |
| 5929 | (defvar inferior-erlang-shell-type 'newshell |
| 5930 | "The type of Erlang shell to use. |
| 5931 | |
| 5932 | When this variable is set to the atom `oldshell', the old shell is used. |
| 5933 | When set to `newshell' the new shell is used. Should the variable be |
| 5934 | nil, the default shell is used. |
| 5935 | |
| 5936 | This variable influence the setting of other variables.") |
| 5937 | |
| 5938 | (defvar inferior-erlang-machine "erl" |
| 5939 | "*The name of the Erlang shell.") |
| 5940 | |
| 5941 | (defvar inferior-erlang-machine-options '() |
| 5942 | "*The options used when activating the Erlang shell. |
| 5943 | |
| 5944 | This must be a list of strings.") |
| 5945 | |
| 5946 | (defvar inferior-erlang-process-name "inferior-erlang" |
| 5947 | "*The name of the inferior Erlang process.") |
| 5948 | |
| 5949 | (defvar inferior-erlang-buffer-name erlang-shell-buffer-name |
| 5950 | "*The name of the inferior erlang buffer.") |
| 5951 | |
| 5952 | (defvar inferior-erlang-prompt-timeout 60 |
| 5953 | "*Number of seconds before `inferior-erlang-wait-prompt' timeouts. |
| 5954 | |
| 5955 | The time specified is waited after every output made by the inferior |
| 5956 | Erlang shell. When this variable is t, we assume that we always have |
| 5957 | a prompt. When nil, we will wait forever, or until C-g.") |
| 5958 | |
| 5959 | (defvar inferior-erlang-process nil |
| 5960 | "Process of last invoked inferior Erlang, or nil.") |
| 5961 | |
| 5962 | (defvar inferior-erlang-buffer nil |
| 5963 | "Buffer of last invoked inferior Erlang, or nil.") |
| 5964 | |
| 5965 | ;;;###autoload |
| 5966 | (defun inferior-erlang () |
| 5967 | "Run an inferior Erlang. |
| 5968 | |
| 5969 | This is just like running Erlang in a normal shell, except that |
| 5970 | an Emacs buffer is used for input and output. |
| 5971 | |
| 5972 | The command line history can be accessed with M-p and M-n. |
| 5973 | The history is saved between sessions. |
| 5974 | |
| 5975 | Entry to this mode calls the functions in the variables |
| 5976 | `comint-mode-hook' and `erlang-shell-mode-hook' with no arguments. |
| 5977 | |
| 5978 | The following commands imitate the usual Unix interrupt and |
| 5979 | editing control characters: |
| 5980 | \\{erlang-shell-mode-map}" |
| 5981 | (interactive) |
| 5982 | (require 'comint) |
| 5983 | (let ((opts inferior-erlang-machine-options)) |
| 5984 | (cond ((eq inferior-erlang-shell-type 'oldshell) |
| 5985 | (setq opts (cons "-oldshell" opts))) |
| 5986 | ((eq inferior-erlang-shell-type 'newshell) |
| 5987 | (setq opts (append '("-newshell" "-env" "TERM" "vt100") opts)))) |
| 5988 | (setq inferior-erlang-buffer |
| 5989 | (apply 'make-comint |
| 5990 | inferior-erlang-process-name inferior-erlang-machine |
| 5991 | nil opts))) |
| 5992 | (setq inferior-erlang-process |
| 5993 | (get-buffer-process inferior-erlang-buffer)) |
| 5994 | (process-kill-without-query inferior-erlang-process) |
| 5995 | (switch-to-buffer inferior-erlang-buffer) |
| 5996 | (if (and (not (eq system-type 'windows-nt)) |
| 5997 | (eq inferior-erlang-shell-type 'newshell)) |
| 5998 | (setq comint-process-echoes t)) |
| 5999 | ;; `rename-buffer' takes only one argument in Emacs 18. |
| 6000 | (condition-case nil |
| 6001 | (rename-buffer inferior-erlang-buffer-name t) |
| 6002 | (error (rename-buffer inferior-erlang-buffer-name))) |
| 6003 | (erlang-shell-mode)) |
| 6004 | |
| 6005 | |
| 6006 | (defun inferior-erlang-run-or-select () |
| 6007 | "Switch to an inferior Erlang buffer, possibly starting new process." |
| 6008 | (interactive) |
| 6009 | (if (null (inferior-erlang-running-p)) |
| 6010 | (inferior-erlang) |
| 6011 | (inferior-erlang-display-buffer t))) |
| 6012 | |
| 6013 | |
| 6014 | (defun inferior-erlang-display-buffer (&optional select) |
| 6015 | "Make the inferior Erlang process visible. |
| 6016 | The window is returned. |
| 6017 | |
| 6018 | Should `inferior-erlang-display-buffer-any-frame' be nil the buffer is |
| 6019 | displayed in the current frame. Should it be non-nil, and the buffer |
| 6020 | already is visible in any other frame, no new window will be created. |
| 6021 | Should it be the atom 'raise, the frame containing the window will |
| 6022 | be raised. |
| 6023 | |
| 6024 | Should the optional argument SELECT be non-nil, the window is |
| 6025 | selected. Should the window be in another frame, that frame is raised. |
| 6026 | |
| 6027 | Note, should the mouse pointer be places outside the raised frame, that |
| 6028 | frame will become deselected before the next command." |
| 6029 | (interactive) |
| 6030 | (or (inferior-erlang-running-p) |
| 6031 | (error "No inferior Erlang process is running.")) |
| 6032 | (let ((win (inferior-erlang-window |
| 6033 | inferior-erlang-display-buffer-any-frame)) |
| 6034 | (frames-p (fboundp 'selected-frame))) |
| 6035 | (if (null win) |
| 6036 | (let ((old-win (selected-window))) |
| 6037 | (save-excursion |
| 6038 | (switch-to-buffer-other-window inferior-erlang-buffer) |
| 6039 | (setq win (selected-window))) |
| 6040 | (select-window old-win)) |
| 6041 | (if (and window-system |
| 6042 | frames-p |
| 6043 | (or select |
| 6044 | (eq inferior-erlang-display-buffer-any-frame 'raise)) |
| 6045 | (not (eq (selected-frame) (window-frame win)))) |
| 6046 | (raise-frame (window-frame win)))) |
| 6047 | (if select |
| 6048 | (select-window win)) |
| 6049 | (sit-for 0) |
| 6050 | win)) |
| 6051 | |
| 6052 | |
| 6053 | (defun inferior-erlang-running-p () |
| 6054 | "Non-nil when an inferior Erlang is running." |
| 6055 | (and inferior-erlang-process |
| 6056 | (memq (process-status inferior-erlang-process) '(run open)) |
| 6057 | inferior-erlang-buffer |
| 6058 | (buffer-name inferior-erlang-buffer))) |
| 6059 | |
| 6060 | |
| 6061 | (defun inferior-erlang-window (&optional all-frames) |
| 6062 | "Return the window containing the inferior Erlang, or nil." |
| 6063 | (and (inferior-erlang-running-p) |
| 6064 | (if (and all-frames (>= erlang-emacs-major-version 19)) |
| 6065 | (get-buffer-window inferior-erlang-buffer t) |
| 6066 | (get-buffer-window inferior-erlang-buffer)))) |
| 6067 | |
| 6068 | |
| 6069 | (defun inferior-erlang-wait-prompt () |
| 6070 | "Wait until the inferior Erlang shell prompt appear." |
| 6071 | (if (eq inferior-erlang-prompt-timeout t) |
| 6072 | () |
| 6073 | (or (inferior-erlang-running-p) |
| 6074 | (error "No inferior Erlang shell is running.")) |
| 6075 | (save-excursion |
| 6076 | (set-buffer inferior-erlang-buffer) |
| 6077 | (let ((msg nil)) |
| 6078 | (while (save-excursion |
| 6079 | (goto-char (process-mark inferior-erlang-process)) |
| 6080 | (forward-line 0) |
| 6081 | (not (looking-at comint-prompt-regexp))) |
| 6082 | (if msg |
| 6083 | () |
| 6084 | (setq msg t) |
| 6085 | (message "Waiting for Erlang shell prompt (press C-g to abort).")) |
| 6086 | (or (accept-process-output inferior-erlang-process |
| 6087 | inferior-erlang-prompt-timeout) |
| 6088 | (error "No Erlang shell prompt before timeout."))) |
| 6089 | (if msg (message "")))))) |
| 6090 | |
| 6091 | |
| 6092 | (defun inferior-erlang-send-command (cmd &optional hist) |
| 6093 | "Send command CMD to the inferior Erlang. |
| 6094 | |
| 6095 | The contents of the current command line (if any) will |
| 6096 | be placed at the next prompt. |
| 6097 | |
| 6098 | If optional second argument is non-nil the command is inserted into |
| 6099 | the history list. |
| 6100 | |
| 6101 | Return the position after the newly inserted command." |
| 6102 | (or (inferior-erlang-running-p) |
| 6103 | (error "No inferior Erlang process is running.")) |
| 6104 | (let ((old-buffer (current-buffer)) |
| 6105 | (insert-point (marker-position |
| 6106 | (process-mark inferior-erlang-process))) |
| 6107 | (insert-length (if comint-process-echoes |
| 6108 | 0 |
| 6109 | (1+ (length cmd))))) |
| 6110 | (set-buffer inferior-erlang-buffer) |
| 6111 | (goto-char insert-point) |
| 6112 | (insert cmd) |
| 6113 | ;; Strange things happend if `comint-eol-on-send' is declared |
| 6114 | ;; in the `let' expression above, but setq:d here. The |
| 6115 | ;; `set-buffer' statement obviously makes the buffer local |
| 6116 | ;; instance of `comint-eol-on-send' shadow this one. |
| 6117 | ;; I'm considering this a bug in Elisp. |
| 6118 | (let ((comint-eol-on-send nil) |
| 6119 | (comint-input-filter (if hist comint-input-filter 'ignore))) |
| 6120 | (comint-send-input)) |
| 6121 | ;; Adjust all windows whose points are incorrect. |
| 6122 | (if (null comint-process-echoes) |
| 6123 | (walk-windows |
| 6124 | (function |
| 6125 | (lambda (window) |
| 6126 | (if (and (eq (window-buffer window) inferior-erlang-buffer) |
| 6127 | (eq (window-point window) insert-point)) |
| 6128 | (set-window-point window |
| 6129 | (+ insert-point insert-length))))) |
| 6130 | nil t)) |
| 6131 | (set-buffer old-buffer) |
| 6132 | (+ insert-point insert-length))) |
| 6133 | |
| 6134 | |
| 6135 | (defun inferior-erlang-strip-delete (&optional s) |
| 6136 | "Remove `^H' (delete) and the characters it was supposed to remove." |
| 6137 | (interactive) |
| 6138 | (if (and (boundp 'comint-last-input-end) |
| 6139 | (boundp 'comint-last-output-start)) |
| 6140 | (save-excursion |
| 6141 | (goto-char |
| 6142 | (if (interactive-p) |
| 6143 | (symbol-value 'comint-last-input-end) |
| 6144 | (symbol-value 'comint-last-output-start))) |
| 6145 | (while (progn (skip-chars-forward "^\C-h") |
| 6146 | (not (eq (point) (point-max)))) |
| 6147 | (delete-char 1) |
| 6148 | (or (bolp) |
| 6149 | (backward-delete-char 1)))))) |
| 6150 | |
| 6151 | |
| 6152 | ;; Basically `comint-strip-ctrl-m', with a few extra checks. |
| 6153 | (defun inferior-erlang-strip-ctrl-m (&optional string) |
| 6154 | "Strip trailing `^M' characters from the current output group." |
| 6155 | (interactive) |
| 6156 | (if (and (boundp 'comint-last-input-end) |
| 6157 | (boundp 'comint-last-output-start)) |
| 6158 | (let ((pmark (process-mark (get-buffer-process (current-buffer))))) |
| 6159 | (save-excursion |
| 6160 | (goto-char |
| 6161 | (if (interactive-p) |
| 6162 | (symbol-value 'comint-last-input-end) |
| 6163 | (symbol-value 'comint-last-output-start))) |
| 6164 | (while (re-search-forward "\r+$" pmark t) |
| 6165 | (replace-match "" t t)))))) |
| 6166 | |
| 6167 | |
| 6168 | (defun inferior-erlang-compile () |
| 6169 | "Compile the file in the current buffer. |
| 6170 | |
| 6171 | Should Erlang return `{error, nofile}' it could not load the object |
| 6172 | module after completing the compilation. This is due to a bug in the |
| 6173 | compile command `c' when using the option `outdir'. |
| 6174 | |
| 6175 | There exists two workarounds for this bug: |
| 6176 | |
| 6177 | 1) Place the directory in the Erlang load path. |
| 6178 | |
| 6179 | 2) Set the Emacs variable `erlang-compile-use-outdir' to nil. |
| 6180 | To do so, place the following line in your `~/.emacs'-file: |
| 6181 | (setq erlang-compile-use-outdir nil)" |
| 6182 | (interactive) |
| 6183 | (save-some-buffers) |
| 6184 | (or (inferior-erlang-running-p) |
| 6185 | (save-excursion |
| 6186 | (inferior-erlang))) |
| 6187 | (or (inferior-erlang-running-p) |
| 6188 | (error "Error starting inferior Erlang shell.")) |
| 6189 | (let ((dir (file-name-directory (buffer-file-name))) |
| 6190 | ;;; (file (file-name-nondirectory (buffer-file-name))) |
| 6191 | (noext (substring (buffer-file-name) 0 -4)) |
| 6192 | ;; Hopefully, noone else will ever use these... |
| 6193 | (tmpvar "Tmp7236") |
| 6194 | (tmpvar2 "Tmp8742") |
| 6195 | end) |
| 6196 | (inferior-erlang-display-buffer) |
| 6197 | (inferior-erlang-wait-prompt) |
| 6198 | (setq end (inferior-erlang-send-command |
| 6199 | (if erlang-compile-use-outdir |
| 6200 | (format "c(\"%s\", [{outdir, \"%s\"}])." noext dir) |
| 6201 | (format |
| 6202 | (concat |
| 6203 | "f(%s), {ok, %s} = file:get_cwd(), " |
| 6204 | "file:set_cwd(\"%s\"), " |
| 6205 | "%s = c(\"%s\"), file:set_cwd(%s), f(%s), %s.") |
| 6206 | tmpvar2 tmpvar |
| 6207 | dir |
| 6208 | tmpvar2 noext tmpvar tmpvar tmpvar2)) |
| 6209 | nil)) |
| 6210 | (save-excursion |
| 6211 | (set-buffer inferior-erlang-buffer) |
| 6212 | (setq compilation-error-list nil) |
| 6213 | (setq compilation-parsing-end end)) |
| 6214 | (setq compilation-last-buffer inferior-erlang-buffer))) |
| 6215 | |
| 6216 | |
| 6217 | ;; `next-error' only accepts buffers with major mode `compilation-mode' |
| 6218 | ;; or with the minor mode `compilation-minor-mode' activated. |
| 6219 | ;; (To activate the minor mode is out of the question, since it will |
| 6220 | ;; ruin the inferior Erlang keymap.) |
| 6221 | (defun inferior-erlang-next-error (&optional argp) |
| 6222 | "Just like `next-error'. |
| 6223 | Capable of finding error messages in an inferior Erlang buffer." |
| 6224 | (interactive "P") |
| 6225 | (let ((done nil) |
| 6226 | (buf (and (boundp 'compilation-last-buffer) |
| 6227 | compilation-last-buffer))) |
| 6228 | (if (and (bufferp buf) |
| 6229 | (save-excursion |
| 6230 | (set-buffer buf) |
| 6231 | (and (eq major-mode 'erlang-shell-mode) |
| 6232 | (setq major-mode 'compilation-mode)))) |
| 6233 | (unwind-protect |
| 6234 | (progn |
| 6235 | (setq done t) |
| 6236 | (next-error argp)) |
| 6237 | (save-excursion |
| 6238 | (set-buffer buf) |
| 6239 | (setq major-mode 'erlang-shell-mode)))) |
| 6240 | (or done |
| 6241 | (next-error argp)))) |
| 6242 | |
| 6243 | |
| 6244 | (defun inferior-erlang-change-directory (&optional dir) |
| 6245 | "Make the inferior erlang change directory. |
| 6246 | The default is to go to the directory of the current buffer." |
| 6247 | (interactive) |
| 6248 | (or dir (setq dir (file-name-directory (buffer-file-name)))) |
| 6249 | (or (inferior-erlang-running-p) |
| 6250 | (error "No inferior Erlang is running.")) |
| 6251 | (inferior-erlang-display-buffer) |
| 6252 | (inferior-erlang-wait-prompt) |
| 6253 | (inferior-erlang-send-command (format "cd('%s')." dir) nil)) |
| 6254 | |
| 6255 | ;; Aliases for backward compatibility with older versions of Erlang Mode. |
| 6256 | ;; |
| 6257 | ;; Unfortuantely, older versions of Emacs doesn't have `defalias' and |
| 6258 | ;; `make-obsolete' so we have to define our own `obsolete' function. |
| 6259 | |
| 6260 | (defun erlang-obsolete (sym newdef) |
| 6261 | "Make the obsolete function SYM refer to the defined function NEWDEF. |
| 6262 | |
| 6263 | Simplified version of a combination `defalias' and `make-obsolete', |
| 6264 | it assumes that NEWDEF is loaded." |
| 6265 | (fset sym (symbol-function newdef)) |
| 6266 | (if (fboundp 'make-obsolete) |
| 6267 | (make-obsolete sym newdef))) |
| 6268 | |
| 6269 | |
| 6270 | (erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent) |
| 6271 | (erlang-obsolete 'calculate-erlang-stack-indent |
| 6272 | 'erlang-calculate-stack-indent) |
| 6273 | (erlang-obsolete 'at-erlang-keyword 'erlang-at-keyword) |
| 6274 | (erlang-obsolete 'at-erlang-operator 'erlang-at-operator) |
| 6275 | (erlang-obsolete 'beginning-of-erlang-clause 'erlang-beginning-of-clause) |
| 6276 | (erlang-obsolete 'end-of-erlang-clause 'erlang-end-of-clause) |
| 6277 | (erlang-obsolete 'mark-erlang-clause 'erlang-mark-clause) |
| 6278 | (erlang-obsolete 'beginning-of-erlang-function 'erlang-beginning-of-function) |
| 6279 | (erlang-obsolete 'end-of-erlang-function 'erlang-end-of-function) |
| 6280 | (erlang-obsolete 'mark-erlang-function 'erlang-mark-function) |
| 6281 | (erlang-obsolete 'pass-over-erlang-clause 'erlang-pass-over-function) |
| 6282 | (erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function) |
| 6283 | |
| 6284 | |
| 6285 | ;; The end... |
| 6286 | |
| 6287 | (provide 'erlang) |
| 6288 | |
| 6289 | (run-hooks 'erlang-load-hook) |
| 6290 | |
| 6291 | ;;; erlang.el ends here |