/[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.45 by gm, Wed May 1 15:29:30 2002 UTC revision 1.46 by gm, Wed May 1 23:34:58 2002 UTC
# Line 687  do\\([ \t]*while\\)?\\|select[ \t]*case\ Line 687  do\\([ \t]*while\\)?\\|select[ \t]*case\
687  (unless f90-mode-abbrev-table  (unless f90-mode-abbrev-table
688    (let ((ac abbrevs-changed))    (let ((ac abbrevs-changed))
689      (define-abbrev-table 'f90-mode-abbrev-table ())      (define-abbrev-table 'f90-mode-abbrev-table ())
690      (define-abbrev f90-mode-abbrev-table  "`al"  "allocate" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`al"  "allocate"      nil 0 t)
691      (define-abbrev f90-mode-abbrev-table  "`ab"  "allocatable" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`ab"  "allocatable"   nil 0 t)
692      (define-abbrev f90-mode-abbrev-table  "`as"  "assignment" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`as"  "assignment"    nil 0 t)
693      (define-abbrev f90-mode-abbrev-table  "`ba"  "backspace" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`ba"  "backspace"     nil 0 t)
694      (define-abbrev f90-mode-abbrev-table  "`bd"  "block data" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`bd"  "block data"    nil 0 t)
695      (define-abbrev f90-mode-abbrev-table  "`c"   "character" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`c"   "character"     nil 0 t)
696      (define-abbrev f90-mode-abbrev-table  "`cl"  "close" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`cl"  "close"         nil 0 t)
697      (define-abbrev f90-mode-abbrev-table  "`cm"  "common" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`cm"  "common"        nil 0 t)
698      (define-abbrev f90-mode-abbrev-table  "`cx"  "complex" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`cx"  "complex"       nil 0 t)
699      (define-abbrev f90-mode-abbrev-table  "`cn"  "contains" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`cn"  "contains"      nil 0 t)
700      (define-abbrev f90-mode-abbrev-table  "`cy"  "cycle" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`cy"  "cycle"         nil 0 t)
701      (define-abbrev f90-mode-abbrev-table  "`de"  "deallocate" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`de"  "deallocate"    nil 0 t)
702      (define-abbrev f90-mode-abbrev-table  "`df"  "define" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`df"  "define"        nil 0 t)
703      (define-abbrev f90-mode-abbrev-table  "`di"  "dimension" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`di"  "dimension"     nil 0 t)
704      (define-abbrev f90-mode-abbrev-table  "`dw"  "do while" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`dw"  "do while"      nil 0 t)
705      (define-abbrev f90-mode-abbrev-table  "`el"  "else" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`el"  "else"          nil 0 t)
706      (define-abbrev f90-mode-abbrev-table  "`eli" "else if" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`eli" "else if"       nil 0 t)
707      (define-abbrev f90-mode-abbrev-table  "`elw" "elsewhere" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`elw" "elsewhere"     nil 0 t)
708      (define-abbrev f90-mode-abbrev-table  "`eq"  "equivalence" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`eq"  "equivalence"   nil 0 t)
709      (define-abbrev f90-mode-abbrev-table  "`ex"  "external" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`ex"  "external"      nil 0 t)
710      (define-abbrev f90-mode-abbrev-table  "`ey"  "entry" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`ey"  "entry"         nil 0 t)
711      (define-abbrev f90-mode-abbrev-table  "`fl"  "forall" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`fl"  "forall"        nil 0 t)
712      (define-abbrev f90-mode-abbrev-table  "`fo"  "format" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`fo"  "format"        nil 0 t)
713      (define-abbrev f90-mode-abbrev-table  "`fu"  "function" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`fu"  "function"      nil 0 t)
714      (define-abbrev f90-mode-abbrev-table  "`fa"  ".false." nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`fa"  ".false."       nil 0 t)
715      (define-abbrev f90-mode-abbrev-table  "`im"  "implicit none" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`im"  "implicit none" nil 0 t)
716      (define-abbrev f90-mode-abbrev-table  "`in " "include" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`in " "include"       nil 0 t)
717      (define-abbrev f90-mode-abbrev-table  "`i"   "integer" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`i"   "integer"       nil 0 t)
718      (define-abbrev f90-mode-abbrev-table  "`it"  "intent" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`it"  "intent"        nil 0 t)
719      (define-abbrev f90-mode-abbrev-table  "`if"  "interface" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`if"  "interface"     nil 0 t)
720      (define-abbrev f90-mode-abbrev-table  "`lo"  "logical" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`lo"  "logical"       nil 0 t)
721      (define-abbrev f90-mode-abbrev-table  "`mo"  "module" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`mo"  "module"        nil 0 t)
722      (define-abbrev f90-mode-abbrev-table  "`na"  "namelist" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`na"  "namelist"      nil 0 t)
723      (define-abbrev f90-mode-abbrev-table  "`nu"  "nullify" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`nu"  "nullify"       nil 0 t)
724      (define-abbrev f90-mode-abbrev-table  "`op"  "optional" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`op"  "optional"      nil 0 t)
725      (define-abbrev f90-mode-abbrev-table  "`pa"  "parameter" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`pa"  "parameter"     nil 0 t)
726      (define-abbrev f90-mode-abbrev-table  "`po"  "pointer" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`po"  "pointer"       nil 0 t)
727      (define-abbrev f90-mode-abbrev-table  "`pr"  "print" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`pr"  "print"         nil 0 t)
728      (define-abbrev f90-mode-abbrev-table  "`pi"  "private" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`pi"  "private"       nil 0 t)
729      (define-abbrev f90-mode-abbrev-table  "`pm"  "program" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`pm"  "program"       nil 0 t)
730      (define-abbrev f90-mode-abbrev-table  "`pu"  "public" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`pu"  "public"        nil 0 t)
731      (define-abbrev f90-mode-abbrev-table  "`r"   "real" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`r"   "real"          nil 0 t)
732      (define-abbrev f90-mode-abbrev-table  "`rc"  "recursive" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`rc"  "recursive"     nil 0 t)
733      (define-abbrev f90-mode-abbrev-table  "`rt"  "return" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`rt"  "return"        nil 0 t)
734      (define-abbrev f90-mode-abbrev-table  "`rw"  "rewind" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`rw"  "rewind"        nil 0 t)
735      (define-abbrev f90-mode-abbrev-table  "`se"  "select" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`se"  "select"        nil 0 t)
736      (define-abbrev f90-mode-abbrev-table  "`sq"  "sequence" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`sq"  "sequence"      nil 0 t)
737      (define-abbrev f90-mode-abbrev-table  "`su"  "subroutine" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`su"  "subroutine"    nil 0 t)
738      (define-abbrev f90-mode-abbrev-table  "`ta"  "target" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`ta"  "target"        nil 0 t)
739      (define-abbrev f90-mode-abbrev-table  "`tr"  ".true." nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`tr"  ".true."        nil 0 t)
740      (define-abbrev f90-mode-abbrev-table  "`t"   "type" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`t"   "type"          nil 0 t)
741      (define-abbrev f90-mode-abbrev-table  "`wh"  "where" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`wh"  "where"         nil 0 t)
742      (define-abbrev f90-mode-abbrev-table  "`wr"  "write" nil 0 t)      (define-abbrev f90-mode-abbrev-table  "`wr"  "write"         nil 0 t)
743      (setq abbrevs-changed ac)))      (setq abbrevs-changed ac)))
744    
745  (defcustom f90-mode-hook nil  (defcustom f90-mode-hook nil
# Line 777  Variables controlling indentation style Line 777  Variables controlling indentation style
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 function \\[f90-comment-region] at start of each
781    region (default \"!!!$\").    line in 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 \"!\").
# Line 809  Turning on F90 mode calls the value of t Line 809  Turning on F90 mode calls the value of t
809  with no args, if that value is non-nil."  with no args, if that value is non-nil."
810    (interactive)    (interactive)
811    (kill-all-local-variables)    (kill-all-local-variables)
812    (setq major-mode 'f90-mode)    (setq major-mode 'f90-mode
813    (setq mode-name "F90")          mode-name "F90"
814    (setq local-abbrev-table f90-mode-abbrev-table)          local-abbrev-table f90-mode-abbrev-table)
815    (set-syntax-table f90-mode-syntax-table)    (set-syntax-table f90-mode-syntax-table)
816    (use-local-map f90-mode-map)    (use-local-map f90-mode-map)
817    (make-local-variable 'indent-line-function)    (set (make-local-variable 'indent-line-function) 'f90-indent-line)
818    (setq indent-line-function 'f90-indent-line)    (set (make-local-variable 'indent-region-function) 'f90-indent-region)
819    (make-local-variable 'indent-region-function)    (set (make-local-variable 'require-final-newline) t)
820    (setq indent-region-function 'f90-indent-region)    (set (make-local-variable 'comment-start) "!")
821    (make-local-variable 'require-final-newline)    (set (make-local-variable 'comment-start-skip) "!+ *")
822    (setq require-final-newline t)    (set (make-local-variable 'comment-indent-function) 'f90-comment-indent)
823    (make-local-variable 'comment-start)    (set (make-local-variable 'abbrev-all-caps) t)
824    (setq comment-start "!")    (set (make-local-variable 'normal-auto-fill-function) 'f90-do-auto-fill)
   (make-local-variable 'comment-start-skip)  
   (setq comment-start-skip "!+ *")  
   (make-local-variable 'comment-indent-function)  
   (setq comment-indent-function 'f90-comment-indent)  
   (make-local-variable 'abbrev-all-caps)  
   (setq abbrev-all-caps t)  
   (make-local-variable 'normal-auto-fill-function)  
   (setq normal-auto-fill-function 'f90-do-auto-fill)  
825    (setq indent-tabs-mode nil)    (setq indent-tabs-mode nil)
826    ;; Setting up things for font-lock.    ;; Setting up things for font-lock.
827    (when f90-xemacs-flag    (when f90-xemacs-flag
# Line 840  with no args, if that value is non-nil." Line 832  with no args, if that value is non-nil."
832        (set-buffer-menubar (copy-sequence current-menubar))        (set-buffer-menubar (copy-sequence current-menubar))
833        (add-submenu nil f90-xemacs-menu)))        (add-submenu nil f90-xemacs-menu)))
834    ;; XEmacs: Does not need a special case, since both emacsen work alike -sb.    ;; XEmacs: Does not need a special case, since both emacsen work alike -sb.
835    (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
836    (setq font-lock-defaults         '((f90-font-lock-keywords f90-font-lock-keywords-1
837          '((f90-font-lock-keywords f90-font-lock-keywords-1                                   f90-font-lock-keywords-2
838                                    f90-font-lock-keywords-2                                   f90-font-lock-keywords-3
839                                    f90-font-lock-keywords-3                                   f90-font-lock-keywords-4)
840                                    f90-font-lock-keywords-4)           nil t))
           nil t))  
841    ;; Tell imenu how to handle f90.    ;; Tell imenu how to handle f90.
842    (set (make-local-variable 'imenu-case-fold-search) t)    (set (make-local-variable 'imenu-case-fold-search) t)
843    (make-local-variable 'imenu-generic-expression)    (set (make-local-variable 'imenu-generic-expression)
844    (setq imenu-generic-expression f90-imenu-generic-expression)          f90-imenu-generic-expression)
845    (set (make-local-variable 'add-log-current-defun-function)    (set (make-local-variable 'add-log-current-defun-function)
846         #'f90-current-defun)         #'f90-current-defun)
847    (run-hooks 'f90-mode-hook))    (run-hooks 'f90-mode-hook))
# Line 884  not the last line of a continued stateme Line 875  not the last line of a continued stateme
875    (save-excursion    (save-excursion
876      (beginning-of-line)      (beginning-of-line)
877      (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1))))      (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1))))
878      (let ((bol (line-beginning-position)))      (end-of-line)
879        (end-of-line)      (while (f90-in-comment)
880        (while (f90-in-comment)        (search-backward "!" (line-beginning-position))
881          (search-backward "!" bol)        (skip-chars-backward "!"))
882          (skip-chars-backward "!"))      (skip-chars-backward " \t")
883        (skip-chars-backward " \t")      (= (preceding-char) ?&)))
       (= (preceding-char) ?&))))  
