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

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

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