66 |
;; the variable f90-comment-region in every line of the region. |
;; the variable f90-comment-region in every line of the region. |
67 |
|
|
68 |
;; One common convention for free vs. fixed format is that free-format files |
;; One common convention for free vs. fixed format is that free-format files |
69 |
;; have the ending .f90 or .f95 while fixed format files have the ending .f. |
;; have the ending .f90 or .f95 while fixed format files have the ending .f. |
70 |
;; Emacs automatically loads Fortran files in the appropriate mode based |
;; Emacs automatically loads Fortran files in the appropriate mode based |
71 |
;; on extension. You can modify this by adjusting the variable auto-mode-alist. |
;; on extension. You can modify this by adjusting the variable auto-mode-alist. |
72 |
;; For example: |
;; For example: |
73 |
;; (add-to-list 'auto-mode-alist '("\\.f\\'" . f90-mode)) |
;; (add-to-list 'auto-mode-alist '("\\.f\\'" . f90-mode)) |
74 |
|
|
75 |
;; Once you have entered f90-mode, you may get more info by using |
;; Once you have entered f90-mode, you may get more info by using |
76 |
;; the command describe-mode (C-h m). For online help use |
;; the command describe-mode (C-h m). For online help use |
77 |
;; C-h f <Name of function you want described>, or |
;; C-h f <Name of function you want described>, or |
78 |
;; C-h v <Name of variable you want described>. |
;; C-h v <Name of variable you want described>. |
79 |
|
|
277 |
|
|
278 |
(defconst f90-procedures-re |
(defconst f90-procedures-re |
279 |
(concat "\\<" |
(concat "\\<" |
280 |
(regexp-opt |
(regexp-opt |
281 |
'("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" |
'("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" |
282 |
"all" "allocated" "anint" "any" "asin" "associated" |
"all" "allocated" "anint" "any" "asin" "associated" |
283 |
"atan" "atan2" "bit_size" "btest" "ceiling" "char" "cmplx" |
"atan" "atan2" "bit_size" "btest" "ceiling" "char" "cmplx" |
284 |
"conjg" "cos" "cosh" "count" "cshift" "date_and_time" "dble" |
"conjg" "cos" "cosh" "count" "cshift" "date_and_time" "dble" |
285 |
"digits" "dim" "dot_product" "dprod" "eoshift" "epsilon" |
"digits" "dim" "dot_product" "dprod" "eoshift" "epsilon" |
286 |
"exp" "exponent" "floor" "fraction" "huge" "iachar" "iand" |
"exp" "exponent" "floor" "fraction" "huge" "iachar" "iand" |
287 |
"ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior" |
"ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior" |
288 |
"ishft" "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt" |
"ishft" "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt" |
289 |
"lle" "llt" "log" "log10" "logical" "matmul" "max" |
"lle" "llt" "log" "log10" "logical" "matmul" "max" |
290 |
"maxexponent" "maxloc" "maxval" "merge" "min" "minexponent" |
"maxexponent" "maxloc" "maxval" "merge" "min" "minexponent" |
291 |
"minloc" "minval" "mod" "modulo" "mvbits" "nearest" "nint" |
"minloc" "minval" "mod" "modulo" "mvbits" "nearest" "nint" |
292 |
"not" "pack" "precision" "present" "product" "radix" |
"not" "pack" "precision" "present" "product" "radix" |
293 |
;; Real is taken out here to avoid highlighting declarations. |
;; Real is taken out here to avoid highlighting declarations. |
294 |
"random_number" "random_seed" "range" ;; "real" |
"random_number" "random_seed" "range" ;; "real" |
295 |
"repeat" "reshape" "rrspacing" "scale" "scan" |
"repeat" "reshape" "rrspacing" "scale" "scan" |
296 |
"selected_int_kind" "selected_real_kind" "set_exponent" |
"selected_int_kind" "selected_real_kind" "set_exponent" |
297 |
"shape" "sign" "sin" "sinh" "size" "spacing" "spread" "sqrt" |
"shape" "sign" "sin" "sinh" "size" "spacing" "spread" "sqrt" |
298 |
"sum" "system_clock" "tan" "tanh" "tiny" "transfer" |
"sum" "system_clock" "tan" "tanh" "tiny" "transfer" |
299 |
"transpose" "trim" "ubound" "unpack" "verify" |
"transpose" "trim" "ubound" "unpack" "verify" |
300 |
;; F95 intrinsic functions. |
;; F95 intrinsic functions. |
301 |
"null" "cpu_time") t) |
"null" "cpu_time") t) |
302 |
;; A left parenthesis to avoid highlighting non-procedures. |
;; A left parenthesis to avoid highlighting non-procedures. |
303 |
"[ \t]*(") |
"[ \t]*(") |
304 |
"Regexp whose first part matches F90 intrinsic procedures.") |
"Regexp whose first part matches F90 intrinsic procedures.") |
305 |
|
|
306 |
(defconst f90-operators-re |
(defconst f90-operators-re |
307 |
(concat "\\." |
(concat "\\." |
308 |
(regexp-opt '("and" "eq" "eqv" "false" "ge" "gt" "le" "lt" "ne" |
(regexp-opt '("and" "eq" "eqv" "false" "ge" "gt" "le" "lt" "ne" |
309 |
"neqv" "not" "or" "true") t) |
"neqv" "not" "or" "true") t) |
310 |
"\\.") |
"\\.") |
311 |
"Regexp matching intrinsic operators.") |
"Regexp matching intrinsic operators.") |
312 |
|
|
313 |
(defconst f90-hpf-keywords-re |
(defconst f90-hpf-keywords-re |
328 |
"product_suffix" "sum_prefix" "sum_scatter" "sum_suffix" |
"product_suffix" "sum_prefix" "sum_scatter" "sum_suffix" |
329 |
;; Directives |
;; Directives |
330 |
"align" "distribute" "dynamic" "independent" "inherit" "processors" |
"align" "distribute" "dynamic" "independent" "inherit" "processors" |
331 |
"realign" "redistribute" "template" |
"realign" "redistribute" "template" |
332 |
;; Keywords |
;; Keywords |
333 |
"block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words) |
"block" "cyclic" "extrinsic" "new" "onto" "pure" "with") 'words) |
334 |
"Regexp for all HPF keywords, procedures and directives.") |
"Regexp for all HPF keywords, procedures and directives.") |
343 |
;;; '("\\<\\(type\\)[ \t]*\\(.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)" |
;;; '("\\<\\(type\\)[ \t]*\\(.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)" |
344 |
;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) |
;;; (1 font-lock-keyword-face) (3 font-lock-function-name-face)) |
345 |
;; Other functions and declarations. |
;; Other functions and declarations. |
346 |
'("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|subroutine\\|type\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?" |
'("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\ |
347 |
|
subroutine\\|type\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?" |
348 |
(1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) |
(1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) |
349 |
"\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>") |
"\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>") |
350 |
"This does fairly subdued highlighting of comments and function calls.") |
"This does fairly subdued highlighting of comments and function calls.") |
351 |
|
|
352 |
(defvar f90-font-lock-keywords-2 |
(defvar f90-font-lock-keywords-2 |
353 |
(append f90-font-lock-keywords-1 |
(append |
354 |
(list |
f90-font-lock-keywords-1 |
355 |
;; Variable declarations (avoid the real function call) |
(list |
356 |
'("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)" |
;; Variable declarations (avoid the real function call) |
357 |
(1 font-lock-type-face t) (4 font-lock-variable-name-face)) |
'("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ |
358 |
;; do, if, select, where, and forall constructs |
logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)" |
359 |
'("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)?" |
(1 font-lock-type-face t) (4 font-lock-variable-name-face)) |
360 |
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) |
;; do, if, select, where, and forall constructs |
361 |
'("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" |
'("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\ |
362 |
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) |
\\([ \t]+\\(\\sw+\\)\\)?" |
363 |
;; implicit declaration |
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) |
364 |
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" (1 font-lock-keyword-face) (2 font-lock-type-face)) |
'("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ |
365 |
'("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) |
do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" |
366 |
"\\<else\\([ \t]*if\\|where\\)?\\>" |
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) |
367 |
"\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" |
;; implicit declaration |
368 |
'("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" |
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ |
369 |
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) |
\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" |
370 |
'("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) |
(1 font-lock-keyword-face) (2 font-lock-type-face)) |
371 |
'("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" |
'("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" |
372 |
(1 font-lock-keyword-face) (2 font-lock-constant-face)) |
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) |
373 |
;; line numbers (lines whose first character after number is letter) |
"\\<else\\([ \t]*if\\|where\\)?\\>" |
374 |
'("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)))) |
"\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>" |
375 |
|
'("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" |
376 |
|
(1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) |
377 |
|
'("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1) |
378 |
|
'("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)" |
379 |
|
(1 font-lock-keyword-face) (2 font-lock-constant-face)) |
380 |
|
;; line numbers (lines whose first character after number is letter) |
381 |
|
'("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-constant-face t)))) |
382 |
"Highlights declarations, do-loops and other constructs.") |
"Highlights declarations, do-loops and other constructs.") |
383 |
|
|
384 |
(defvar f90-font-lock-keywords-3 |
(defvar f90-font-lock-keywords-3 |
385 |
(append f90-font-lock-keywords-2 |
(append f90-font-lock-keywords-2 |
386 |
(list |
(list |
387 |
f90-keywords-level-3-re |
f90-keywords-level-3-re |
388 |
f90-operators-re |
f90-operators-re |
389 |
(list f90-procedures-re '(1 font-lock-keyword-face keep)) |
(list f90-procedures-re '(1 font-lock-keyword-face keep)) |
390 |
"\\<real\\>" ; Avoid overwriting real defs. |
"\\<real\\>" ; Avoid overwriting real defs. |
391 |
)) |
)) |
392 |
"Highlights all F90 keywords and intrinsic procedures.") |
"Highlights all F90 keywords and intrinsic procedures.") |
393 |
|
|
394 |
(defvar f90-font-lock-keywords-4 |
(defvar f90-font-lock-keywords-4 |
395 |
(append f90-font-lock-keywords-3 |
(append f90-font-lock-keywords-3 |
396 |
(list f90-hpf-keywords-re)) |
(list f90-hpf-keywords-re)) |
397 |
"Highlights all F90 and HPF keywords.") |
"Highlights all F90 and HPF keywords.") |
398 |
|
|
399 |
(defvar f90-font-lock-keywords |
(defvar f90-font-lock-keywords |
413 |
(modify-syntax-entry ?\" "\"" f90-mode-syntax-table) ; string quote |
(modify-syntax-entry ?\" "\"" f90-mode-syntax-table) ; string quote |
414 |
(modify-syntax-entry ?\` "w" f90-mode-syntax-table) ; for abbrevs |
(modify-syntax-entry ?\` "w" f90-mode-syntax-table) ; for abbrevs |
415 |
(modify-syntax-entry ?\r " " f90-mode-syntax-table) ; return is whitespace |
(modify-syntax-entry ?\r " " f90-mode-syntax-table) ; return is whitespace |
416 |
(modify-syntax-entry ?+ "." f90-mode-syntax-table) |
(modify-syntax-entry ?+ "." f90-mode-syntax-table) |
417 |
(modify-syntax-entry ?- "." f90-mode-syntax-table) |
(modify-syntax-entry ?- "." f90-mode-syntax-table) |
418 |
(modify-syntax-entry ?= "." f90-mode-syntax-table) |
(modify-syntax-entry ?= "." f90-mode-syntax-table) |
419 |
(modify-syntax-entry ?* "." f90-mode-syntax-table) |
(modify-syntax-entry ?* "." f90-mode-syntax-table) |
448 |
(define-key f90-mode-map "*" 'f90-electric-insert) |
(define-key f90-mode-map "*" 'f90-electric-insert) |
449 |
(define-key f90-mode-map "/" 'f90-electric-insert)) |
(define-key f90-mode-map "/" 'f90-electric-insert)) |
450 |
|
|
451 |
|
|
452 |
;; menus |
;; menus |
453 |
(if f90-xemacs-flag |
(if f90-xemacs-flag |
454 |
(defvar f90-xemacs-menu |
(defvar f90-xemacs-menu |
471 |
["Upcase Keywords (region)" f90-upcase-region-keywords |
["Upcase Keywords (region)" f90-upcase-region-keywords |
472 |
t] |
t] |
473 |
["Capitalize Keywords (buffer)" f90-capitalize-keywords t] |
["Capitalize Keywords (buffer)" f90-capitalize-keywords t] |
474 |
["Capitalize Keywords (region)" |
["Capitalize Keywords (region)" |
475 |
f90-capitalize-region-keywords t] |
f90-capitalize-region-keywords t] |
476 |
["Downcase Keywords (buffer)" f90-downcase-keywords t] |
["Downcase Keywords (buffer)" f90-downcase-keywords t] |
477 |
["Downcase Keywords (region)" |
["Downcase Keywords (region)" |
478 |
f90-downcase-region-keywords t] |
f90-downcase-region-keywords t] |
479 |
"-----" |
"-----" |
480 |
["Toggle abbrev-mode" abbrev-mode t] |
["Toggle abbrev-mode" abbrev-mode t] |
484 |
|
|
485 |
(defvar f90-change-case-menu |
(defvar f90-change-case-menu |
486 |
(let ((map (make-sparse-keymap "Change Keyword Case"))) |
(let ((map (make-sparse-keymap "Change Keyword Case"))) |
|
|
|
487 |
(define-key map [dkr] (cons "Downcase Keywords (region)" |
(define-key map [dkr] (cons "Downcase Keywords (region)" |
488 |
'f90-downcase-region-keywords)) |
'f90-downcase-region-keywords)) |
489 |
(put 'f90-downcase-region-keywords 'menu-enable 'mark-active) |
(put 'f90-downcase-region-keywords 'menu-enable 'mark-active) |
|
|
|
490 |
(define-key map [ckr] (cons "Capitalize Keywords (region)" |
(define-key map [ckr] (cons "Capitalize Keywords (region)" |
491 |
'f90-capitalize-region-keywords)) |
'f90-capitalize-region-keywords)) |
492 |
(put 'f90-capitalize-region-keywords 'menu-enable 'mark-active) |
(put 'f90-capitalize-region-keywords 'menu-enable 'mark-active) |
|
|
|
493 |
(define-key map [ukr] (cons "Upcase Keywords (region)" |
(define-key map [ukr] (cons "Upcase Keywords (region)" |
494 |
'f90-upcase-region-keywords)) |
'f90-upcase-region-keywords)) |
495 |
(put 'f90-upcase-region-keywords 'menu-enable 'mark-active) |
(put 'f90-upcase-region-keywords 'menu-enable 'mark-active) |
|
|
|
496 |
(define-key map [line] (list "-----------------")) |
(define-key map [line] (list "-----------------")) |
|
|
|
497 |
(define-key map [dkb] (cons "Downcase Keywords (buffer)" |
(define-key map [dkb] (cons "Downcase Keywords (buffer)" |
498 |
'f90-downcase-keywords)) |
'f90-downcase-keywords)) |
|
|
|
499 |
(define-key map [ckb] (cons "Capitalize Keywords (buffer)" |
(define-key map [ckb] (cons "Capitalize Keywords (buffer)" |
500 |
'f90-capitalize-keywords)) |
'f90-capitalize-keywords)) |
|
|
|
501 |
(define-key map [ukb] (cons "Upcase Keywords (buffer)" |
(define-key map [ukb] (cons "Upcase Keywords (buffer)" |
502 |
'f90-upcase-keywords)) |
'f90-upcase-keywords)) |
503 |
map) |
map) |
509 |
(defalias 'f90-font-lock-off 'font-lock-mode) |
(defalias 'f90-font-lock-off 'font-lock-mode) |
510 |
(put 'f90-font-lock-on 'menu-enable 'font-lock-mode) |
(put 'f90-font-lock-on 'menu-enable 'font-lock-mode) |
511 |
(put 'f90-font-lock-off 'menu-enable '(not font-lock-mode)) |
(put 'f90-font-lock-off 'menu-enable '(not font-lock-mode)) |
512 |
|
|
513 |
(defun f90-font-lock-1 () |
(defun f90-font-lock-1 () |
514 |
(interactive) |
(interactive) |
515 |
"Set font-lock-keywords to f90-font-lock-keywords-1." |
"Set font-lock-keywords to f90-font-lock-keywords-1." |
516 |
(font-lock-mode 1) |
(font-lock-mode 1) |
517 |
(setq font-lock-keywords f90-font-lock-keywords-1) |
(setq font-lock-keywords f90-font-lock-keywords-1) |
518 |
(font-lock-fontify-buffer)) |
(font-lock-fontify-buffer)) |
519 |
|
|
520 |
(defun f90-font-lock-2 () |
(defun f90-font-lock-2 () |
521 |
(interactive) |
(interactive) |
522 |
"Set font-lock-keywords to f90-font-lock-keywords-2." |
"Set font-lock-keywords to f90-font-lock-keywords-2." |
523 |
(font-lock-mode 1) |
(font-lock-mode 1) |
524 |
(setq font-lock-keywords f90-font-lock-keywords-2) |
(setq font-lock-keywords f90-font-lock-keywords-2) |
525 |
(font-lock-fontify-buffer)) |
(font-lock-fontify-buffer)) |
526 |
|
|
527 |
(defun f90-font-lock-3 () |
(defun f90-font-lock-3 () |
528 |
(interactive) |
(interactive) |
529 |
"Set font-lock-keywords to f90-font-lock-keywords-3." |
"Set font-lock-keywords to f90-font-lock-keywords-3." |
530 |
(font-lock-mode 1) |
(font-lock-mode 1) |
531 |
(setq font-lock-keywords f90-font-lock-keywords-3) |
(setq font-lock-keywords f90-font-lock-keywords-3) |
532 |
(font-lock-fontify-buffer)) |
(font-lock-fontify-buffer)) |
533 |
|
|
534 |
(defun f90-font-lock-4 () |
(defun f90-font-lock-4 () |
535 |
(interactive) |
(interactive) |
536 |
"Set font-lock-keywords to f90-font-lock-keywords-4." |
"Set font-lock-keywords to f90-font-lock-keywords-4." |
537 |
(font-lock-mode 1) |
(font-lock-mode 1) |
538 |
(setq font-lock-keywords f90-font-lock-keywords-4) |
(setq font-lock-keywords f90-font-lock-keywords-4) |
539 |
(font-lock-fontify-buffer)) |
(font-lock-fontify-buffer)) |
540 |
|
|
541 |
(defvar f90-font-lock-menu |
(defvar f90-font-lock-menu |
542 |
(let ((map (make-sparse-keymap "f90-font-lock-menu"))) |
(let ((map (make-sparse-keymap "f90-font-lock-menu"))) |
543 |
(define-key map [h4] (cons "Maximum highlighting (level 4)" |
(define-key map [h4] (cons "Maximum highlighting (level 4)" |
558 |
(defalias 'f90-font-lock-menu f90-font-lock-menu) |
(defalias 'f90-font-lock-menu f90-font-lock-menu) |
559 |
|
|
560 |
(define-key f90-mode-map [menu-bar] (make-sparse-keymap)) |
(define-key f90-mode-map [menu-bar] (make-sparse-keymap)) |
561 |
(define-key f90-mode-map [menu-bar f90] |
(define-key f90-mode-map [menu-bar f90] |
562 |
(cons "F90" (make-sparse-keymap "f90"))) |
(cons "F90" (make-sparse-keymap "f90"))) |
|
|
|
563 |
(define-key f90-mode-map [menu-bar f90 f90-imenu-menu] |
(define-key f90-mode-map [menu-bar f90 f90-imenu-menu] |
564 |
'("Add imenu Menu" . f90-add-imenu-menu)) |
'("Add imenu Menu" . f90-add-imenu-menu)) |
565 |
(define-key f90-mode-map [menu-bar f90 abbrev-mode] |
(define-key f90-mode-map [menu-bar f90 abbrev-mode] |
574 |
(cons "Highlighting" 'f90-font-lock-menu)) |
(cons "Highlighting" 'f90-font-lock-menu)) |
575 |
(define-key f90-mode-map [menu-bar f90 line2] |
(define-key f90-mode-map [menu-bar f90 line2] |
576 |
'("----")) |
'("----")) |
|
|
|
577 |
(define-key f90-mode-map [menu-bar f90 f90-insert-end] |
(define-key f90-mode-map [menu-bar f90 f90-insert-end] |
578 |
'("Insert Block End" . f90-insert-end)) |
'("Insert Block End" . f90-insert-end)) |
579 |
(define-key f90-mode-map [menu-bar f90 f90-join-lines] |
(define-key f90-mode-map [menu-bar f90 f90-join-lines] |
580 |
'("Join with Next Line" . f90-join-lines)) |
'("Join with Next Line" . f90-join-lines)) |
581 |
(define-key f90-mode-map [menu-bar f90 f90-break-line] |
(define-key f90-mode-map [menu-bar f90 f90-break-line] |
582 |
'("Break Line at Point" . f90-break-line)) |
'("Break Line at Point" . f90-break-line)) |
|
|
|
583 |
(define-key f90-mode-map [menu-bar f90 line3] |
(define-key f90-mode-map [menu-bar f90 line3] |
584 |
'("----")) |
'("----")) |
|
|
|
585 |
(define-key f90-mode-map [menu-bar f90 f90-fill-region] |
(define-key f90-mode-map [menu-bar f90 f90-fill-region] |
586 |
'("Fill Region" . f90-fill-region)) |
'("Fill Region" . f90-fill-region)) |
587 |
(put 'f90-fill-region 'menu-enable 'mark-active) |
(put 'f90-fill-region 'menu-enable 'mark-active) |
|
|
|
588 |
(define-key f90-mode-map [menu-bar f90 indent-region] |
(define-key f90-mode-map [menu-bar f90 indent-region] |
589 |
'("Indent Region" . indent-region)) |
'("Indent Region" . indent-region)) |
|
|
|
590 |
(define-key f90-mode-map [menu-bar f90 f90-comment-region] |
(define-key f90-mode-map [menu-bar f90 f90-comment-region] |
591 |
'("(Un)Comment Region" . f90-comment-region)) |
'("(Un)Comment Region" . f90-comment-region)) |
592 |
(put 'f90-comment-region 'menu-enable 'mark-active) |
(put 'f90-comment-region 'menu-enable 'mark-active) |
|
|
|
593 |
(define-key f90-mode-map [menu-bar f90 line4] |
(define-key f90-mode-map [menu-bar f90 line4] |
594 |
'("----")) |
'("----")) |
|
|
|
595 |
(define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram] |
(define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram] |
596 |
'("End of Subprogram" . f90-end-of-subprogram)) |
'("End of Subprogram" . f90-end-of-subprogram)) |
597 |
(define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram] |
(define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram] |
603 |
) |
) |
604 |
|
|
605 |
;; Regexps for finding program structures. |
;; Regexps for finding program structures. |
606 |
(defconst f90-blocks-re |
(defconst f90-blocks-re |
607 |
"\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\ |
"\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\ |
608 |
program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>") |
program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>") |
609 |
(defconst f90-program-block-re |
(defconst f90-program-block-re |
610 |
"\\(program\\|module\\|subroutine\\|function\\)") |
"\\(program\\|module\\|subroutine\\|function\\)") |
611 |
(defconst f90-else-like-re |
(defconst f90-else-like-re |
612 |
"\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)") |
"\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)") |
613 |
(defconst f90-end-if-re |
(defconst f90-end-if-re |
614 |
"end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>") |
"end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>") |
615 |
(defconst f90-end-type-re |
(defconst f90-end-type-re |
616 |
"end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)") |
"end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)") |
617 |
(defconst f90-type-def-re |
(defconst f90-type-def-re |
618 |
"\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)") |
"\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)") |
634 |
'("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) |
'("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1) |
635 |
'("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1) |
'("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1) |
636 |
(list |
(list |
637 |
"Procedures" |
"Procedures" |
638 |
(concat |
(concat |
639 |
"^[ \t0-9]*" |
"^[ \t0-9]*" |
640 |
"\\(" |
"\\(" |
649 |
good-char "?" good-char "?" |
good-char "?" good-char "?" |
650 |
"\\)" |
"\\)" |
651 |
"[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)") |
"[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)") |
652 |
4))) |
4))) |
653 |
"Generic imenu expression for F90 mode.") |
"Generic imenu expression for F90 mode.") |
654 |
|
|
655 |
(defun f90-add-imenu-menu () |
(defun f90-add-imenu-menu () |
764 |
`f90-continuation-indent' |
`f90-continuation-indent' |
765 |
Extra indentation applied to continuation lines. (default 5) |
Extra indentation applied to continuation lines. (default 5) |
766 |
`f90-comment-region' |
`f90-comment-region' |
767 |
String inserted by \\[f90-comment-region] at start of each line in |
String inserted by \\[f90-comment-region] at start of each line in |
768 |
region. (default \"!!!$\") |
region. (default \"!!!$\") |
769 |
`f90-indented-comment-re' |
`f90-indented-comment-re' |
770 |
Regexp determining the type of comment to be intended like code. |
Regexp determining the type of comment to be intended like code. |
822 |
(when f90-xemacs-flag |
(when f90-xemacs-flag |
823 |
(put 'f90-mode 'font-lock-keywords-case-fold-search t) |
(put 'f90-mode 'font-lock-keywords-case-fold-search t) |
824 |
(when (and (featurep 'menubar) |
(when (and (featurep 'menubar) |
825 |
current-menubar |
current-menubar |
826 |
(not (assoc "F90" current-menubar))) |
(not (assoc "F90" current-menubar))) |
827 |
(set-buffer-menubar (copy-sequence current-menubar)) |
(set-buffer-menubar (copy-sequence current-menubar)) |
828 |
(add-submenu nil f90-xemacs-menu))) |
(add-submenu nil f90-xemacs-menu))) |
829 |
;; XEmacs: (Don't need a special case, since both emacsen work alike -sb) |
;; XEmacs: (Don't need a special case, since both emacsen work alike -sb) |
830 |
(make-local-variable 'font-lock-defaults) |
(make-local-variable 'font-lock-defaults) |
831 |
(setq font-lock-defaults |
(setq font-lock-defaults |
832 |
'((f90-font-lock-keywords f90-font-lock-keywords-1 |
'((f90-font-lock-keywords f90-font-lock-keywords-1 |
833 |
f90-font-lock-keywords-2 |
f90-font-lock-keywords-2 |
834 |
f90-font-lock-keywords-3 |
f90-font-lock-keywords-3 |
852 |
f90-cache-position |
f90-cache-position |
853 |
(point-min)))) |
(point-min)))) |
854 |
(nth 3 (parse-partial-sexp beg-pnt (point))))) |
(nth 3 (parse-partial-sexp beg-pnt (point))))) |
855 |
|
|
856 |
(defsubst f90-in-comment () |
(defsubst f90-in-comment () |
857 |
"Return non-nil if point is inside a comment. |
"Return non-nil if point is inside a comment. |
858 |
Checks from point-min, or f90-cache-position, if that is non-nil |
Checks from point-min, or f90-cache-position, if that is non-nil |
972 |
(defsubst f90-looking-at-type-like () |
(defsubst f90-looking-at-type-like () |
973 |
"Return (KIND NAME) if a type/interface/block-data block starts after point. |
"Return (KIND NAME) if a type/interface/block-data block starts after point. |
974 |
NAME is non-nil only for type." |
NAME is non-nil only for type." |
975 |
(cond |
(cond |
976 |
((looking-at f90-type-def-re) |
((looking-at f90-type-def-re) |
977 |
(list (match-string 1) (match-string 4))) |
(list (match-string 1) (match-string 4))) |
978 |
((looking-at "\\(interface\\|block[\t]*data\\)\\>") |
((looking-at "\\(interface\\|block[\t]*data\\)\\>") |
993 |
|
|
994 |
(defsubst f90-looking-at-program-block-end () |
(defsubst f90-looking-at-program-block-end () |
995 |
"Return (KIND NAME) if a block with name NAME ends after point." |
"Return (KIND NAME) if a block with name NAME ends after point." |
996 |
(if (looking-at (concat "end[ \t]*" f90-blocks-re |
(if (looking-at (concat "end[ \t]*" f90-blocks-re |
997 |
"?\\([ \t]+\\(\\sw+\\)\\)?\\>")) |
"?\\([ \t]+\\(\\sw+\\)\\)?\\>")) |
998 |
(list (match-string 1) (match-string 3)))) |
(list (match-string 1) (match-string 3)))) |
999 |
|
|
1103 |
(setq icol (- icol f90-do-indent)))) |
(setq icol (- icol f90-do-indent)))) |
1104 |
(end-of-line)) |
(end-of-line)) |
1105 |
icol))) |
icol))) |
1106 |
|
|
|
|
|
1107 |
(defun f90-calculate-indent () |
(defun f90-calculate-indent () |
1108 |
"Calculate the indent column based on previous statements." |
"Calculate the indent column based on previous statements." |
1109 |
(interactive) |
(interactive) |
1126 |
(cond ((or (f90-looking-at-if-then) |
(cond ((or (f90-looking-at-if-then) |
1127 |
(f90-looking-at-where-or-forall) |
(f90-looking-at-where-or-forall) |
1128 |
(f90-looking-at-select-case) |
(f90-looking-at-select-case) |
1129 |
(looking-at f90-else-like-re)) |
(looking-at f90-else-like-re)) |
1130 |
(setq icol (+ icol f90-if-indent))) |
(setq icol (+ icol f90-if-indent))) |
1131 |
((f90-looking-at-do) |
((f90-looking-at-do) |
1132 |
(setq icol (+ icol f90-do-indent))) |
(setq icol (+ icol f90-do-indent))) |
1184 |
(interactive) |
(interactive) |
1185 |
(let ((count 1) (case-fold-search t) matching-beg) |
(let ((count 1) (case-fold-search t) matching-beg) |
1186 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) (skip-chars-forward " \t0-9") |
1187 |
(if (setq matching-beg (f90-looking-at-program-block-start)) |
(if (setq matching-beg (f90-looking-at-program-block-start)) |
1188 |
(setq count (- count 1))) |
(setq count (- count 1))) |
1189 |
(while (and (not (zerop count)) |
(while (and (not (zerop count)) |
1190 |
(re-search-backward f90-program-block-re nil 'move)) |
(re-search-backward f90-program-block-re nil 'move)) |
1191 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) (skip-chars-forward " \t0-9") |
1192 |
(cond |
(cond |
1193 |
((setq matching-beg (f90-looking-at-program-block-start)) |
((setq matching-beg (f90-looking-at-program-block-start)) |
1194 |
(setq count (- count 1))) |
(setq count (- count 1))) |
1195 |
((f90-looking-at-program-block-end) |
((f90-looking-at-program-block-end) |
1284 |
(if (looking-at "!") |
(if (looking-at "!") |
1285 |
(setq indent (f90-comment-indent)) |
(setq indent (f90-comment-indent)) |
1286 |
(if (and (looking-at "end") f90-smart-end) |
(if (and (looking-at "end") f90-smart-end) |
1287 |
(f90-match-end)) |
(f90-match-end)) |
1288 |
(setq indent (f90-calculate-indent))) |
(setq indent (f90-calculate-indent))) |
1289 |
(if (zerop (- indent (current-column))) |
(if (zerop (- indent (current-column))) |
1290 |
nil |
nil |
1293 |
;; position after the indentation. Else stay at same point in text. |
;; position after the indentation. Else stay at same point in text. |
1294 |
(if (< (point) (marker-position pos)) |
(if (< (point) (marker-position pos)) |
1295 |
(goto-char (marker-position pos))) |
(goto-char (marker-position pos))) |
1296 |
(if auto-fill-function |
(if auto-fill-function |
1297 |
(f90-do-auto-fill) ; also updates line |
(f90-do-auto-fill) ; also updates line |
1298 |
(if (not no-update) (f90-update-line))) |
(if (not no-update) (f90-update-line))) |
1299 |
(set-marker pos nil))) |
(set-marker pos nil))) |
1360 |
(if struct (setq block-list (cons struct block-list))) |
(if struct (setq block-list (cons struct block-list))) |
1361 |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
1362 |
(< (point) end-region-mark)) |
(< (point) end-region-mark)) |
1363 |
(if (not (zerop (- (current-indentation) |
(if (not (zerop (- (current-indentation) |
1364 |
(+ ind-curr f90-continuation-indent)))) |
(+ ind-curr f90-continuation-indent)))) |
1365 |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))) |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))) |
1366 |
;; process all following lines |
;; process all following lines |
1392 |
((setq end-struct (f90-looking-at-program-block-end)) |
((setq end-struct (f90-looking-at-program-block-end)) |
1393 |
(setq beg-struct (car block-list) |
(setq beg-struct (car block-list) |
1394 |
block-list (cdr block-list)) |
block-list (cdr block-list)) |
1395 |
(if f90-smart-end |
(if f90-smart-end |
1396 |
(save-excursion |
(save-excursion |
1397 |
(f90-block-match (car beg-struct)(car (cdr beg-struct)) |
(f90-block-match (car beg-struct)(car (cdr beg-struct)) |
1398 |
(car end-struct)(car (cdr end-struct))))) |
(car end-struct)(car (cdr end-struct))))) |
1410 |
(f90-indent-to ind-curr)) |
(f90-indent-to ind-curr)) |
1411 |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
1412 |
(< (point) end-region-mark)) |
(< (point) end-region-mark)) |
1413 |
(if (not (zerop (- (current-indentation) |
(if (not (zerop (- (current-indentation) |
1414 |
(+ ind-curr f90-continuation-indent)))) |
(+ ind-curr f90-continuation-indent)))) |
1415 |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) |
1416 |
;; restore point etc |
;; restore point etc |
1457 |
(newline 1) |
(newline 1) |
1458 |
(if f90-beginning-ampersand (insert "&"))))) |
(if f90-beginning-ampersand (insert "&"))))) |
1459 |
(indent-according-to-mode)) |
(indent-according-to-mode)) |
1460 |
|
|
1461 |
(defun f90-find-breakpoint () |
(defun f90-find-breakpoint () |
1462 |
"From `fill-column', search backward for break-delimiter." |
"From `fill-column', search backward for break-delimiter." |
1463 |
(let ((bol (line-beginning-position))) |
(let ((bol (line-beginning-position))) |
1479 |
;; Will not break **, //, or => (specified by f90-no-break-re). |
;; Will not break **, //, or => (specified by f90-no-break-re). |
1480 |
(f90-update-line) |
(f90-update-line) |
1481 |
(while (> (current-column) fill-column) |
(while (> (current-column) fill-column) |
1482 |
(let ((pos-mark (point-marker))) |
(let ((pos-mark (point-marker))) |
1483 |
(move-to-column fill-column) |
(move-to-column fill-column) |
1484 |
(if (not (f90-in-string)) |
(if (not (f90-in-string)) |
1485 |
(f90-find-breakpoint)) |
(f90-find-breakpoint)) |
1486 |
(f90-break-line) |
(f90-break-line) |
1487 |
(goto-char pos-mark) |
(goto-char pos-mark) |
1488 |
(set-marker pos-mark nil)))) |
(set-marker pos-mark nil)))) |
1489 |
|
|
1490 |
|
|
1491 |
(defun f90-join-lines () |
(defun f90-join-lines () |
1546 |
(if end-block |
(if end-block |
1547 |
(progn |
(progn |
1548 |
(message "END %s does not match %s." end-block beg-block) |
(message "END %s does not match %s." end-block beg-block) |
1549 |
(end-of-line) |
(end-of-line) |
1550 |
(throw 'no-match nil)) |
(throw 'no-match nil)) |
1551 |
(message "Inserting %s." beg-block) |
(message "Inserting %s." beg-block) |
1552 |
(insert (concat " " beg-block))) |
(insert (concat " " beg-block))) |
1553 |
(search-forward end-block)) |
(search-forward end-block)) |
1554 |
(if (not (f90-equal-symbols beg-name end-name)) |
(if (not (f90-equal-symbols beg-name end-name)) |
1555 |
(cond ((and beg-name (not end-name)) |
(cond ((and beg-name (not end-name)) |
1556 |
(message "Inserting %s." beg-name) |
(message "Inserting %s." beg-name) |
1557 |
(insert (concat " " beg-name))) |
(insert (concat " " beg-name))) |
1558 |
((and beg-name end-name) |
((and beg-name end-name) |
1559 |
(message "Replacing %s with %s." end-name beg-name) |
(message "Replacing %s with %s." end-name beg-name) |
1560 |
(search-forward end-name) |
(search-forward end-name) |
1561 |
(replace-match beg-name)) |
(replace-match beg-name)) |
1562 |
((and (not beg-name) end-name) |
((and (not beg-name) end-name) |
1563 |
(message "Deleting %s." end-name) |
(message "Deleting %s." end-name) |
1564 |
(search-forward end-name) |
(search-forward end-name) |
1565 |
(replace-match ""))) |
(replace-match ""))) |
1578 |
(setq end-name (car (cdr end-struct))) |
(setq end-name (car (cdr end-struct))) |
1579 |
(save-excursion |
(save-excursion |
1580 |
(beginning-of-line) |
(beginning-of-line) |
1581 |
(while |
(while |
1582 |
(and (not (zerop count)) |
(and (not (zerop count)) |
1583 |
(let ((stop nil) notexist) |
(let ((stop nil) notexist) |
1584 |
(while (not stop) |
(while (not stop) |
1585 |
(setq notexist |
(setq notexist |
1586 |
(not (re-search-backward |
(not (re-search-backward |
1587 |
(concat "\\(" f90-blocks-re "\\)") nil t))) |
(concat "\\(" f90-blocks-re "\\)") nil t))) |
1588 |
(if notexist |
(if notexist |
1589 |
(setq stop t) |
(setq stop t) |
1630 |
;; abbrevs and keywords |
;; abbrevs and keywords |
1631 |
|
|
1632 |
(defun f90-abbrev-start () |
(defun f90-abbrev-start () |
1633 |
"Typing `\\[help-command] or `? lists all the F90 abbrevs. |
"Typing `\\[help-command] or `? lists all the F90 abbrevs. |
1634 |
Any other key combination is executed normally." |
Any other key combination is executed normally." |
1635 |
(interactive) |
(interactive) |
1636 |
(let (e c) |
(let (e c) |
1698 |
(save-excursion |
(save-excursion |
1699 |
(setq beg (if beg beg (point-min))) |
(setq beg (if beg beg (point-min))) |
1700 |
(setq end (if end end (point-max))) |
(setq end (if end end (point-max))) |
1701 |
(let ((keyword-re |
(let ((keyword-re |
1702 |
(concat "\\(" |
(concat "\\(" |
1703 |
f90-keywords-re "\\|" f90-procedures-re "\\|" |
f90-keywords-re "\\|" f90-procedures-re "\\|" |
1704 |
f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) |
f90-hpf-keywords-re "\\|" f90-operators-re "\\)")) |