884    
885  (defsubst f90-current-indentation ()  (defsubst f90-current-indentation ()
886    "Return indentation of current line.    "Return indentation of current line.
887  Line-numbers are considered whitespace characters."  Line-numbers are considered whitespace characters."
888    (save-excursion    (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")))
     (beginning-of-line) (skip-chars-forward " \t0-9")))  
889    
890  (defsubst f90-indent-to (col &optional no-line-number)  (defsubst f90-indent-to (col &optional no-line-number)
891    "Indent current line to column COL.    "Indent current line to column COL.
# Line 914  line-number before indenting." Line 903  line-number before indenting."
903    "If point lies within a comment, return the string starting the comment.    "If point lies within a comment, return the string starting the comment.
904  For example, \"!\" or \"!!\"."  For example, \"!\" or \"!!\"."
905    (save-excursion    (save-excursion
906      (let ((type nil) (eol (line-end-position)))      (when (f90-in-comment)
907        (when (f90-in-comment)        (beginning-of-line)
908          (beginning-of-line)        (re-search-forward "[!]+" (line-end-position))
909          (re-search-forward "[!]+" eol)        (while (f90-in-string)
910          (while (f90-in-string)          (re-search-forward "[!]+" (line-end-position))
911            (re-search-forward "[!]+" eol))          (match-string 0)))))
         (setq type (match-string 0)))  
       type)))  
912    
913  (defsubst f90-equal-symbols (a b)  (defsubst f90-equal-symbols (a b)
914    "Compare strings A and B neglecting case and allowing for nil value."    "Compare strings A and B neglecting case and allowing for nil value."
# Line 956  NAME is nil if the statement has no labe Line 943  NAME is nil if the statement has no labe
943    "Return (\"if\" NAME) if an if () then statement starts after point.    "Return (\"if\" NAME) if an if () then statement starts after point.
944  NAME is nil if the statement has no label."  NAME is nil if the statement has no label."
945    (save-excursion    (save-excursion
946      (let (struct (label nil))      (when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
947        (when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")        (let (label
948          (setq struct (match-string 3))              (struct (match-string 3)))
949          (if (looking-at "\\(\\sw+\\)[ \t]*\:")          (if (looking-at "\\(\\sw+\\)[ \t]*\:")
950              (setq label (match-string 1)))              (setq label (match-string 1)))
951          (let ((pos (scan-lists (point) 1 0)))          (let ((pos (scan-lists (point) 1 0)))
# Line 1039  middle - current line is neither first n Line 1026  middle - current line is neither first n
1026  Comment lines embedded amongst continued lines return 'middle."  Comment lines embedded amongst continued lines return 'middle."
1027    (let (pcont cont)    (let (pcont cont)
1028      (save-excursion      (save-excursion
1029        (setq pcont (if (f90-previous-statement) (f90-line-continued) nil)))        (setq pcont (if (f90-previous-statement) (f90-line-continued))))
1030      (setq cont (f90-line-continued))      (setq cont (f90-line-continued))
1031      (cond ((and (not pcont) (not cont)) 'single)      (cond ((and (not pcont) (not cont)) 'single)
1032            ((and (not pcont) cont)       'begin)            ((and (not pcont) cont)       'begin)
1033            ((and pcont       (not cont)) 'end)            ((and pcont       (not cont)) 'end)
1034            ((and pcont       cont)       'middle)            ((and pcont       cont)       'middle)
1035            (t (error)))))            (t (error "The impossible occurred")))))
1036    
1037  (defsubst f90-indent-line-no ()  (defsubst f90-indent-line-no ()
1038    "If `f90-leave-line-no' is nil, left-justify a line number.    "If `f90-leave-line-no' is nil, left-justify a line number.
# Line 1098  Does not check type and subprogram inden Line 1085  Does not check type and subprogram inden
1085        (beginning-of-line)        (beginning-of-line)
1086        (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"        (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
1087                                 (line-end-position) t)                                 (line-end-position) t)
1088          (beginning-of-line) (skip-chars-forward " \t")          (beginning-of-line)
1089            (skip-chars-forward " \t")
1090          (cond ((f90-looking-at-do)          (cond ((f90-looking-at-do)
1091                 (setq icol (+ icol f90-do-indent)))                 (setq icol (+ icol f90-do-indent)))
1092                ((or (f90-looking-at-if-then)                ((or (f90-looking-at-if-then)
# Line 1108  Does not check type and subprogram inden Line 1096  Does not check type and subprogram inden
1096          (end-of-line))          (end-of-line))
1097        (while (re-search-forward        (while (re-search-forward
1098                "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)                "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
1099          (beginning-of-line) (skip-chars-forward " \t0-9")          (beginning-of-line)
1100          (cond  ((f90-looking-at-do)          (skip-chars-forward " \t0-9")
1101                  (setq icol (+ icol f90-do-indent)))          (cond ((f90-looking-at-do)
1102                 ((or (f90-looking-at-if-then)                 (setq icol (+ icol f90-do-indent)))
1103                      (f90-looking-at-where-or-forall)                ((or (f90-looking-at-if-then)
1104                      (f90-looking-at-select-case))                     (f90-looking-at-where-or-forall)
1105                  (setq icol (+ icol f90-if-indent)))                     (f90-looking-at-select-case))
1106                 ((looking-at f90-end-if-re)                 (setq icol (+ icol f90-if-indent)))
1107                  (setq icol (- icol f90-if-indent)))                ((looking-at f90-end-if-re)
1108                 ((looking-at "end[ \t]*do\\>")                 (setq icol (- icol f90-if-indent)))
1109                  (setq icol (- icol f90-do-indent))))                ((looking-at "end[ \t]*do\\>")
1110                   (setq icol (- icol f90-do-indent))))
1111          (end-of-line))          (end-of-line))
1112        icol)))        icol)))
1113    
# Line 1136  Does not check type and subprogram inden Line 1125  Does not check type and subprogram inden
1125          (cond ((eq cont 'begin)          (cond ((eq cont 'begin)
1126                 (setq icol (+ (f90-current-indentation)                 (setq icol (+ (f90-current-indentation)
1127                               f90-continuation-indent)))                               f90-continuation-indent)))
1128                ((eq cont 'middle) (setq icol(current-indentation)))                ((eq cont 'middle) (setq icol (current-indentation)))
1129                (t (setq icol (f90-current-indentation))                (t (setq icol (f90-current-indentation))
1130                   (skip-chars-forward " \t")                   (skip-chars-forward " \t")
1131                   (if (looking-at "[0-9]")                   (if (looking-at "[0-9]")
# Line 1201  Return nil if no later statement is foun Line 1190  Return nil if no later statement is foun
1190  Return (TYPE NAME), or nil if not found."  Return (TYPE NAME), or nil if not found."
1191    (interactive)    (interactive)
1192    (let ((count 1) (case-fold-search t) matching-beg)    (let ((count 1) (case-fold-search t) matching-beg)
1193      (beginning-of-line) (skip-chars-forward " \t0-9")      (beginning-of-line)
1194        (skip-chars-forward " \t0-9")
1195      (if (setq matching-beg (f90-looking-at-program-block-start))      (if (setq matching-beg (f90-looking-at-program-block-start))
1196          (setq count (- count 1)))          (setq count (1- count)))
1197      (while (and (not (zerop count))      (while (and (not (zerop count))
1198                  (re-search-backward f90-program-block-re nil 'move))                  (re-search-backward f90-program-block-re nil 'move))
1199        (beginning-of-line) (skip-chars-forward " \t0-9")        (beginning-of-line)
1200        (cond        (skip-chars-forward " \t0-9")
1201         ((setq matching-beg (f90-looking-at-program-block-start))        (cond ((setq matching-beg (f90-looking-at-program-block-start))
1202          (setq count (- count 1)))               (setq count (1- count)))
1203         ((f90-looking-at-program-block-end)              ((f90-looking-at-program-block-end)
1204          (setq count (+ count 1)))))               (setq count (1+ count)))))
1205      (beginning-of-line)      (beginning-of-line)
1206      (if (zerop count)      (if (zerop count)
1207          matching-beg          matching-beg
# Line 1223  Return (TYPE NAME), or nil if not found. Line 1213  Return (TYPE NAME), or nil if not found.
1213  Return (TYPE NAME), or nil if not found."  Return (TYPE NAME), or nil if not found."
1214    (interactive)    (interactive)
1215    (let ((count 1) (case-fold-search t) matching-end)    (let ((count 1) (case-fold-search t) matching-end)
1216      (beginning-of-line) (skip-chars-forward " \t0-9")      (beginning-of-line)
1217        (skip-chars-forward " \t0-9")
1218      (if (setq matching-end (f90-looking-at-program-block-end))      (if (setq matching-end (f90-looking-at-program-block-end))
1219          (setq count (1- count)))          (setq count (1- count)))
1220      (end-of-line)      (end-of-line)
1221      (while (and (not (zerop count))      (while (and (not (zerop count))
1222                  (re-search-forward f90-program-block-re nil 'move))                  (re-search-forward f90-program-block-re nil 'move))
1223        (beginning-of-line) (skip-chars-forward " \t0-9")        (beginning-of-line)
1224          (skip-chars-forward " \t0-9")
1225        (cond ((f90-looking-at-program-block-start)        (cond ((f90-looking-at-program-block-start)
1226               (setq count (+ count 1)))               (setq count (1+ count)))
1227              ((setq matching-end (f90-looking-at-program-block-end))              ((setq matching-end (f90-looking-at-program-block-end))
1228               (setq count (1- count ))))               (setq count (1- count))))
1229        (end-of-line))        (end-of-line))
1230      (forward-line 1)      (forward-line 1)
1231      (if (zerop count)      (if (zerop count)
# Line 1281  in the region, or, if already present, r Line 1273  in the region, or, if already present, r
1273      (if (looking-at (regexp-quote f90-comment-region))      (if (looking-at (regexp-quote f90-comment-region))
1274          (delete-region (point) (match-end 0))          (delete-region (point) (match-end 0))
1275        (insert f90-comment-region))        (insert f90-comment-region))
1276      (while (and  (zerop (forward-line 1))      (while (and (zerop (forward-line 1))
1277                   (< (point) (marker-position end)))                  (< (point) (marker-position end)))
1278        (if (looking-at (regexp-quote f90-comment-region))        (if (looking-at (regexp-quote f90-comment-region))
1279            (delete-region (point) (match-end 0))            (delete-region (point) (match-end 0))
1280          (insert f90-comment-region)))          (insert f90-comment-region)))
# Line 1293  in the region, or, if already present, r Line 1285  in the region, or, if already present, r
1285  Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'  Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'
1286  after indenting."  after indenting."
1287    (interactive)    (interactive)
1288    (let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t))    (let (indent no-line-number (pos (make-marker)) (case-fold-search t))
1289      (set-marker pos (point))      (set-marker pos (point))
1290      (beginning-of-line)                 ; digits after & \n are not line-nos      (beginning-of-line)                 ; digits after & \n are not line-nos
1291      (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))      (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))
# Line 1304  after indenting." Line 1296  after indenting."
1296        (if (and (looking-at "end") f90-smart-end)        (if (and (looking-at "end") f90-smart-end)
1297            (f90-match-end))            (f90-match-end))
1298        (setq indent (f90-calculate-indent)))        (setq indent (f90-calculate-indent)))
1299      (if (zerop (- indent (current-column)))      (if (not (zerop (- indent (current-column))))
1300          nil          (f90-indent-to indent no-line-number))
       (f90-indent-to indent no-line-number))  
1301      ;; If initial point was within line's indentation,      ;; If initial point was within line's indentation,
1302      ;; position after the indentation.  Else stay at same point in text.      ;; position after the indentation.  Else stay at same point in text.
1303      (if (< (point) (marker-position pos))      (if (< (point) (marker-position pos))
# Line 1328  If run in the middle of a line, the line Line 1319  If run in the middle of a line, the line
1319      (f90-indent-line 'no-update)      (f90-indent-line 'no-update)
1320      (end-of-line)      (end-of-line)
1321      (delete-horizontal-space)           ; destroy trailing whitespace      (delete-horizontal-space)           ; destroy trailing whitespace
1322      (setq string (f90-in-string))      (setq string (f90-in-string)
1323      (setq cont (f90-line-continued))            cont (f90-line-continued))
1324      (if (and string (not cont)) (insert "&"))      (if (and string (not cont)) (insert "&"))
1325      (f90-update-line)      (f90-update-line)
1326      (newline)      (newline)
# Line 1340  If run in the middle of a line, the line Line 1331  If run in the middle of a line, the line
1331  (defun f90-indent-region (beg-region end-region)  (defun f90-indent-region (beg-region end-region)
1332    "Indent every line in region by forward parsing."    "Indent every line in region by forward parsing."
1333    (interactive "*r")    (interactive "*r")
1334    (let ((end-region-mark (make-marker)) (save-point (point-marker))    (let ((end-region-mark (make-marker))
1335          (block-list nil) ind-lev ind-curr ind-b cont          (save-point (point-marker))
1336            block-list ind-lev ind-curr ind-b cont
1337          struct beg-struct end-struct)          struct beg-struct end-struct)
1338      (set-marker end-region-mark end-region)      (set-marker end-region-mark end-region)
1339      (goto-char beg-region)      (goto-char beg-region)
# Line 1358  If run in the middle of a line, the line Line 1350  If run in the middle of a line, the line
1350      ;; Process present line for beginning of block.      ;; Process present line for beginning of block.
1351      (setq f90-cache-position (point))      (setq f90-cache-position (point))
1352      (f90-indent-line 'no-update)      (f90-indent-line 'no-update)
1353      (setq ind-lev (f90-current-indentation))      (setq ind-lev (f90-current-indentation)
1354      (setq ind-curr ind-lev)            ind-curr ind-lev)
1355      (beginning-of-line) (skip-chars-forward " \t0-9")      (beginning-of-line)
1356      (setq struct nil)      (skip-chars-forward " \t0-9")
1357      (setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)      (setq struct nil
1358              ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
1359                        ((or (setq struct (f90-looking-at-if-then))                        ((or (setq struct (f90-looking-at-if-then))
1360                             (setq struct (f90-looking-at-select-case))                             (setq struct (f90-looking-at-select-case))
1361                             (setq struct (f90-looking-at-where-or-forall))                             (setq struct (f90-looking-at-where-or-forall))
# Line 1448  If run in the middle of a line, the line Line 1441  If run in the middle of a line, the line
1441    "Properly indent the subprogram containing point."    "Properly indent the subprogram containing point."
1442    (interactive)    (interactive)
1443    (save-excursion    (save-excursion
1444      (let (program)      (let ((program (f90-mark-subprogram)))
       (setq program (f90-mark-subprogram))  
1445        (if program        (if program
1446            (progn            (progn
1447              (message "Indenting %s %s..."              (message "Indenting %s %s..."
# Line 1502  Update keyword case first." Line 1494  Update keyword case first."
1494    (while (> (current-column) fill-column)    (while (> (current-column) fill-column)
1495      (let ((pos-mark (point-marker)))      (let ((pos-mark (point-marker)))
1496        (move-to-column fill-column)        (move-to-column fill-column)
1497        (if (not (f90-in-string))        (or (f90-in-string) (f90-find-breakpoint))
           (f90-find-breakpoint))  
1498        (f90-break-line)        (f90-break-line)
1499        (goto-char pos-mark)        (goto-char pos-mark)
1500        (set-marker pos-mark nil))))        (set-marker pos-mark nil))))
# Line 1515  Update keyword case first." Line 1506  Update keyword case first."
1506    (let (pos (oldpos (point)))    (let (pos (oldpos (point)))
1507      (end-of-line)      (end-of-line)
1508      (skip-chars-backward " \t")      (skip-chars-backward " \t")
1509      (cond ((= (preceding-char) ?&)      (when (= (preceding-char) ?&)
1510             (delete-char -1)        (delete-char -1)
1511             (setq pos (point))        (setq pos (point))
1512             (forward-line 1)        (forward-line 1)
1513             (skip-chars-forward " \t")        (skip-chars-forward " \t")
1514             (if (looking-at "\&") (delete-char 1))        (if (looking-at "\&") (delete-char 1))
1515             (delete-region pos (point))        (delete-region pos (point))
1516             (unless (f90-in-string)        (unless (f90-in-string)
1517               (delete-horizontal-space)          (delete-horizontal-space)
1518               (insert " "))          (insert " "))
1519             (if (and auto-fill-function        (if (and auto-fill-function
1520                      (> (save-excursion (end-of-line)                 (> (line-end-position) fill-column))
1521                                         (current-column))            (f90-do-auto-fill))
1522                         fill-column))        (goto-char oldpos)
1523                 (f90-do-auto-fill))        t)))                              ; return t if joined something
            (goto-char oldpos)  
            t))))  
1524    
1525  (defun f90-fill-region (beg-region end-region)  (defun f90-fill-region (beg-region end-region)
1526    "Fill every line in region by forward parsing.  Join lines if possible."    "Fill every line in region by forward parsing.  Join lines if possible."
1527    (interactive "*r")    (interactive "*r")
1528    (let ((end-region-mark (make-marker))    (let ((end-region-mark (make-marker))
1529          (f90-smart-end nil) (f90-auto-keyword-case nil) (go-on t)          (go-on t)
1530          (auto-fill-function nil))          f90-smart-end f90-auto-keyword-case auto-fill-function)
1531      (set-marker end-region-mark end-region)      (set-marker end-region-mark end-region)
1532      (goto-char beg-region)      (goto-char beg-region)
1533      (while go-on      (while go-on
# Line 1550  Update keyword case first." Line 1539  Update keyword case first."
1539          (move-to-column fill-column)          (move-to-column fill-column)
1540          (f90-find-breakpoint)          (f90-find-breakpoint)
1541          (f90-break-line 'no-update))          (f90-break-line 'no-update))
1542        (setq go-on (and  (< (point) (marker-position end-region-mark))        (setq go-on (and (< (point) (marker-position end-region-mark))
1543                          (zerop (forward-line 1))))                         (zerop (forward-line 1)))
1544        (setq f90-cache-position (point)))              f90-cache-position (point)))
1545      (setq f90-cache-position nil)      (setq f90-cache-position nil)
1546      (if f90-xemacs-flag      (if f90-xemacs-flag
1547          (zmacs-deactivate-region)          (zmacs-deactivate-region)
# Line 1594  Leave point at the end of line." Line 1583  Leave point at the end of line."
1583  (defun f90-match-end ()  (defun f90-match-end ()
1584    "From an end block statement, find the corresponding block and name."    "From an end block statement, find the corresponding block and name."
1585    (interactive)    (interactive)
1586    (let ((count 1) (top-of-window (window-start)) (matching-beg nil)    (let ((count 1) (top-of-window (window-start))
1587          (end-point (point)) (case-fold-search t)          (end-point (point)) (case-fold-search t)
1588          beg-name end-name beg-block end-block end-struct)          matching-beg beg-name end-name beg-block end-block end-struct)
1589      (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")      (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
1590                            (setq end-struct (f90-looking-at-program-block-end)))                            (setq end-struct (f90-looking-at-program-block-end)))
1591        (setq end-block (car end-struct))        (setq end-block (car end-struct)
1592        (setq end-name  (car (cdr end-struct)))              end-name  (car (cdr end-struct)))
1593        (save-excursion        (save-excursion
1594          (beginning-of-line)          (beginning-of-line)
1595          (while          (while
# Line 1616  Leave point at the end of line." Line 1605  Leave point at the end of line."
1605                               (not (or (f90-in-string)                               (not (or (f90-in-string)
1606                                        (f90-in-comment))))))                                        (f90-in-comment))))))
1607                     (not notexist)))                     (not notexist)))
1608            (beginning-of-line) (skip-chars-forward " \t0-9")            (beginning-of-line)
1609              (skip-chars-forward " \t0-9")
1610            (cond ((setq matching-beg            (cond ((setq matching-beg
1611                         (cond                         (or
1612                          ((f90-looking-at-do))                          (f90-looking-at-do)
1613                          ((f90-looking-at-if-then))                          (f90-looking-at-if-then)
1614                          ((f90-looking-at-where-or-forall))                          (f90-looking-at-where-or-forall)
1615                          ((f90-looking-at-select-case))                          (f90-looking-at-select-case)
1616                          ((f90-looking-at-type-like))                          (f90-looking-at-type-like)
1617                          ((f90-looking-at-program-block-start))))                          (f90-looking-at-program-block-start)))
1618                   (setq count (- count 1)))                   (setq count (1- count)))
1619                  ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))                  ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))
1620                   (setq count (+ count 1)))))                   (setq count (1+ count)))))
1621          (if (not (zerop count))          (if (not (zerop count))
1622              (message "No matching beginning.")              (message "No matching beginning.")
1623            (f90-update-line)            (f90-update-line)
# Line 1639  Leave point at the end of line." Line 1629  Leave point at the end of line."
1629                              (line-beginning-position)                              (line-beginning-position)
1630                              (line-end-position)))                              (line-end-position)))
1631                  (sit-for 1)))                  (sit-for 1)))
1632            (setq beg-block (car matching-beg))            (setq beg-block (car matching-beg)
1633            (setq beg-name (car (cdr matching-beg)))                  beg-name (car (cdr matching-beg)))
1634            (goto-char end-point)            (goto-char end-point)
1635            (beginning-of-line)            (beginning-of-line)
1636            (f90-block-match beg-block beg-name end-block end-name))))))            (f90-block-match beg-block beg-name end-block end-name))))))
# Line 1648  Leave point at the end of line." Line 1638  Leave point at the end of line."
1638  (defun f90-insert-end ()  (defun f90-insert-end ()
1639    "Insert a complete end statement matching beginning of present block."    "Insert a complete end statement matching beginning of present block."
1640    (interactive)    (interactive)
1641    (let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink)))    (let ((f90-smart-end (or f90-smart-end 'blink)))
1642      (insert "end")      (insert "end")
1643      (f90-indent-new-line)))      (f90-indent-new-line)))
1644    
# Line 1724  Any other key combination is executed no Line 1714  Any other key combination is executed no
1714    "Change the case of F90 keywords in the region (if specified) or buffer.    "Change the case of F90 keywords in the region (if specified) or buffer.
1715  CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word."  CHANGE-WORD should be one of 'upcase-word, 'downcase-word, capitalize-word."
1716    (save-excursion    (save-excursion
1717      (setq beg (if beg beg (point-min)))      (setq beg (or beg (point-min))
1718      (setq end (if end end (point-max)))            end (or end (point-max)))
1719      (let ((keyword-re      (let ((keyword-re
1720             (concat "\\("             (concat "\\("
1721                     f90-keywords-re "\\|" f90-procedures-re "\\|"                     f90-keywords-re "\\|" f90-procedures-re "\\|"
1722                     f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))                     f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
1723            (ref-point (point-min)) state            (ref-point (point-min))
1724            (modified (buffer-modified-p)) saveword back-point)            (modified (buffer-modified-p))
1725              state saveword back-point)
1726        (goto-char beg)        (goto-char beg)
1727        (unwind-protect        (unwind-protect
1728            (while (re-search-forward keyword-re end t)            (while (re-search-forward keyword-re end t)
# Line 1743  CHANGE-WORD should be one of 'upcase-wor Line 1734  CHANGE-WORD should be one of 'upcase-wor
1734                              (skip-chars-forward " \t0-9")                              (skip-chars-forward " \t0-9")
1735                              (looking-at "#"))))                              (looking-at "#"))))
1736                (setq ref-point (point)                (setq ref-point (point)
1737                      back-point (save-excursion (backward-word 1) (point)))                      back-point (save-excursion (backward-word 1) (point))
1738                (setq saveword (buffer-substring back-point ref-point))                      saveword (buffer-substring back-point ref-point))
1739                (funcall change-word -1)                (funcall change-word -1)
1740                (or (string= saveword (buffer-substring back-point ref-point))                (or (string= saveword (buffer-substring back-point ref-point))
1741                    (setq modified t))))                    (setq modified t))))

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

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