/[emacs]/emacs/lisp/progmodes/f90.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/f90.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.44 by gm, Mon Apr 29 23:23:03 2002 UTC revision 1.45 by gm, Wed May 1 15:29:30 2002 UTC
# Line 243  The options are 'downcase-word, 'upcase- Line 243  The options are 'downcase-word, 'upcase-
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"
# Line 312  The options are 'downcase-word, 'upcase- Line 312  The options are 'downcase-word, 'upcase-
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"
# Line 326  The options are 'downcase-word, 'upcase- Line 326  The options are 'downcase-word, 'upcase-
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.
# Line 353  subroutine\\|type\\)\\|use\\|call\\)\\>[ Line 353  subroutine\\|type\\)\\|use\\|call\\)\\>[
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))
# Line 387  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 387  do\\([ \t]*while\\)?\\|select[ \t]*case\
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    
# Line 400  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 400  do\\([ \t]*while\\)?\\|select[ \t]*case\
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    
# Line 435  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 435  do\\([ \t]*while\\)?\\|select[ \t]*case\
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)
# Line 449  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 449  do\\([ \t]*while\\)?\\|select[ \t]*case\
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"
# Line 468  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 467  do\\([ \t]*while\\)?\\|select[ \t]*case\
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)
# Line 540  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 536  do\\([ \t]*while\\)?\\|select[ \t]*case\
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))
# Line 566  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 563  do\\([ \t]*while\\)?\\|select[ \t]*case\
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)
# Line 590  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 584  do\\([ \t]*while\\)?\\|select[ \t]*case\
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]
# Line 604  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 597  do\\([ \t]*while\\)?\\|select[ \t]*case\
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]"))
# Line 638  program\\|select\\|subroutine\\|type\\|w Line 651  program\\|select\\|subroutine\\|type\\|w
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+\\)")
# Line 655  program\\|select\\|subroutine\\|type\\|w Line 668  program\\|select\\|subroutine\\|type\\|w
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))
# Line 730  program\\|select\\|subroutine\\|type\\|w Line 743  program\\|select\\|subroutine\\|type\\|w
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)
# Line 739  program\\|select\\|subroutine\\|type\\|w Line 752  program\\|select\\|subroutine\\|type\\|w
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\
# Line 752  Key definitions: Line 765  Key definitions:
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."
# Line 818  with no args, if that value is non-nil." Line 831  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)
# Line 826  with no args, if that value is non-nil." Line 839  with no args, if that value is non-nil."
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
# Line 841  with no args, if that value is non-nil." Line 854  with no args, if that value is non-nil."
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))
# Line 855  and lies before point." Line 869  and lies before point."
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))
# Line 910  For example, \"!\" or \"!!\"." Line 924  For example, \"!\" or \"!!\"."
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."
# Line 998  NAME is non-nil only for type." Line 1011  NAME is non-nil only for type."
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)
# Line 1138  Does not check type and subprogram inden Line 1156  Does not check type and subprogram inden
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")
# Line 1155  Does not check type and subprogram inden Line 1173  Does not check type and subprogram inden
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)
# Line 1180  Return nil if no later statement is foun Line 1198  Return nil if no later statement is foun
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")
# Line 1197  Return (type name) or nil if not found." Line 1215  Return (type name) or nil if not found."
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")
# Line 1277  after indenting." Line 1295  after indenting."
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))
# Line 1305  If run in the middle of a line, the line Line 1323  If run in the middle of a line, the line
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 "&"))
# Line 1328  If run in the middle of a line, the line Line 1345  If run in the middle of a line, the line
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)
# Line 1338  If run in the middle of a line, the line Line 1355  If run in the middle of a line, the line
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))
# Line 1360  If run in the middle of a line, the line Line 1377  If run in the middle of a line, the line
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)
# Line 1394  If run in the middle of a line, the line Line 1413  If run in the middle of a line, the line
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)
# Line 1405  If run in the middle of a line, the line Line 1424  If run in the middle of a line, the line
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)
# Line 1423  If run in the middle of a line, the line Line 1445  If run in the middle of a line, the line
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)
# Line 1439  If run in the middle of a line, the line Line 1461  If run in the middle of a line, the line
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
# Line 1474  is non-nil, call `f90-update-line' after Line 1495  is non-nil, call `f90-update-line' after
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)))
# Line 1521  Update keyword case first." Line 1542  Update keyword case first."
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)
# Line 1539  Update keyword case first." Line 1560  Update keyword case first."
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
# Line 1567  Leave point at the end of line." Line 1592  Leave point at the end of line."
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)
# Line 1627  Leave point at the end of line." Line 1652  Leave point at the end of line."
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.
# Line 1639  Any other key combination is executed no Line 1664  Any other key combination is executed no
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
# Line 1654  Any other key combination is executed no Line 1679  Any other key combination is executed no
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)
# Line 1695  Any other key combination is executed no Line 1721  Any other key combination is executed no
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)))
# Line 1710  Any other key combination is executed no Line 1738  Any other key combination is executed no
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 "#"))))

Legend:
Removed from v.1.44  
changed lines
  Added in v.1.45

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26