243 |
:group 'f90) |
:group 'f90) |
244 |
|
|
245 |
(defconst f90-xemacs-flag (string-match "XEmacs\\|Lucid" emacs-version) |
(defconst f90-xemacs-flag (string-match "XEmacs\\|Lucid" emacs-version) |
246 |
"Non-nil means f90-mode thinks it is running under XEmacs.") |
"Non-nil means F90 mode thinks it is running under XEmacs.") |
247 |
|
|
248 |
(defconst f90-keywords-re |
(defconst f90-keywords-re |
249 |
(regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" |
(regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace" |
312 |
|
|
313 |
(defconst f90-hpf-keywords-re |
(defconst f90-hpf-keywords-re |
314 |
(regexp-opt |
(regexp-opt |
315 |
;; Intrinsic procedures |
;; Intrinsic procedures. |
316 |
'("all_prefix" "all_scatter" "all_suffix" "any_prefix" |
'("all_prefix" "all_scatter" "all_suffix" "any_prefix" |
317 |
"any_scatter" "any_suffix" "copy_prefix" "copy_scatter" |
"any_scatter" "any_suffix" "copy_prefix" "copy_scatter" |
318 |
"copy_suffix" "count_prefix" "count_scatter" "count_suffix" |
"copy_suffix" "count_prefix" "count_scatter" "count_suffix" |
326 |
"parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar" |
"parity_prefix" "parity_scatter" "parity_suffix" "popcnt" "poppar" |
327 |
"processors_shape" "product_prefix" "product_scatter" |
"processors_shape" "product_prefix" "product_scatter" |
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.") |
335 |
|
|
336 |
;; Highlighting patterns |
;; Highlighting patterns. |
337 |
|
|
338 |
(defvar f90-font-lock-keywords-1 |
(defvar f90-font-lock-keywords-1 |
339 |
(list |
(list |
340 |
;; Special highlighting of "module procedure foo-list" |
;; Special highlighting of "module procedure". |
341 |
'("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face)) |
'("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face)) |
342 |
;; Highlight definition of new type |
;; Highlight declaration of derived type. |
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. |
353 |
(append |
(append |
354 |
f90-font-lock-keywords-1 |
f90-font-lock-keywords-1 |
355 |
(list |
(list |
356 |
;; Variable declarations (avoid the real function call) |
;; Variable declarations (avoid the real function call). |
357 |
'("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ |
'("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|\ |
358 |
logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)" |
logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)" |
359 |
(1 font-lock-type-face t) (4 font-lock-variable-name-face)) |
(1 font-lock-type-face t) (4 font-lock-variable-name-face)) |
360 |
;; do, if, select, where, and forall constructs |
;; do, if, select, where, and forall constructs. |
361 |
'("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\ |
'("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\ |
362 |
\\([ \t]+\\(\\sw+\\)\\)?" |
\\([ \t]+\\(\\sw+\\)\\)?" |
363 |
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) |
(1 font-lock-keyword-face) (3 font-lock-constant-face nil t)) |
364 |
'("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ |
'("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|\ |
365 |
do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" |
do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>" |
366 |
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) |
(2 font-lock-constant-face nil t) (3 font-lock-keyword-face)) |
367 |
;; implicit declaration |
;; Implicit declaration. |
368 |
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ |
'("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\ |
369 |
\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" |
\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" |
370 |
(1 font-lock-keyword-face) (2 font-lock-type-face)) |
(1 font-lock-keyword-face) (2 font-lock-type-face)) |
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 |
|
|
400 |
f90-font-lock-keywords-2 |
f90-font-lock-keywords-2 |
401 |
"*Default expressions to highlight in F90 mode.") |
"*Default expressions to highlight in F90 mode.") |
402 |
|
|
403 |
;; syntax table |
|
404 |
(defvar f90-mode-syntax-table nil |
(defvar f90-mode-syntax-table nil |
405 |
"Syntax table in use in F90 mode buffers.") |
"Syntax table in use in F90 mode buffers.") |
406 |
|
|
407 |
(unless f90-mode-syntax-table |
(unless f90-mode-syntax-table |
408 |
(setq f90-mode-syntax-table (make-syntax-table)) |
(setq f90-mode-syntax-table (make-syntax-table)) |
409 |
(modify-syntax-entry ?\! "<" f90-mode-syntax-table) ; beg. comment |
(modify-syntax-entry ?\! "<" f90-mode-syntax-table) ; begin comment |
410 |
(modify-syntax-entry ?\n ">" f90-mode-syntax-table) ; end comment |
(modify-syntax-entry ?\n ">" f90-mode-syntax-table) ; end comment |
411 |
(modify-syntax-entry ?_ "w" f90-mode-syntax-table) ; underscore in names |
(modify-syntax-entry ?_ "w" f90-mode-syntax-table) ; underscore in names |
412 |
(modify-syntax-entry ?\' "\"" f90-mode-syntax-table) ; string quote |
(modify-syntax-entry ?\' "\"" f90-mode-syntax-table) ; string quote |
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) ; punctuation |
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) |
420 |
(modify-syntax-entry ?/ "." f90-mode-syntax-table) |
(modify-syntax-entry ?/ "." f90-mode-syntax-table) |
421 |
(modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)) ; escape chars |
(modify-syntax-entry ?\\ "\\" f90-mode-syntax-table)) ; escape chars |
422 |
|
|
423 |
;; keys |
|
424 |
(defvar f90-mode-map () |
(defvar f90-mode-map () |
425 |
"Keymap used in F90 mode.") |
"Keymap used in F90 mode.") |
426 |
|
|
435 |
(define-key f90-mode-map "\C-j" 'f90-indent-new-line) ; LFD equals C-j |
(define-key f90-mode-map "\C-j" 'f90-indent-new-line) ; LFD equals C-j |
436 |
(define-key f90-mode-map "\r" 'newline) |
(define-key f90-mode-map "\r" 'newline) |
437 |
(define-key f90-mode-map "\C-c\r" 'f90-break-line) |
(define-key f90-mode-map "\C-c\r" 'f90-break-line) |
438 |
;; (define-key f90-mode-map [M-return] 'f90-break-line) |
;;; (define-key f90-mode-map [M-return] 'f90-break-line) |
439 |
(define-key f90-mode-map "\C-c\C-d" 'f90-join-lines) |
(define-key f90-mode-map "\C-c\C-d" 'f90-join-lines) |
440 |
(define-key f90-mode-map "\C-c\C-f" 'f90-fill-region) |
(define-key f90-mode-map "\C-c\C-f" 'f90-fill-region) |
441 |
(define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement) |
(define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement) |
449 |
(define-key f90-mode-map "/" 'f90-electric-insert)) |
(define-key f90-mode-map "/" 'f90-electric-insert)) |
450 |
|
|
451 |
|
|
|
;; menus |
|
452 |
(if f90-xemacs-flag |
(if f90-xemacs-flag |
453 |
(defvar f90-xemacs-menu |
(defvar f90-xemacs-menu |
454 |
'("F90" |
'("F90" |
467 |
["Insert Block End" f90-insert-end t] |
["Insert Block End" f90-insert-end t] |
468 |
"-----" |
"-----" |
469 |
["Upcase Keywords (buffer)" f90-upcase-keywords t] |
["Upcase Keywords (buffer)" f90-upcase-keywords t] |
470 |
["Upcase Keywords (region)" f90-upcase-region-keywords |
["Upcase Keywords (region)" f90-upcase-region-keywords t] |
|
t] |
|
471 |
["Capitalize Keywords (buffer)" f90-capitalize-keywords t] |
["Capitalize Keywords (buffer)" f90-capitalize-keywords t] |
472 |
["Capitalize Keywords (region)" |
["Capitalize Keywords (region)" f90-capitalize-region-keywords t] |
|
f90-capitalize-region-keywords t] |
|
473 |
["Downcase Keywords (buffer)" f90-downcase-keywords t] |
["Downcase Keywords (buffer)" f90-downcase-keywords t] |
474 |
["Downcase Keywords (region)" |
["Downcase Keywords (region)" f90-downcase-region-keywords t] |
|
f90-downcase-region-keywords t] |
|
475 |
"-----" |
"-----" |
476 |
["Toggle abbrev-mode" abbrev-mode t] |
["Toggle abbrev-mode" abbrev-mode t] |
477 |
["Toggle auto-fill" auto-fill-mode t]) |
["Toggle auto-fill" auto-fill-mode t]) |
478 |
"XEmacs menu for F90 mode.") |
"XEmacs menu for F90 mode.") |
|
;; Emacs |
|
479 |
|
|
480 |
|
;; Emacs. |
481 |
(defvar f90-change-case-menu |
(defvar f90-change-case-menu |
482 |
(let ((map (make-sparse-keymap "Change Keyword Case"))) |
(let ((map (make-sparse-keymap "Change Keyword Case"))) |
483 |
(define-key map [dkr] (cons "Downcase Keywords (region)" |
(define-key map [dkr] |
484 |
'f90-downcase-region-keywords)) |
(cons "Downcase Keywords (region)" 'f90-downcase-region-keywords)) |
485 |
(put 'f90-downcase-region-keywords 'menu-enable 'mark-active) |
(put 'f90-downcase-region-keywords 'menu-enable 'mark-active) |
486 |
(define-key map [ckr] (cons "Capitalize Keywords (region)" |
(define-key map [ckr] |
487 |
'f90-capitalize-region-keywords)) |
(cons "Capitalize Keywords (region)" 'f90-capitalize-region-keywords)) |
488 |
(put 'f90-capitalize-region-keywords 'menu-enable 'mark-active) |
(put 'f90-capitalize-region-keywords 'menu-enable 'mark-active) |
489 |
(define-key map [ukr] (cons "Upcase Keywords (region)" |
(define-key map [ukr] |
490 |
'f90-upcase-region-keywords)) |
(cons "Upcase Keywords (region)" 'f90-upcase-region-keywords)) |
491 |
(put 'f90-upcase-region-keywords 'menu-enable 'mark-active) |
(put 'f90-upcase-region-keywords 'menu-enable 'mark-active) |
492 |
(define-key map [line] (list "-----------------")) |
(define-key map [line] (list "-----------------")) |
493 |
(define-key map [dkb] (cons "Downcase Keywords (buffer)" |
(define-key map [dkb] |
494 |
'f90-downcase-keywords)) |
(cons "Downcase Keywords (buffer)" 'f90-downcase-keywords)) |
495 |
(define-key map [ckb] (cons "Capitalize Keywords (buffer)" |
(define-key map [ckb] |
496 |
'f90-capitalize-keywords)) |
(cons "Capitalize Keywords (buffer)" 'f90-capitalize-keywords)) |
497 |
(define-key map [ukb] (cons "Upcase Keywords (buffer)" |
(define-key map [ukb] |
498 |
'f90-upcase-keywords)) |
(cons "Upcase Keywords (buffer)" 'f90-upcase-keywords)) |
499 |
map) |
map) |
500 |
"Submenu for change of case.") |
"Submenu for change of case.") |
501 |
(defalias 'f90-change-case-menu f90-change-case-menu) |
(defalias 'f90-change-case-menu f90-change-case-menu) |
502 |
|
|
503 |
;; font-lock-menu and function calls |
;; Font-lock-menu and function calls. |
504 |
(defalias 'f90-font-lock-on 'font-lock-mode) |
(defalias 'f90-font-lock-on 'font-lock-mode) |
505 |
(defalias 'f90-font-lock-off 'font-lock-mode) |
(defalias 'f90-font-lock-off 'font-lock-mode) |
506 |
(put 'f90-font-lock-on 'menu-enable 'font-lock-mode) |
(put 'f90-font-lock-on 'menu-enable 'font-lock-mode) |
536 |
|
|
537 |
(defvar f90-font-lock-menu |
(defvar f90-font-lock-menu |
538 |
(let ((map (make-sparse-keymap "f90-font-lock-menu"))) |
(let ((map (make-sparse-keymap "f90-font-lock-menu"))) |
539 |
(define-key map [h4] (cons "Maximum highlighting (level 4)" |
(define-key map [h4] |
540 |
'f90-font-lock-4)) |
(cons "Maximum highlighting (level 4)" 'f90-font-lock-4)) |
541 |
(define-key map [h3] (cons "Heavy highlighting (level 3)" |
(define-key map [h3] |
542 |
'f90-font-lock-3)) |
(cons "Heavy highlighting (level 3)" 'f90-font-lock-3)) |
543 |
(define-key map [h2] (cons "Default highlighting (level 2)" |
(define-key map [h2] |
544 |
'f90-font-lock-2)) |
(cons "Default highlighting (level 2)" 'f90-font-lock-2)) |
545 |
(define-key map [h1] (cons "Light highlighting (level 1)" |
(define-key map [h1] |
546 |
'f90-font-lock-1)) |
(cons "Light highlighting (level 1)" 'f90-font-lock-1)) |
547 |
(define-key map [line] (list "-----------------")) |
(define-key map [line] (list "-----------------")) |
548 |
(define-key map [floff] (cons "Turn off font-lock-mode" |
(define-key map [floff] |
549 |
'f90-font-lock-on)) |
(cons "Turn off font-lock-mode" 'f90-font-lock-on)) |
550 |
(define-key map [flon] (cons "Turn on font-lock-mode" |
(define-key map [flon] |
551 |
'f90-font-lock-off)) |
(cons "Turn on font-lock-mode" 'f90-font-lock-off)) |
552 |
map) |
map) |
553 |
"Submenu for highlighting using font-lock-mode.") |
"Submenu for highlighting using font-lock-mode.") |
554 |
|
|
555 |
(defalias 'f90-font-lock-menu f90-font-lock-menu) |
(defalias 'f90-font-lock-menu f90-font-lock-menu) |
556 |
|
|
557 |
(define-key f90-mode-map [menu-bar] (make-sparse-keymap)) |
(define-key f90-mode-map [menu-bar] (make-sparse-keymap)) |
563 |
'("Toggle abbrev-mode" . abbrev-mode)) |
'("Toggle abbrev-mode" . abbrev-mode)) |
564 |
(define-key f90-mode-map [menu-bar f90 auto-fill-mode] |
(define-key f90-mode-map [menu-bar f90 auto-fill-mode] |
565 |
'("Toggle auto-fill" . auto-fill-mode)) |
'("Toggle auto-fill" . auto-fill-mode)) |
566 |
(define-key f90-mode-map [menu-bar f90 line1] |
(define-key f90-mode-map [menu-bar f90 line1] '("----")) |
|
'("----")) |
|
567 |
(define-key f90-mode-map [menu-bar f90 f90-change-case-menu] |
(define-key f90-mode-map [menu-bar f90 f90-change-case-menu] |
568 |
(cons "Change Keyword Case" 'f90-change-case-menu)) |
(cons "Change Keyword Case" 'f90-change-case-menu)) |
569 |
(define-key f90-mode-map [menu-bar f90 f90-font-lock-menu] |
(define-key f90-mode-map [menu-bar f90 f90-font-lock-menu] |
570 |
(cons "Highlighting" 'f90-font-lock-menu)) |
(cons "Highlighting" 'f90-font-lock-menu)) |
571 |
(define-key f90-mode-map [menu-bar f90 line2] |
(define-key f90-mode-map [menu-bar f90 line2] '("----")) |
|
'("----")) |
|
572 |
(define-key f90-mode-map [menu-bar f90 f90-insert-end] |
(define-key f90-mode-map [menu-bar f90 f90-insert-end] |
573 |
'("Insert Block End" . f90-insert-end)) |
'("Insert Block End" . f90-insert-end)) |
574 |
(define-key f90-mode-map [menu-bar f90 f90-join-lines] |
(define-key f90-mode-map [menu-bar f90 f90-join-lines] |
575 |
'("Join with Next Line" . f90-join-lines)) |
'("Join with Next Line" . f90-join-lines)) |
576 |
(define-key f90-mode-map [menu-bar f90 f90-break-line] |
(define-key f90-mode-map [menu-bar f90 f90-break-line] |
577 |
'("Break Line at Point" . f90-break-line)) |
'("Break Line at Point" . f90-break-line)) |
578 |
(define-key f90-mode-map [menu-bar f90 line3] |
(define-key f90-mode-map [menu-bar f90 line3] '("----")) |
|
'("----")) |
|
579 |
(define-key f90-mode-map [menu-bar f90 f90-fill-region] |
(define-key f90-mode-map [menu-bar f90 f90-fill-region] |
580 |
'("Fill Region" . f90-fill-region)) |
'("Fill Region" . f90-fill-region)) |
581 |
(put 'f90-fill-region 'menu-enable 'mark-active) |
(put 'f90-fill-region 'menu-enable 'mark-active) |
584 |
(define-key f90-mode-map [menu-bar f90 f90-comment-region] |
(define-key f90-mode-map [menu-bar f90 f90-comment-region] |
585 |
'("(Un)Comment Region" . f90-comment-region)) |
'("(Un)Comment Region" . f90-comment-region)) |
586 |
(put 'f90-comment-region 'menu-enable 'mark-active) |
(put 'f90-comment-region 'menu-enable 'mark-active) |
587 |
(define-key f90-mode-map [menu-bar f90 line4] |
(define-key f90-mode-map [menu-bar f90 line4] '("----")) |
|
'("----")) |
|
588 |
(define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram] |
(define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram] |
589 |
'("End of Subprogram" . f90-end-of-subprogram)) |
'("End of Subprogram" . f90-end-of-subprogram)) |
590 |
(define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram] |
(define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram] |
597 |
|
|
598 |
;; Regexps for finding program structures. |
;; Regexps for finding program structures. |
599 |
(defconst f90-blocks-re |
(defconst f90-blocks-re |
600 |
"\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\ |
(concat "\\(block[ \t]*data\\|" |
601 |
program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>") |
(regexp-opt '("do" "if" "interface" "function" "module" "program" |
602 |
|
"select" "subroutine" "type" "where" "forall")) |
603 |
|
"\\)\\>") |
604 |
|
"Regexp potentially indicating a \"block\" of F90 code.") |
605 |
|
|
606 |
(defconst f90-program-block-re |
(defconst f90-program-block-re |
607 |
"\\(program\\|module\\|subroutine\\|function\\)") |
(regexp-opt '("program" "module" "subroutine" "function") 'paren) |
608 |
|
"Regexp used to locate the start/end of a \"subprogram\".") |
609 |
|
|
610 |
(defconst f90-else-like-re |
(defconst f90-else-like-re |
611 |
"\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)") |
"\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)" |
612 |
|
"Regexp matching an ELSE IF, ELSEWHERE, CASE statement.") |
613 |
|
|
614 |
(defconst f90-end-if-re |
(defconst f90-end-if-re |
615 |
"end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>") |
(concat "end[ \t]*" |
616 |
|
(regexp-opt '("if" "select" "where" "forall") 'paren) |
617 |
|
"\\>") |
618 |
|
"Regexp matching the end of an IF, SELECT, WHERE, FORALL block.") |
619 |
|
|
620 |
(defconst f90-end-type-re |
(defconst f90-end-type-re |
621 |
"end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)") |
"end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)\\>" |
622 |
|
"Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.") |
623 |
|
|
624 |
(defconst f90-type-def-re |
(defconst f90-type-def-re |
625 |
"\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)") |
"\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)" |
626 |
(defconst f90-no-break-re "\\(\\*\\*\\|//\\|=>\\)") |
"Regexp matching the declaration of a variable of derived type.") |
627 |
;; A temporary position to make region operators faster |
|
628 |
(defvar f90-cache-position nil) |
(defconst f90-no-break-re |
629 |
|
(regexp-opt '("**" "//" "=>") 'paren) |
630 |
|
"Regexp specifying where not to break lines when filling.") |
631 |
|
|
632 |
|
(defvar f90-cache-position nil |
633 |
|
"Temporary position used to speed up region operations.") |
634 |
(make-variable-buffer-local 'f90-cache-position) |
(make-variable-buffer-local 'f90-cache-position) |
635 |
;; A flag to tell whether f90-imenu is turned on. |
|
636 |
(defvar f90-imenu nil) |
(defvar f90-imenu-flag nil |
637 |
(make-variable-buffer-local 'f90-imenu) |
"Non-nil means this buffer already has an imenu.") |
638 |
|
(make-variable-buffer-local 'f90-imenu-flag) |
639 |
|
|
640 |
|
|
641 |
;; Imenu support |
;; Imenu support. |
642 |
(defvar f90-imenu-generic-expression |
(defvar f90-imenu-generic-expression |
643 |
(let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]") |
(let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]") |
644 |
(not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")) |
(not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]")) |
651 |
(concat |
(concat |
652 |
"^[ \t0-9]*" |
"^[ \t0-9]*" |
653 |
"\\(" |
"\\(" |
654 |
;; At least three non-space characters before function/subroutine |
;; At least three non-space characters before function/subroutine. |
655 |
;; Check that the last three non-space characters don't spell E N D |
;; Check that the last three non-space characters do not spell E N D. |
656 |
"[^!\"\&\n]*\\(" |
"[^!\"\&\n]*\\(" |
657 |
not-e good-char good-char "\\|" |
not-e good-char good-char "\\|" |
658 |
good-char not-n good-char "\\|" |
good-char not-n good-char "\\|" |
659 |
good-char good-char not-d "\\)" |
good-char good-char not-d "\\)" |
660 |
"\\|" |
"\\|" |
661 |
;; Less than three non-space characters before function/subroutine |
;; Less than three non-space characters before function/subroutine. |
662 |
good-char "?" good-char "?" |
good-char "?" good-char "?" |
663 |
"\\)" |
"\\)" |
664 |
"[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)") |
"[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)") |
668 |
(defun f90-add-imenu-menu () |
(defun f90-add-imenu-menu () |
669 |
"Add an imenu menu to the menubar." |
"Add an imenu menu to the menubar." |
670 |
(interactive) |
(interactive) |
671 |
(if f90-imenu |
(if f90-imenu-flag |
672 |
(message "%s" "F90-imenu already exists.") |
(message "%s" "F90-imenu already exists.") |
673 |
(imenu-add-to-menubar "F90-imenu") |
(imenu-add-to-menubar "F90-imenu") |
674 |
(redraw-frame (selected-frame)) |
(redraw-frame (selected-frame)) |
675 |
(setq f90-imenu t))) |
(setq f90-imenu-flag t))) |
676 |
|
|
677 |
(put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu)) |
(put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu-flag)) |
678 |
|
|
679 |
|
|
680 |
;; When compiling under GNU Emacs, load imenu during compilation. If |
;; When compiling under GNU Emacs, load imenu during compilation. |
681 |
;; you have 19.22 or earlier, comment this out, or get imenu. |
;; If you have 19.22 or earlier, comment this out, or get imenu. |
682 |
(or f90-xemacs-flag (eval-when-compile (require 'imenu))) |
(or f90-xemacs-flag (eval-when-compile (require 'imenu))) |
683 |
|
|
684 |
|
|
685 |
;; abbrevs have generally two letters, except standard types `c, `i, `r, `t |
;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t. |
686 |
(defvar f90-mode-abbrev-table nil) |
(defvar f90-mode-abbrev-table nil) |
687 |
(unless f90-mode-abbrev-table |
(unless f90-mode-abbrev-table |
688 |
(let ((ac abbrevs-changed)) |
(let ((ac abbrevs-changed)) |
743 |
(setq abbrevs-changed ac))) |
(setq abbrevs-changed ac))) |
744 |
|
|
745 |
(defcustom f90-mode-hook nil |
(defcustom f90-mode-hook nil |
746 |
"Hook run by F90 mode." |
"Hook run when entering F90 mode." |
747 |
:type 'hook |
:type 'hook |
748 |
:options '(f90-add-imenu-menu) |
:options '(f90-add-imenu-menu) |
749 |
:group 'f90) |
:group 'f90) |
752 |
(defun f90-mode () |
(defun f90-mode () |
753 |
"Major mode for editing Fortran 90,95 code in free format. |
"Major mode for editing Fortran 90,95 code in free format. |
754 |
|
|
755 |
\\[f90-indent-new-line] corrects current indentation and creates new\ |
\\[f90-indent-new-line] indents current line and creates a new\ |
756 |
indented line. |
indented line. |
757 |
\\[f90-indent-line] indents the current line correctly. |
\\[f90-indent-line] indents the current line. |
758 |
\\[f90-indent-subprogram] indents the current subprogram. |
\\[f90-indent-subprogram] indents the current subprogram. |
759 |
|
|
760 |
Type `? or `\\[help-command] to display a list of built-in\ |
Type `? or `\\[help-command] to display a list of built-in\ |
765 |
|
|
766 |
Variables controlling indentation style and extra features: |
Variables controlling indentation style and extra features: |
767 |
|
|
768 |
`f90-do-indent' |
`f90-do-indent' |
769 |
Extra indentation within do blocks. (default 3) |
Extra indentation within do blocks (default 3). |
770 |
`f90-if-indent' |
`f90-if-indent' |
771 |
Extra indentation within if/select case/where/forall blocks. (default 3) |
Extra indentation within if/select case/where/forall blocks (default 3). |
772 |
`f90-type-indent' |
`f90-type-indent' |
773 |
Extra indentation within type/interface/block-data blocks. (default 3) |
Extra indentation within type/interface/block-data blocks (default 3). |
774 |
`f90-program-indent' |
`f90-program-indent' |
775 |
Extra indentation within program/module/subroutine/function blocks. |
Extra indentation within program/module/subroutine/function blocks |
776 |
(default 2) |
(default 2). |
777 |
`f90-continuation-indent' |
`f90-continuation-indent' |
778 |
Extra indentation applied to continuation lines. (default 5) |
Extra indentation applied to continuation lines (default 5). |
779 |
`f90-comment-region' |
`f90-comment-region' |
780 |
String inserted by \\[f90-comment-region] at start of each line in |
String inserted by \\[f90-comment-region] at start of each line in |
781 |
region. (default \"!!!$\") |
region (default \"!!!$\"). |
782 |
`f90-indented-comment-re' |
`f90-indented-comment-re' |
783 |
Regexp determining the type of comment to be intended like code. |
Regexp determining the type of comment to be intended like code |
784 |
(default \"!\") |
(default \"!\"). |
785 |
`f90-directive-comment-re' |
`f90-directive-comment-re' |
786 |
Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented. |
Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented |
787 |
(default \"!hpf\\\\$\") |
(default \"!hpf\\\\$\"). |
788 |
`f90-break-delimiters' |
`f90-break-delimiters' |
789 |
Regexp holding list of delimiters at which lines may be broken. |
Regexp holding list of delimiters at which lines may be broken |
790 |
(default \"[-+*/><=,% \\t]\") |
(default \"[-+*/><=,% \\t]\"). |
791 |
`f90-break-before-delimiters' |
`f90-break-before-delimiters' |
792 |
Non-nil causes `f90-do-auto-fill' to break lines before delimiters. |
Non-nil causes `f90-do-auto-fill' to break lines before delimiters |
793 |
(default t) |
(default t). |
794 |
`f90-beginning-ampersand' |
`f90-beginning-ampersand' |
795 |
Automatic insertion of \& at beginning of continuation lines. (default t) |
Automatic insertion of \& at beginning of continuation lines (default t). |
796 |
`f90-smart-end' |
`f90-smart-end' |
797 |
From an END statement, check and fill the end using matching block start. |
From an END statement, check and fill the end using matching block start. |
798 |
Allowed values are 'blink, 'no-blink, and nil, which determine |
Allowed values are 'blink, 'no-blink, and nil, which determine |
799 |
whether to blink the matching beginning. (default 'blink) |
whether to blink the matching beginning (default 'blink). |
800 |
`f90-auto-keyword-case' |
`f90-auto-keyword-case' |
801 |
Automatic change of case of keywords. (default nil) |
Automatic change of case of keywords (default nil). |
802 |
The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. |
The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word. |
803 |
`f90-leave-line-no' |
`f90-leave-line-no' |
804 |
Do not left-justify line numbers. (default nil) |
Do not left-justify line numbers (default nil). |
805 |
`f90-keywords-re' |
`f90-keywords-re' |
806 |
List of keywords used for highlighting/upcase-keywords etc. |
List of keywords used for highlighting/upcase-keywords etc. |
807 |
|
|
808 |
Turning on F90 mode calls the value of the variable `f90-mode-hook' |
Turning on F90 mode calls the value of the variable `f90-mode-hook' |
809 |
with no args, if that value is non-nil." |
with no args, if that value is non-nil." |
831 |
(make-local-variable 'normal-auto-fill-function) |
(make-local-variable 'normal-auto-fill-function) |
832 |
(setq normal-auto-fill-function 'f90-do-auto-fill) |
(setq normal-auto-fill-function 'f90-do-auto-fill) |
833 |
(setq indent-tabs-mode nil) |
(setq indent-tabs-mode nil) |
834 |
;; Setting up things for font-lock |
;; Setting up things for font-lock. |
835 |
(when f90-xemacs-flag |
(when f90-xemacs-flag |
836 |
(put 'f90-mode 'font-lock-keywords-case-fold-search t) |
(put 'f90-mode 'font-lock-keywords-case-fold-search t) |
837 |
(when (and (featurep 'menubar) |
(when (and (featurep 'menubar) |
839 |
(not (assoc "F90" current-menubar))) |
(not (assoc "F90" current-menubar))) |
840 |
(set-buffer-menubar (copy-sequence current-menubar)) |
(set-buffer-menubar (copy-sequence current-menubar)) |
841 |
(add-submenu nil f90-xemacs-menu))) |
(add-submenu nil f90-xemacs-menu))) |
842 |
;; XEmacs: (Don't need a special case, since both emacsen work alike -sb) |
;; XEmacs: Does not need a special case, since both emacsen work alike -sb. |
843 |
(make-local-variable 'font-lock-defaults) |
(make-local-variable 'font-lock-defaults) |
844 |
(setq font-lock-defaults |
(setq font-lock-defaults |
845 |
'((f90-font-lock-keywords f90-font-lock-keywords-1 |
'((f90-font-lock-keywords f90-font-lock-keywords-1 |
854 |
(set (make-local-variable 'add-log-current-defun-function) |
(set (make-local-variable 'add-log-current-defun-function) |
855 |
#'f90-current-defun) |
#'f90-current-defun) |
856 |
(run-hooks 'f90-mode-hook)) |
(run-hooks 'f90-mode-hook)) |
857 |
|
|
858 |
|
|
859 |
;; inline-functions |
;; Inline-functions. |
860 |
(defsubst f90-in-string () |
(defsubst f90-in-string () |
861 |
"Return non-nil if point is inside a string. |
"Return non-nil if point is inside a string. |
862 |
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 |
863 |
and lies before point." |
and lies before point." |
864 |
(let ((beg-pnt |
(let ((beg-pnt |
865 |
(if (and f90-cache-position (> (point) f90-cache-position)) |
(if (and f90-cache-position (> (point) f90-cache-position)) |
869 |
|
|
870 |
(defsubst f90-in-comment () |
(defsubst f90-in-comment () |
871 |
"Return non-nil if point is inside a comment. |
"Return non-nil if point is inside a comment. |
872 |
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 |
873 |
and lies before point." |
and lies before point." |
874 |
(let ((beg-pnt |
(let ((beg-pnt |
875 |
(if (and f90-cache-position (> (point) f90-cache-position)) |
(if (and f90-cache-position (> (point) f90-cache-position)) |
924 |
type))) |
type))) |
925 |
|
|
926 |
(defsubst f90-equal-symbols (a b) |
(defsubst f90-equal-symbols (a b) |
927 |
"Compare strings neglecting case and allowing for nil value." |
"Compare strings A and B neglecting case and allowing for nil value." |
928 |
(let ((a-local (if a (downcase a) nil)) |
(let ((a-local (if a (downcase a) nil)) |
929 |
(b-local (if b (downcase b) nil))) |
(b-local (if b (downcase b) nil))) |
930 |
(equal a-local b-local))) |
(equal a-local b-local))) |
931 |
|
|
932 |
;; XEmacs 19.11 & 19.12 gives back a single char when matching an empty regular |
;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp. |
933 |
;; expression. Therefore, the next 2 functions are longer than necessary. |
;; The next 2 functions are therefore longer than necessary. |
|
|
|
934 |
(defsubst f90-looking-at-do () |
(defsubst f90-looking-at-do () |
935 |
"Return (\"do\" NAME) if a do statement starts after point. |
"Return (\"do\" NAME) if a do statement starts after point. |
936 |
NAME is nil if the statement has no label." |
NAME is nil if the statement has no label." |
1011 |
(list (match-string 1) (match-string 3)))) |
(list (match-string 1) (match-string 3)))) |
1012 |
|
|
1013 |
(defsubst f90-comment-indent () |
(defsubst f90-comment-indent () |
1014 |
|
"Return the indentation to be used for a comment starting at point. |
1015 |
|
Used for `comment-indent-function' by F90 mode. |
1016 |
|
\"!!!\", `f90-directive-comment-re', variable `f90-comment-region' return 0. |
1017 |
|
`f90-indented-comment-re' (if not trailing code) calls `f90-calculate-indent'. |
1018 |
|
Any other type return `comment-column', leaving at least one space after code." |
1019 |
(cond ((looking-at "!!!") 0) |
(cond ((looking-at "!!!") 0) |
1020 |
((and f90-directive-comment-re |
((and f90-directive-comment-re |
1021 |
(looking-at f90-directive-comment-re)) 0) |
(looking-at f90-directive-comment-re)) 0) |
1156 |
(goto-char pnt) |
(goto-char pnt) |
1157 |
(beginning-of-line) |
(beginning-of-line) |
1158 |
(cond ((looking-at "[ \t]*$")) |
(cond ((looking-at "[ \t]*$")) |
1159 |
((looking-at "[ \t]*#") ; Check for cpp directive. |
((looking-at "[ \t]*#") ; check for cpp directive |
1160 |
(setq icol 0)) |
(setq icol 0)) |
1161 |
(t |
(t |
1162 |
(skip-chars-forward " \t0-9") |
(skip-chars-forward " \t0-9") |
1173 |
)))) |
)))) |
1174 |
icol)) |
icol)) |
1175 |
|
|
|
;; Statement = statement line, a line which is neither blank, nor a comment. |
|
1176 |
(defun f90-previous-statement () |
(defun f90-previous-statement () |
1177 |
"Move point to beginning of the previous F90 statement. |
"Move point to beginning of the previous F90 statement. |
1178 |
Return nil if no previous statement is found." |
Return nil if no previous statement is found. |
1179 |
|
A statement is a line which is neither blank nor a comment." |
1180 |
(interactive) |
(interactive) |
1181 |
(let (not-first-statement) |
(let (not-first-statement) |
1182 |
(beginning-of-line) |
(beginning-of-line) |
1198 |
|
|
1199 |
(defun f90-beginning-of-subprogram () |
(defun f90-beginning-of-subprogram () |
1200 |
"Move point to the beginning of subprogram. |
"Move point to the beginning of subprogram. |
1201 |
Return (type name) or nil if not found." |
Return (TYPE NAME), or nil if not found." |
1202 |
(interactive) |
(interactive) |
1203 |
(let ((count 1) (case-fold-search t) matching-beg) |
(let ((count 1) (case-fold-search t) matching-beg) |
1204 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) (skip-chars-forward " \t0-9") |
1215 |
(beginning-of-line) |
(beginning-of-line) |
1216 |
(if (zerop count) |
(if (zerop count) |
1217 |
matching-beg |
matching-beg |
1218 |
(message "No beginning-found.") |
(message "No beginning found.") |
1219 |
nil))) |
nil))) |
1220 |
|
|
1221 |
(defun f90-end-of-subprogram () |
(defun f90-end-of-subprogram () |
1222 |
"Move point to the end of subprogram. |
"Move point to the end of subprogram. |
1223 |
Return (type name) or nil if not found." |
Return (TYPE NAME), or nil if not found." |
1224 |
(interactive) |
(interactive) |
1225 |
(let ((count 1) (case-fold-search t) matching-end) |
(let ((count 1) (case-fold-search t) matching-end) |
1226 |
(beginning-of-line) (skip-chars-forward " \t0-9") |
(beginning-of-line) (skip-chars-forward " \t0-9") |
1295 |
(interactive) |
(interactive) |
1296 |
(let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t)) |
(let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t)) |
1297 |
(set-marker pos (point)) |
(set-marker pos (point)) |
1298 |
(beginning-of-line) ; Digits after & \n are not line-no |
(beginning-of-line) ; digits after & \n are not line-nos |
1299 |
(if (save-excursion (and (f90-previous-statement) (f90-line-continued))) |
(if (save-excursion (and (f90-previous-statement) (f90-line-continued))) |
1300 |
(progn (setq no-line-number t) (skip-chars-forward " \t")) |
(progn (setq no-line-number t) (skip-chars-forward " \t")) |
1301 |
(f90-indent-line-no)) |
(f90-indent-line-no)) |
1323 |
(interactive) |
(interactive) |
1324 |
(let (string cont (case-fold-search t)) |
(let (string cont (case-fold-search t)) |
1325 |
(if abbrev-mode (expand-abbrev)) |
(if abbrev-mode (expand-abbrev)) |
1326 |
(beginning-of-line) ; Reindent where likely to be needed. |
(beginning-of-line) ; reindent where likely to be needed |
1327 |
(f90-indent-line-no) |
(f90-indent-line-no) |
1328 |
(if (or (looking-at "\\(end\\|else\\|!\\)")) |
(f90-indent-line 'no-update) |
|
(f90-indent-line 'no-update)) |
|
1329 |
(end-of-line) |
(end-of-line) |
1330 |
(delete-horizontal-space) ;Destroy trailing whitespace |
(delete-horizontal-space) ; destroy trailing whitespace |
1331 |
(setq string (f90-in-string)) |
(setq string (f90-in-string)) |
1332 |
(setq cont (f90-line-continued)) |
(setq cont (f90-line-continued)) |
1333 |
(if (and string (not cont)) (insert "&")) |
(if (and string (not cont)) (insert "&")) |
1345 |
struct beg-struct end-struct) |
struct beg-struct end-struct) |
1346 |
(set-marker end-region-mark end-region) |
(set-marker end-region-mark end-region) |
1347 |
(goto-char beg-region) |
(goto-char beg-region) |
1348 |
;; first find a line which is not a continuation line or comment |
;; First find a line which is not a continuation line or comment. |
1349 |
(beginning-of-line) |
(beginning-of-line) |
1350 |
(while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)") |
(while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)") |
1351 |
(progn (f90-indent-line 'no-update) |
(progn (f90-indent-line 'no-update) |
1355 |
(while (and (or (eq cont 'middle) (eq cont 'end)) |
(while (and (or (eq cont 'middle) (eq cont 'end)) |
1356 |
(f90-previous-statement)) |
(f90-previous-statement)) |
1357 |
(setq cont (f90-present-statement-cont))) |
(setq cont (f90-present-statement-cont))) |
1358 |
;; process present line for beginning of block |
;; Process present line for beginning of block. |
1359 |
(setq f90-cache-position (point)) |
(setq f90-cache-position (point)) |
1360 |
(f90-indent-line 'no-update) |
(f90-indent-line 'no-update) |
1361 |
(setq ind-lev (f90-current-indentation)) |
(setq ind-lev (f90-current-indentation)) |
1377 |
(if struct (setq block-list (cons struct block-list))) |
(if struct (setq block-list (cons struct block-list))) |
1378 |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
1379 |
(< (point) end-region-mark)) |
(< (point) end-region-mark)) |
1380 |
(if (not (zerop (- (current-indentation) |
(if (looking-at "[ \t]*!") |
1381 |
(+ ind-curr f90-continuation-indent)))) |
(f90-indent-to (f90-comment-indent)) |
1382 |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))) |
(if (not (zerop (- (current-indentation) |
1383 |
;; process all following lines |
(+ ind-curr f90-continuation-indent)))) |
1384 |
|
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) |
1385 |
|
;; Process all following lines. |
1386 |
(while (and (zerop (forward-line 1)) (< (point) end-region-mark)) |
(while (and (zerop (forward-line 1)) (< (point) end-region-mark)) |
1387 |
(beginning-of-line) |
(beginning-of-line) |
1388 |
(f90-indent-line-no) |
(f90-indent-line-no) |
1413 |
block-list (cdr block-list)) |
block-list (cdr block-list)) |
1414 |
(if f90-smart-end |
(if f90-smart-end |
1415 |
(save-excursion |
(save-excursion |
1416 |
(f90-block-match (car beg-struct)(car (cdr beg-struct)) |
(f90-block-match (car beg-struct) (car (cdr beg-struct)) |
1417 |
(car end-struct)(car (cdr end-struct))))) |
(car end-struct) (car (cdr end-struct))))) |
1418 |
(setq ind-b |
(setq ind-b |
1419 |
(cond ((looking-at f90-end-if-re) f90-if-indent) |
(cond ((looking-at f90-end-if-re) f90-if-indent) |
1420 |
((looking-at "end[ \t]*do\\>") f90-do-indent) |
((looking-at "end[ \t]*do\\>") f90-do-indent) |
1424 |
(if ind-b (setq ind-lev (- ind-lev ind-b))) |
(if ind-b (setq ind-lev (- ind-lev ind-b))) |
1425 |
(setq ind-curr ind-lev)) |
(setq ind-curr ind-lev)) |
1426 |
(t (setq ind-curr ind-lev))) |
(t (setq ind-curr ind-lev))) |
1427 |
;; do the indentation if necessary |
;; Do the indentation if necessary. |
1428 |
(if (not (zerop (- ind-curr (current-column)))) |
(if (not (zerop (- ind-curr (current-column)))) |
1429 |
(f90-indent-to ind-curr)) |
(f90-indent-to ind-curr)) |
1430 |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
(while (and (f90-line-continued) (zerop (forward-line 1)) |
1431 |
(< (point) end-region-mark)) |
(< (point) end-region-mark)) |
1432 |
(if (not (zerop (- (current-indentation) |
(if (looking-at "[ \t]*!") |
1433 |
(+ ind-curr f90-continuation-indent)))) |
(f90-indent-to (f90-comment-indent)) |
1434 |
(f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) |
(if (not (zerop (- (current-indentation) |
1435 |
;; restore point etc |
(+ ind-curr f90-continuation-indent)))) |
1436 |
|
(f90-indent-to |
1437 |
|
(+ ind-curr f90-continuation-indent) 'no-line-no))))) |
1438 |
|
;; Restore point, etc. |
1439 |
(setq f90-cache-position nil) |
(setq f90-cache-position nil) |
1440 |
(goto-char save-point) |
(goto-char save-point) |
1441 |
(set-marker end-region-mark nil) |
(set-marker end-region-mark nil) |
1445 |
(deactivate-mark)))) |
(deactivate-mark)))) |
1446 |
|
|
1447 |
(defun f90-indent-subprogram () |
(defun f90-indent-subprogram () |
1448 |
"Properly indent the subprogram which contains point." |
"Properly indent the subprogram containing point." |
1449 |
(interactive) |
(interactive) |
1450 |
(save-excursion |
(save-excursion |
1451 |
(let (program) |
(let (program) |
1461 |
(indent-region (point) (mark) nil) |
(indent-region (point) (mark) nil) |
1462 |
(message "Indenting the whole file...done"))))) |
(message "Indenting the whole file...done"))))) |
1463 |
|
|
|
;; autofill and break-line |
|
1464 |
(defun f90-break-line (&optional no-update) |
(defun f90-break-line (&optional no-update) |
1465 |
"Break line at point, insert continuation marker(s) and indent. |
"Break line at point, insert continuation marker(s) and indent. |
1466 |
Unless in a string or comment, or if the optional argument NO-UPDATE |
Unless in a string or comment, or if the optional argument NO-UPDATE |
1495 |
"Break line if non-white characters beyond `fill-column'. |
"Break line if non-white characters beyond `fill-column'. |
1496 |
Update keyword case first." |
Update keyword case first." |
1497 |
(interactive) |
(interactive) |
1498 |
;; Break the line before or after the last delimiter (non-word char) if |
;; Break line before or after last delimiter (non-word char) if |
1499 |
;; position is beyond fill-column. |
;; position is beyond fill-column. |
1500 |
;; Will not break **, //, or => (specified by f90-no-break-re). |
;; Will not break **, //, or => (as specified by f90-no-break-re). |
1501 |
(f90-update-line) |
(f90-update-line) |
1502 |
(while (> (current-column) fill-column) |
(while (> (current-column) fill-column) |
1503 |
(let ((pos-mark (point-marker))) |
(let ((pos-mark (point-marker))) |
1542 |
(set-marker end-region-mark end-region) |
(set-marker end-region-mark end-region) |
1543 |
(goto-char beg-region) |
(goto-char beg-region) |
1544 |
(while go-on |
(while go-on |
1545 |
;; join as much as possible |
;; Join as much as possible. |
1546 |
(while (f90-join-lines)) |
(while (f90-join-lines)) |
1547 |
;; chop the line if necessary |
;; Chop the line if necessary. |
1548 |
(while (> (save-excursion (end-of-line) (current-column)) |
(while (> (save-excursion (end-of-line) (current-column)) |
1549 |
fill-column) |
fill-column) |
1550 |
(move-to-column fill-column) |
(move-to-column fill-column) |
1560 |
|
|
1561 |
(defun f90-block-match (beg-block beg-name end-block end-name) |
(defun f90-block-match (beg-block beg-name end-block end-name) |
1562 |
"Match end-struct with beg-struct and complete end-block if possible. |
"Match end-struct with beg-struct and complete end-block if possible. |
1563 |
|
BEG-BLOCK is the type of block as indicated at the start (e.g., do). |
1564 |
|
BEG-NAME is the block start name (may be nil). |
1565 |
|
END-BLOCK is the type of block as indicated at the end (may be nil). |
1566 |
|
END-NAME is the block end name (may be nil). |
1567 |
Leave point at the end of line." |
Leave point at the end of line." |
1568 |
(search-forward "end" (line-end-position)) |
(search-forward "end" (line-end-position)) |
1569 |
(catch 'no-match |
(catch 'no-match |
1592 |
(if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) |
(if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) |
1593 |
|
|
1594 |
(defun f90-match-end () |
(defun f90-match-end () |
1595 |
"From an end foo statement, find the corresponding foo including name." |
"From an end block statement, find the corresponding block and name." |
1596 |
(interactive) |
(interactive) |
1597 |
(let ((count 1) (top-of-window (window-start)) (matching-beg nil) |
(let ((count 1) (top-of-window (window-start)) (matching-beg nil) |
1598 |
(end-point (point)) (case-fold-search t) |
(end-point (point)) (case-fold-search t) |
1652 |
(insert "end") |
(insert "end") |
1653 |
(f90-indent-new-line))) |
(f90-indent-new-line))) |
1654 |
|
|
1655 |
;; abbrevs and keywords |
;; Abbrevs and keywords. |
1656 |
|
|
1657 |
(defun f90-abbrev-start () |
(defun f90-abbrev-start () |
1658 |
"Typing `\\[help-command] or `? lists all the F90 abbrevs. |
"Typing `\\[help-command] or `? lists all the F90 abbrevs. |
1664 |
(setq c (read-event)) |
(setq c (read-event)) |
1665 |
(setq e (next-command-event) |
(setq e (next-command-event) |
1666 |
c (event-to-character e))) |
c (event-to-character e))) |
1667 |
;; insert char if not equal to `?' |
;; Insert char if not equal to `?'. |
1668 |
(if (or (eq c ??) (eq c help-char)) |
(if (or (eq c ??) (eq c help-char)) |
1669 |
(f90-abbrev-help) |
(f90-abbrev-help) |
1670 |
(if f90-xemacs-flag |
(if f90-xemacs-flag |
1679 |
(message "Listing abbrev table...done")) |
(message "Listing abbrev table...done")) |
1680 |
|
|
1681 |
(defun f90-prepare-abbrev-list-buffer () |
(defun f90-prepare-abbrev-list-buffer () |
1682 |
|
"Create a buffer listing the F90 mode abbreviations." |
1683 |
(save-excursion |
(save-excursion |
1684 |
(set-buffer (get-buffer-create "*Abbrevs*")) |
(set-buffer (get-buffer-create "*Abbrevs*")) |
1685 |
(erase-buffer) |
(erase-buffer) |
1721 |
|
|
1722 |
;; Change the keywords according to argument. |
;; Change the keywords according to argument. |
1723 |
(defun f90-change-keywords (change-word &optional beg end) |
(defun f90-change-keywords (change-word &optional beg end) |
1724 |
|
"Change the case of F90 keywords in the region (if specified) or buffer. |
1725 |
|
CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word." |
1726 |
(save-excursion |
(save-excursion |
1727 |
(setq beg (if beg beg (point-min))) |
(setq beg (if beg beg (point-min))) |
1728 |
(setq end (if end end (point-max))) |
(setq end (if end end (point-max))) |
1738 |
(unless (progn |
(unless (progn |
1739 |
(setq state (parse-partial-sexp ref-point (point))) |
(setq state (parse-partial-sexp ref-point (point))) |
1740 |
(or (nth 3 state) (nth 4 state) |
(or (nth 3 state) (nth 4 state) |
1741 |
(save-excursion ; Check for cpp directive. |
(save-excursion ; check for cpp directive |
1742 |
(beginning-of-line) |
(beginning-of-line) |
1743 |
(skip-chars-forward " \t0-9") |
(skip-chars-forward " \t0-9") |
1744 |
(looking-at "#")))) |
(looking-at "#")))) |