/[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.56 by gm, Sun May 26 19:54:22 2002 UTC revision 1.56.2.1 by miles, Fri Apr 4 06:20:32 2003 UTC
# Line 156  Line 156 
156    
157  ;;; Code:  ;;; Code:
158    
159    (defvar comment-auto-fill-only-comments)
160    (defvar font-lock-keywords)
161    
162  ;; User options  ;; User options
163    
164  (defgroup f90 nil  (defgroup f90 nil
# Line 242  The options are 'downcase-word, 'upcase- Line 245  The options are 'downcase-word, 'upcase-
245    :type 'boolean    :type 'boolean
246    :group 'f90)    :group 'f90)
247    
248  (defconst f90-xemacs-flag (string-match "XEmacs\\|Lucid" emacs-version)  (defcustom f90-mode-hook nil
249    "Non-nil means F90 mode thinks it is running under XEmacs.")    "Hook run when entering F90 mode."
250      :type 'hook
251      :options '(f90-add-imenu-menu)
252      :group 'f90)
253    
254    ;; User options end here.
255    
256  (defconst f90-keywords-re  (defconst f90-keywords-re
257    (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace"    (regexp-opt '("allocatable" "allocate" "assign" "assignment" "backspace"
# Line 339  The options are 'downcase-word, 'upcase- Line 347  The options are 'downcase-word, 'upcase-
347    (list    (list
348     ;; Special highlighting of "module procedure".     ;; Special highlighting of "module procedure".
349     '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face))     '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face))
350     ;; Highlight declaration of derived type.     ;; Highlight definition of derived type.
351  ;;;   '("\\<\\(type\\)[ \t]*\\(.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"     '("\\<\\(\\(?:end[ \t]*\\)?type\\)\\>\\([^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
352  ;;;     (1 font-lock-keyword-face) (3 font-lock-function-name-face))       (1 font-lock-keyword-face) (3 font-lock-function-name-face))
353     ;; Other functions and declarations.     ;; Other functions and declarations.
354     '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\     '("\\<\\(\\(?:end[ \t]*\\)?\\(program\\|module\\|function\\|\
355  subroutine\\|type\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"  subroutine\\)\\|use\\|call\\)\\>[ \t]*\\(\\sw+\\)?"
356       (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))
357     "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")     "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
358    "This does fairly subdued highlighting of comments and function calls.")    "This does fairly subdued highlighting of comments and function calls.")
# Line 366  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 374  do\\([ \t]*while\\)?\\|select[ \t]*case\
374        (2 font-lock-constant-face nil t) (3 font-lock-keyword-face))        (2 font-lock-constant-face nil t) (3 font-lock-keyword-face))
375      ;; Implicit declaration.      ;; Implicit declaration.
376      '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\      '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\
377  \\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>"  \\|logical\\|type[ \t]*(\\sw+)\\|none\\)[ \t]*"
378        (1 font-lock-keyword-face) (2 font-lock-type-face))        (1 font-lock-keyword-face) (2 font-lock-type-face))
379      '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"      '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/"
380        (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))        (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
# Line 398  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 406  do\\([ \t]*while\\)?\\|select[ \t]*case\
406    
407  (defvar f90-font-lock-keywords  (defvar f90-font-lock-keywords
408    f90-font-lock-keywords-2    f90-font-lock-keywords-2
409    "*Default expressions to highlight in F90 mode.")    "*Default expressions to highlight in F90 mode.
410    Can be overridden by the value of `font-lock-maximum-decoration'.")
411    
412    
413  (defvar f90-mode-syntax-table  (defvar f90-mode-syntax-table
# Line 449  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 458  do\\([ \t]*while\\)?\\|select[ \t]*case\
458      map)      map)
459    "Keymap used in F90 mode.")    "Keymap used in F90 mode.")
460    
 ;; Menu bar support.  
 (if f90-xemacs-flag  
     (defvar f90-xemacs-menu  
       '("F90"  
         ["Indent Subprogram"       f90-indent-subprogram t]  
         ["Mark Subprogram"         f90-mark-subprogram t]  
         ["Beginning of Subprogram" f90-beginning-of-subprogram t]  
         ["End of Subprogram"       f90-end-of-subprogram t]  
         "-----"  
         ["(Un)Comment Region"      f90-comment-region t]  
         ["Indent Region"           indent-region t]  
         ["Fill Region"             f90-fill-region t]  
         "-----"  
         ["Break Line at Point"     f90-break-line t]  
         ["Join with Next Line"     f90-join-lines t]  
         ["Insert Newline"          newline t]  
         ["Insert Block End"        f90-insert-end t]  
         "-----"  
         ["Upcase Keywords (buffer)"      f90-upcase-keywords t]  
         ["Upcase Keywords (region)"      f90-upcase-region-keywords t]  
         ["Capitalize Keywords (buffer)"  f90-capitalize-keywords t]  
         ["Capitalize Keywords (region)"  f90-capitalize-region-keywords t]  
         ["Downcase Keywords (buffer)"    f90-downcase-keywords t]  
         ["Downcase Keywords (region)"    f90-downcase-region-keywords t]  
         "-----"  
         ["Toggle abbrev-mode"   abbrev-mode t]  
         ["Toggle auto-fill"     auto-fill-mode t])  
       "XEmacs menu for F90 mode.")  
   
   ;; Emacs.  
   (defvar f90-menu-bar-menu  
     (let ((map (make-sparse-keymap "F90")))  
       (define-key map [f90-imenu-menu]  
         '("Add imenu Menu" . f90-add-imenu-menu))  
       (define-key map [abbrev-mode]  
         '("Toggle abbrev-mode" . abbrev-mode))  
       (define-key map [auto-fill-mode]  
         '("Toggle auto-fill" . auto-fill-mode))  
       (define-key map [line1] '("--"))  
       (define-key map [f90-change-case-menu]  
         '("Change Keyword Case" . f90-change-case-menu))  
       (define-key map [f90-font-lock-menu]  
         '("Highlighting" . f90-font-lock-menu))  
       (define-key map [line2] '("--"))  
       (define-key map [f90-insert-end]  
         '("Insert Block End" . f90-insert-end))  
       (define-key map [f90-join-lines]  
         '("Join with Next Line" . f90-join-lines))  
       (define-key map [f90-break-line]  
         '("Break Line at Point" . f90-break-line))  
       (define-key map [line3] '("--"))  
       (define-key map [f90-fill-region]  
         '("Fill Region" . f90-fill-region))  
       (put 'f90-fill-region 'menu-enable 'mark-active)  
       (define-key map [indent-region]  
         '("Indent Region" . indent-region))  
       (define-key map [f90-comment-region]  
         '("(Un)Comment Region" . f90-comment-region))  
       (put 'f90-comment-region 'menu-enable 'mark-active)  
       (define-key map [line4] '("--"))  
       (define-key map [f90-end-of-subprogram]  
         '("End of Subprogram" . f90-end-of-subprogram))  
       (define-key map [f90-beginning-of-subprogram]  
         '("Beginning of Subprogram" . f90-beginning-of-subprogram))  
       (define-key map [f90-mark-subprogram]  
         '("Mark Subprogram" . f90-mark-subprogram))  
       (define-key map [f90-indent-subprogram]  
         '("Indent Subprogram" . f90-indent-subprogram))  
       map)  
     "F90 mode top-level menu bar menu.")  
   
   (define-key f90-mode-map [menu-bar f90-menu]  
     (cons "F90" f90-menu-bar-menu))  
   
   (defvar f90-change-case-menu  
     (let ((map (make-sparse-keymap "Change Keyword Case")))  
       (define-key map [dkr]  
         '("Downcase Keywords (region)" . f90-downcase-region-keywords))  
       (put 'f90-downcase-region-keywords 'menu-enable 'mark-active)  
       (define-key map [ckr]  
         '("Capitalize Keywords (region)" . f90-capitalize-region-keywords))  
       (put 'f90-capitalize-region-keywords 'menu-enable 'mark-active)  
       (define-key map [ukr]  
         '("Upcase Keywords (region)" . f90-upcase-region-keywords))  
       (put 'f90-upcase-region-keywords 'menu-enable 'mark-active)  
       (define-key map [line] '("--"))  
       (define-key map [dkb]  
         '("Downcase Keywords (buffer)" . f90-downcase-keywords))  
       (define-key map [ckb]  
         '("Capitalize Keywords (buffer)" . f90-capitalize-keywords))  
       (define-key map [ukb]  
         '("Upcase Keywords (buffer)" . f90-upcase-keywords))  
       map)  
     "Submenu for change of case.")  
   
   (defalias 'f90-change-case-menu f90-change-case-menu)  
   
   ;; Font-lock-menu and function calls.  
   (defalias 'f90-font-lock-on 'font-lock-mode)  
   (put 'f90-font-lock-on 'menu-enable 'font-lock-mode)  
   (put 'f90-font-lock-on 'menu-alias t)  
   
   (defalias 'f90-font-lock-off 'font-lock-mode)  
   (put 'f90-font-lock-off 'menu-enable '(not font-lock-mode))  
   (put 'f90-font-lock-off 'menu-alias t)  
   
   (defun f90-font-lock-1 ()  
     "Set `font-lock-keywords' to `f90-font-lock-keywords-1'."  
     (interactive)  
     (font-lock-mode 1)  
     (setq font-lock-keywords f90-font-lock-keywords-1)  
     (font-lock-fontify-buffer))  
   
   (defun f90-font-lock-2 ()  
     "Set `font-lock-keywords' to `f90-font-lock-keywords-2'."  
     (interactive)  
     (font-lock-mode 1)  
     (setq font-lock-keywords f90-font-lock-keywords-2)  
     (font-lock-fontify-buffer))  
   
   (defun f90-font-lock-3 ()  
     "Set `font-lock-keywords' to `f90-font-lock-keywords-3'."  
     (interactive)  
     (font-lock-mode 1)  
     (setq font-lock-keywords f90-font-lock-keywords-3)  
     (font-lock-fontify-buffer))  
   
   (defun f90-font-lock-4 ()  
     "Set `font-lock-keywords' to `f90-font-lock-keywords-4'."  
     (interactive)  
     (font-lock-mode 1)  
     (setq font-lock-keywords f90-font-lock-keywords-4)  
     (font-lock-fontify-buffer))  
   
   (defvar f90-font-lock-menu  
     (let ((map (make-sparse-keymap "f90-font-lock-menu")))  
       (define-key map [h4]  
         '("Maximum highlighting (level 4)" . f90-font-lock-4))  
       (define-key map [h3]  
         '("Heavy highlighting (level 3)" . f90-font-lock-3))  
       (define-key map [h2]  
         '("Default highlighting (level 2)" . f90-font-lock-2))  
       (define-key map [h1]  
         '("Light highlighting (level 1)" . f90-font-lock-1))  
       (define-key map [line] '("--"))  
       (define-key map [floff]  
         '("Turn off font-lock-mode" . f90-font-lock-on))  
       (define-key map [flon]  
         '("Turn on font-lock-mode" . f90-font-lock-off))  
       map)  
     "Submenu for highlighting using font-lock-mode.")  
   
   (defalias 'f90-font-lock-menu f90-font-lock-menu)  
461    
462    )  (easy-menu-define f90-menu f90-mode-map "Menu for F90 mode."
463      '("F90"
464        ["Indent Subprogram"       f90-indent-subprogram       t]
465        ["Mark Subprogram"         f90-mark-subprogram         t]
466        ["Beginning of Subprogram" f90-beginning-of-subprogram t]
467        ["End of Subprogram"       f90-end-of-subprogram       t]
468        "--"
469        ["(Un)Comment Region" f90-comment-region mark-active]
470        ["Indent Region"      f90-indent-region  mark-active]
471        ["Fill Region"        f90-fill-region    mark-active]
472        "--"
473        ["Break Line at Point" f90-break-line t]
474        ["Join with Next Line" f90-join-lines t]
475        ["Insert Block End"    f90-insert-end t]
476        "--"
477        ("Highlighting"
478         ["Toggle font-lock-mode" font-lock-mode :selected font-lock-mode
479          :style toggle]
480         "--"
481         ["Light highlighting (level 1)"    f90-font-lock-1 t]
482         ["Moderate highlighting (level 2)" f90-font-lock-2 t]
483         ["Heavy highlighting (level 3)"    f90-font-lock-3 t]
484         ["Maximum highlighting (level 4)"  f90-font-lock-4 t]
485         )
486        ("Change Keyword Case"
487         ["Upcase Keywords (buffer)"     f90-upcase-keywords     t]
488         ["Capitalize Keywords (buffer)" f90-capitalize-keywords t]
489         ["Downcase Keywords (buffer)"   f90-downcase-keywords   t]
490         "--"
491         ["Upcase Keywords (region)"     f90-upcase-region-keywords mark-active]
492         ["Capitalize Keywords (region)" f90-capitalize-region-keywords
493          mark-active]
494         ["Downcase Keywords (region)"   f90-downcase-region-keywords mark-active]
495         )
496        "--"
497        ["Toggle auto-fill"   auto-fill-mode :selected auto-fill-function
498         :style toggle]
499        ["Toggle abbrev-mode" abbrev-mode    :selected abbrev-mode :style toggle]
500        ["Add imenu Menu" f90-add-imenu-menu
501         :active (not (lookup-key (current-local-map) [menu-bar index]))
502         :included (fboundp 'imenu-add-to-menubar)]
503        ))
504    
505    (defun f90-font-lock-1 ()
506      "Set `font-lock-keywords' to `f90-font-lock-keywords-1'."
507      (interactive)
508      (font-lock-mode 1)
509      (setq font-lock-keywords f90-font-lock-keywords-1)
510      (font-lock-fontify-buffer))
511    
512    (defun f90-font-lock-2 ()
513      "Set `font-lock-keywords' to `f90-font-lock-keywords-2'."
514      (interactive)
515      (font-lock-mode 1)
516      (setq font-lock-keywords f90-font-lock-keywords-2)
517      (font-lock-fontify-buffer))
518    
519    (defun f90-font-lock-3 ()
520      "Set `font-lock-keywords' to `f90-font-lock-keywords-3'."
521      (interactive)
522      (font-lock-mode 1)
523      (setq font-lock-keywords f90-font-lock-keywords-3)
524      (font-lock-fontify-buffer))
525    
526    (defun f90-font-lock-4 ()
527      "Set `font-lock-keywords' to `f90-font-lock-keywords-4'."
528      (interactive)
529      (font-lock-mode 1)
530      (setq font-lock-keywords f90-font-lock-keywords-4)
531      (font-lock-fontify-buffer))
532    
533    
534  ;; Regexps for finding program structures.  ;; Regexps for finding program structures.
535  (defconst f90-blocks-re  (defconst f90-blocks-re
536    (concat "\\(block[ \t]*data\\|"    (concat "\\(block[ \t]*data\\|"
# Line 632  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 558  do\\([ \t]*while\\)?\\|select[ \t]*case\
558    "Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.")    "Regexp matching the end of a TYPE, INTERFACE, BLOCK DATA section.")
559    
560  (defconst f90-type-def-re  (defconst f90-type-def-re
561    "\\<\\(type\\)\\([^(\n]*\\)\\(::\\)?[ \t]*\\b\\(\\sw+\\)"    "\\<\\(type\\)\\>\\(?:[^()\n]*::\\)?[ \t]*\\(\\sw+\\)"
562    "Regexp matching the declaration of a variable of derived type.")    "Regexp matching the definition of a derived type.")
563    
564  (defconst f90-no-break-re  (defconst f90-no-break-re
565    (regexp-opt '("**" "//" "=>") 'paren)    (regexp-opt '("**" "//" "=>") 'paren)
# Line 643  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 569  do\\([ \t]*while\\)?\\|select[ \t]*case\
569    "Temporary position used to speed up region operations.")    "Temporary position used to speed up region operations.")
570  (make-variable-buffer-local 'f90-cache-position)  (make-variable-buffer-local 'f90-cache-position)
571    
 (defvar f90-imenu-flag nil  
   "Non-nil means this buffer already has an imenu.")  
 (make-variable-buffer-local 'f90-imenu-flag)  
   
572    
573  ;; Imenu support.  ;; Imenu support.
574  (defvar f90-imenu-generic-expression  (defvar f90-imenu-generic-expression
# Line 678  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 600  do\\([ \t]*while\\)?\\|select[ \t]*case\
600  (defun f90-add-imenu-menu ()  (defun f90-add-imenu-menu ()
601    "Add an imenu menu to the menubar."    "Add an imenu menu to the menubar."
602    (interactive)    (interactive)
603    (if f90-imenu-flag    (if (lookup-key (current-local-map) [menu-bar index])
604        (message "%s" "F90-imenu already exists.")        (message "%s" "F90-imenu already exists.")
605      (imenu-add-to-menubar "F90-imenu")      (imenu-add-to-menubar "F90-imenu")
606      (redraw-frame (selected-frame))      (redraw-frame (selected-frame))))
     (setq f90-imenu-flag t)))  
   
 (put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu-flag))  
   
   
 ;; When compiling under GNU Emacs, load imenu during compilation.  
 ;; If you have 19.22 or earlier, comment this out, or get imenu.  
 (or f90-xemacs-flag (eval-when-compile (require 'imenu)))  
607    
608    
609  ;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t.  ;; Abbrevs have generally two letters, except standard types `c, `i, `r, `t.
610  (defvar f90-mode-abbrev-table  (defvar f90-mode-abbrev-table
611    (let (abbrevs-changed)    (let (abbrevs-changed)
612      (define-abbrev-table 'f90-mode-abbrev-table      (define-abbrev-table 'f90-mode-abbrev-table nil)
613        '(("`al"  "allocate"      nil 0 t)      ;; Use the 6th arg (SYSTEM-FLAG) of define-abbrev if possible.
614          ("`ab"  "allocatable"   nil 0 t)      ;; A little baroque to quieten the byte-compiler.
615          ("`as"  "assignment"    nil 0 t)      (mapcar
616          ("`ba"  "backspace"     nil 0 t)       (function (lambda (element)
617          ("`bd"  "block data"    nil 0 t)                   (condition-case nil
618          ("`c"   "character"     nil 0 t)                       (apply 'define-abbrev f90-mode-abbrev-table
619          ("`cl"  "close"         nil 0 t)                              (append element '(nil 0 t)))
620          ("`cm"  "common"        nil 0 t)                     (wrong-number-of-arguments
621          ("`cx"  "complex"       nil 0 t)                      (apply 'define-abbrev f90-mode-abbrev-table
622          ("`cn"  "contains"      nil 0 t)                             (append element '(nil 0)))))))
623          ("`cy"  "cycle"         nil 0 t)       '(("`al"  "allocate"     )
624          ("`de"  "deallocate"    nil 0 t)         ("`ab"  "allocatable"  )
625          ("`df"  "define"        nil 0 t)         ("`as"  "assignment"   )
626          ("`di"  "dimension"     nil 0 t)         ("`ba"  "backspace"    )
627          ("`dw"  "do while"      nil 0 t)         ("`bd"  "block data"   )
628          ("`el"  "else"          nil 0 t)         ("`c"   "character"    )
629          ("`eli" "else if"       nil 0 t)         ("`cl"  "close"        )
630          ("`elw" "elsewhere"     nil 0 t)         ("`cm"  "common"       )
631          ("`eq"  "equivalence"   nil 0 t)         ("`cx"  "complex"      )
632          ("`ex"  "external"      nil 0 t)         ("`cn"  "contains"     )
633          ("`ey"  "entry"         nil 0 t)         ("`cy"  "cycle"        )
634          ("`fl"  "forall"        nil 0 t)         ("`de"  "deallocate"   )
635          ("`fo"  "format"        nil 0 t)         ("`df"  "define"       )
636          ("`fu"  "function"      nil 0 t)         ("`di"  "dimension"    )
637          ("`fa"  ".false."       nil 0 t)         ("`dw"  "do while"     )
638          ("`im"  "implicit none" nil 0 t)         ("`el"  "else"         )
639          ("`in " "include"       nil 0 t)         ("`eli" "else if"      )
640          ("`i"   "integer"       nil 0 t)         ("`elw" "elsewhere"    )
641          ("`it"  "intent"        nil 0 t)         ("`eq"  "equivalence"  )
642          ("`if"  "interface"     nil 0 t)         ("`ex"  "external"     )
643          ("`lo"  "logical"       nil 0 t)         ("`ey"  "entry"        )
644          ("`mo"  "module"        nil 0 t)         ("`fl"  "forall"       )
645          ("`na"  "namelist"      nil 0 t)         ("`fo"  "format"       )
646          ("`nu"  "nullify"       nil 0 t)         ("`fu"  "function"     )
647          ("`op"  "optional"      nil 0 t)         ("`fa"  ".false."      )
648          ("`pa"  "parameter"     nil 0 t)         ("`im"  "implicit none")
649          ("`po"  "pointer"       nil 0 t)         ("`in"  "include"      )
650          ("`pr"  "print"         nil 0 t)         ("`i"   "integer"      )
651          ("`pi"  "private"       nil 0 t)         ("`it"  "intent"       )
652          ("`pm"  "program"       nil 0 t)         ("`if"  "interface"    )
653          ("`pu"  "public"        nil 0 t)         ("`lo"  "logical"      )
654          ("`r"   "real"          nil 0 t)         ("`mo"  "module"       )
655          ("`rc"  "recursive"     nil 0 t)         ("`na"  "namelist"     )
656          ("`rt"  "return"        nil 0 t)         ("`nu"  "nullify"      )
657          ("`rw"  "rewind"        nil 0 t)         ("`op"  "optional"     )
658          ("`se"  "select"        nil 0 t)         ("`pa"  "parameter"    )
659          ("`sq"  "sequence"      nil 0 t)         ("`po"  "pointer"      )
660          ("`su"  "subroutine"    nil 0 t)         ("`pr"  "print"        )
661          ("`ta"  "target"        nil 0 t)         ("`pi"  "private"      )
662          ("`tr"  ".true."        nil 0 t)         ("`pm"  "program"      )
663          ("`t"   "type"          nil 0 t)         ("`pu"  "public"       )
664          ("`wh"  "where"         nil 0 t)         ("`r"   "real"         )
665          ("`wr"  "write"         nil 0 t)))         ("`rc"  "recursive"    )
666           ("`rt"  "return"       )
667           ("`rw"  "rewind"       )
668           ("`se"  "select"       )
669           ("`sq"  "sequence"     )
670           ("`su"  "subroutine"   )
671           ("`ta"  "target"       )
672           ("`tr"  ".true."       )
673           ("`t"   "type"         )
674           ("`wh"  "where"        )
675           ("`wr"  "write"        )))
676      f90-mode-abbrev-table)      f90-mode-abbrev-table)
677    "Abbrev table for F90 mode.")    "Abbrev table for F90 mode.")
678    
 (defcustom f90-mode-hook nil  
   "Hook run when entering F90 mode."  
   :type 'hook  
   :options '(f90-add-imenu-menu)  
   :group 'f90)  
679    
680  ;;;###autoload  ;;;###autoload
681  (defun f90-mode ()  (defun f90-mode ()
# Line 833  with no args, if that value is non-nil." Line 752  with no args, if that value is non-nil."
752    (set (make-local-variable 'abbrev-all-caps) t)    (set (make-local-variable 'abbrev-all-caps) t)
753    (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill)    (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill)
754    (setq indent-tabs-mode nil)           ; auto buffer local    (setq indent-tabs-mode nil)           ; auto buffer local
755      (easy-menu-add f90-menu)
756    ;; Setting up things for font-lock.    ;; Setting up things for font-lock.
   (when f90-xemacs-flag  
     (put 'f90-mode 'font-lock-keywords-case-fold-search t)  
     (when (and (featurep 'menubar)  
                current-menubar  
                (not (assoc "F90" current-menubar)))  
       (set-buffer-menubar (copy-sequence current-menubar))  
       (add-submenu nil f90-xemacs-menu)))  
   ;; XEmacs: Does not need a special case, since both emacsen work alike -sb.  
757    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
758         '((f90-font-lock-keywords f90-font-lock-keywords-1         '((f90-font-lock-keywords f90-font-lock-keywords-1
759                                   f90-font-lock-keywords-2                                   f90-font-lock-keywords-2
# Line 977  NAME is nil if the statement has no labe Line 889  NAME is nil if the statement has no labe
889  NAME is non-nil only for type."  NAME is non-nil only for type."
890    (cond    (cond
891     ((looking-at f90-type-def-re)     ((looking-at f90-type-def-re)
892      (list (match-string 1) (match-string 4)))      (list (match-string 1) (match-string 2)))
893     ((looking-at "\\(interface\\|block[\t]*data\\)\\>")     ((looking-at "\\(interface\\|block[\t]*data\\)\\>")
894      (list (match-string 1) nil))))      (list (match-string 1) nil))))
895    
# Line 1369  A block is a subroutine, if-endif, etc." Line 1281  A block is a subroutine, if-endif, etc."
1281    (f90-next-block (- (or num 1))))    (f90-next-block (- (or num 1))))
1282    
1283    
 (defvar f90-mark-subprogram-overlay nil  
   "Used internally by `f90-mark-subprogram' to highlight the subprogram.")  
 (make-variable-buffer-local 'f90-mark-subprogram-overlay)  
   
1284  (defun f90-mark-subprogram ()  (defun f90-mark-subprogram ()
1285    "Put mark at end of F90 subprogram, point at beginning, push marks.    "Put mark at end of F90 subprogram, point at beginning, push marks."
 If called interactively, highlight the subprogram with the face `highlight'.  
 Call again to remove the highlighting."  
1286    (interactive)    (interactive)
1287    (let ((pos (point)) program)    (let ((pos (point)) program)
1288      (f90-end-of-subprogram)      (f90-end-of-subprogram)
1289      (push-mark (point) t)      (push-mark)
1290      (goto-char pos)      (goto-char pos)
1291      (setq program (f90-beginning-of-subprogram))      (setq program (f90-beginning-of-subprogram))
1292      ;; The keywords in the preceding lists assume case-insensitivity.      (if (fboundp 'zmacs-activate-region)
1293      (if f90-xemacs-flag          (zmacs-activate-region)
         (zmacs-activate-region)  
1294        (setq mark-active t        (setq mark-active t
1295              deactivate-mark nil)              deactivate-mark nil))
       (if (interactive-p)  
           (if (overlayp f90-mark-subprogram-overlay)  
               (if (overlay-buffer f90-mark-subprogram-overlay)  
                   (delete-overlay f90-mark-subprogram-overlay)  
                 (move-overlay f90-mark-subprogram-overlay (point) (mark)))  
             (setq f90-mark-subprogram-overlay (make-overlay (point) (mark)))  
             (overlay-put f90-mark-subprogram-overlay 'face 'highlight))))  
1296      program))      program))
1297    
1298  (defun f90-comment-region (beg-region end-region)  (defun f90-comment-region (beg-region end-region)
# Line 1423  after indenting." Line 1321  after indenting."
1321    (interactive)    (interactive)
1322    (let (indent no-line-number (pos (make-marker)) (case-fold-search t))    (let (indent no-line-number (pos (make-marker)) (case-fold-search t))
1323      (set-marker pos (point))      (set-marker pos (point))
1324      (beginning-of-line)                 ; digits after & \n are not line-nos      (beginning-of-line)                ; digits after & \n are not line-nos
1325      (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))      (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))
1326          (progn (setq no-line-number t) (skip-chars-forward " \t"))          (progn (setq no-line-number t) (skip-chars-forward " \t"))
1327        (f90-indent-line-no))        (f90-indent-line-no))
# Line 1450  If run in the middle of a line, the line Line 1348  If run in the middle of a line, the line
1348    (interactive)    (interactive)
1349    (let (string cont (case-fold-search t))    (let (string cont (case-fold-search t))
1350      (if abbrev-mode (expand-abbrev))      (if abbrev-mode (expand-abbrev))
1351      (beginning-of-line)                 ; reindent where likely to be needed      (beginning-of-line)                ; reindent where likely to be needed
1352      (f90-indent-line-no)      (f90-indent-line-no)
1353      (f90-indent-line 'no-update)      (f90-indent-line 'no-update)
1354      (end-of-line)      (end-of-line)
# Line 1499  If run in the middle of a line, the line Line 1397  If run in the middle of a line, the line
1397                         f90-if-indent)                         f90-if-indent)
1398                        ((setq struct (f90-looking-at-type-like))                        ((setq struct (f90-looking-at-type-like))
1399                         f90-type-indent)                         f90-type-indent)
1400                        ((or(setq struct (f90-looking-at-program-block-start))                        ((or (setq struct (f90-looking-at-program-block-start))
1401                            (looking-at "contains[ \t]*\\($\\|!\\)"))                             (looking-at "contains[ \t]*\\($\\|!\\)"))
1402                         f90-program-indent)))                         f90-program-indent)))
1403      (if ind-b (setq ind-lev (+ ind-lev ind-b)))      (if ind-b (setq ind-lev (+ ind-lev ind-b)))
1404      (if struct (setq block-list (cons struct block-list)))      (if struct (setq block-list (cons struct block-list)))
# Line 1569  If run in the middle of a line, the line Line 1467  If run in the middle of a line, the line
1467      (goto-char save-point)      (goto-char save-point)
1468      (set-marker end-region-mark nil)      (set-marker end-region-mark nil)
1469      (set-marker save-point nil)      (set-marker save-point nil)
1470      (if f90-xemacs-flag      (if (fboundp 'zmacs-deactivate-region)
1471          (zmacs-deactivate-region)          (zmacs-deactivate-region)
1472        (deactivate-mark))))        (deactivate-mark))))
1473    
1474  (defun f90-indent-subprogram ()  (defun f90-indent-subprogram ()
# Line 1624  Update keyword case first." Line 1522  Update keyword case first."
1522    ;; position is beyond fill-column.    ;; position is beyond fill-column.
1523    ;; Will not break **, //, or => (as specified by f90-no-break-re).    ;; Will not break **, //, or => (as specified by f90-no-break-re).
1524    (f90-update-line)    (f90-update-line)
1525    (while (> (current-column) fill-column)    ;; Need this for `f90-electric-insert' and other f90- callers.
1526      (let ((pos-mark (point-marker)))    (unless (and (boundp 'comment-auto-fill-only-comments)
1527        (move-to-column fill-column)                 comment-auto-fill-only-comments
1528        (or (f90-in-string) (f90-find-breakpoint))                 (not (f90-in-comment)))
1529        (f90-break-line)      (while (> (current-column) fill-column)
1530        (goto-char pos-mark)        (let ((pos-mark (point-marker)))
1531        (set-marker pos-mark nil))))          (move-to-column fill-column)
1532            (or (f90-in-string) (f90-find-breakpoint))
1533            (f90-break-line)
1534            (goto-char pos-mark)
1535            (set-marker pos-mark nil)))))
1536    
1537    
1538  (defun f90-join-lines ()  (defun f90-join-lines ()
# Line 1676  Update keyword case first." Line 1578  Update keyword case first."
1578                         (zerop (forward-line 1)))                         (zerop (forward-line 1)))
1579              f90-cache-position (point)))              f90-cache-position (point)))
1580      (setq f90-cache-position nil)      (setq f90-cache-position nil)
1581      (if f90-xemacs-flag      (if (fboundp 'zmacs-deactivate-region)
1582          (zmacs-deactivate-region)          (zmacs-deactivate-region)
1583        (deactivate-mark))))        (deactivate-mark))))
1584    
1585  (defun f90-block-match (beg-block beg-name end-block end-name)  (defun f90-block-match (beg-block beg-name end-block end-name)
# Line 1770  Leave point at the end of line." Line 1672  Leave point at the end of line."
1672    "Typing `\\[help-command] or `? lists all the F90 abbrevs.    "Typing `\\[help-command] or `? lists all the F90 abbrevs.
1673  Any other key combination is executed normally."  Any other key combination is executed normally."
1674    (interactive)    (interactive)
1675    (let (e c)    (let (c)
1676      (insert last-command-char)      (insert last-command-char)
1677      (if (not f90-xemacs-flag)      (setq c (if (fboundp 'next-command-event) ; XEmacs
1678          (setq c (read-event))                  (event-to-character (next-command-event))
1679        (setq e (next-command-event)                (read-event)))
             c (event-to-character e)))  
1680      ;; Insert char if not equal to `?'.      ;; Insert char if not equal to `?'.
1681      (if (or (eq c ??) (eq c help-char))      (if (or (eq c ??) (eq c help-char))
1682          (f90-abbrev-help)          (f90-abbrev-help)
1683        (if f90-xemacs-flag        (setq unread-command-events (list c)))))
           (setq unread-command-event e)  
         (setq unread-command-events (list c))))))  
1684    
1685  (defun f90-abbrev-help ()  (defun f90-abbrev-help ()
1686    "List the currently defined abbrevs in F90 mode."    "List the currently defined abbrevs in F90 mode."
# Line 1842  CHANGE-WORD should be one of 'upcase-wor Line 1741  CHANGE-WORD should be one of 'upcase-wor
1741             (concat "\\("             (concat "\\("
1742                     f90-keywords-re "\\|" f90-procedures-re "\\|"                     f90-keywords-re "\\|" f90-procedures-re "\\|"
1743                     f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))                     f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
1744            (ref-point (point-min))            (ref-point (point-min))
1745            (modified (buffer-modified-p))            (modified (buffer-modified-p))
1746            state saveword back-point)            state saveword back-point)
1747        (goto-char beg)        (goto-char beg)

Legend:
Removed from v.1.56  
changed lines
  Added in v.1.56.2.1

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