/[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.68 by gm, Tue Apr 15 19:18:23 2003 UTC revision 1.69 by gm, Wed Apr 16 11:08:58 2003 UTC
# Line 770  with no args, if that value is non-nil." Line 770  with no args, if that value is non-nil."
770                                   f90-font-lock-keywords-3                                   f90-font-lock-keywords-3
771                                   f90-font-lock-keywords-4)                                   f90-font-lock-keywords-4)
772           nil t))           nil t))
   ;; Tell imenu how to handle f90.  
773    (set (make-local-variable 'imenu-case-fold-search) t)    (set (make-local-variable 'imenu-case-fold-search) t)
774    (set (make-local-variable 'imenu-generic-expression)    (set (make-local-variable 'imenu-generic-expression)
775         f90-imenu-generic-expression)         f90-imenu-generic-expression)
# Line 817  not the last line of a continued stateme Line 816  not the last line of a continued stateme
816      (skip-chars-backward " \t")      (skip-chars-backward " \t")
817      (= (preceding-char) ?&)))      (= (preceding-char) ?&)))
818    
819    ;; GM this is not right, eg a continuation line starting with a number.
820    ;; Need f90-code-start-position function.
821    ;; And yet, things seems to work with this...
822  (defsubst f90-current-indentation ()  (defsubst f90-current-indentation ()
823    "Return indentation of current line.    "Return indentation of current line.
824  Line-numbers are considered whitespace characters."  Line-numbers are considered whitespace characters."
# Line 827  Line-numbers are considered whitespace c Line 829  Line-numbers are considered whitespace c
829  If optional argument NO-LINE-NUMBER is nil, jump over a possible  If optional argument NO-LINE-NUMBER is nil, jump over a possible
830  line-number before indenting."  line-number before indenting."
831    (beginning-of-line)    (beginning-of-line)
832    (if (not no-line-number)    (or no-line-number
833        (skip-chars-forward " \t0-9"))        (skip-chars-forward " \t0-9"))
834    (delete-horizontal-space)    (delete-horizontal-space)
835    (if (zerop (current-column))    ;; Leave >= 1 space after line number.
836        (indent-to col)    (indent-to col (if (zerop (current-column)) 0 1)))
     (indent-to col 1)))                 ; leave >= 1 space after line number  
837    
838  (defsubst f90-get-present-comment-type ()  (defsubst f90-get-present-comment-type ()
839    "If point lies within a comment, return the string starting the comment.    "If point lies within a comment, return the string starting the comment.
# Line 850  For example, \"!\" or \"!!\"." Line 851  For example, \"!\" or \"!!\"."
851    (equal (if a (downcase a) nil)    (equal (if a (downcase a) nil)
852           (if b (downcase b) nil)))           (if b (downcase b) nil)))
853    
 ;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp.  
 ;; The next 2 functions are therefore longer than necessary.  
854  (defsubst f90-looking-at-do ()  (defsubst f90-looking-at-do ()
855    "Return (\"do\" NAME) if a do statement starts after point.    "Return (\"do\" NAME) if a do statement starts after point.
856  NAME is nil if the statement has no label."  NAME is nil if the statement has no label."
857    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>")    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>")
858        (list (match-string 3)        (list (match-string 3) (match-string 2)))
             (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))))  
859    
860  (defsubst f90-looking-at-select-case ()  (defsubst f90-looking-at-select-case ()
861    "Return (\"select\" NAME) if a select-case statement starts after point.    "Return (\"select\" NAME) if a select-case statement starts after point.
862  NAME is nil if the statement has no label."  NAME is nil if the statement has no label."
863    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\    (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
864  \\(select\\)[ \t]*case[ \t]*(")  \\(select\\)[ \t]*case[ \t]*(")
865        (list (match-string 3)        (list (match-string 3) (match-string 2))))
             (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))))  
866    
867  (defsubst f90-looking-at-if-then ()  (defsubst f90-looking-at-if-then ()
868    "Return (\"if\" NAME) if an if () then statement starts after point.    "Return (\"if\" NAME) if an if () then statement starts after point.
# Line 873  NAME is nil if the statement has no labe Line 870  NAME is nil if the statement has no labe
870    (save-excursion    (save-excursion
871      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>")      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>")
872        (let ((struct (match-string 3))        (let ((struct (match-string 3))
873              (label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))              (label (match-string 2))
874              (pos (scan-lists (point) 1 0)))              (pos (scan-lists (point) 1 0)))
875          (and pos (goto-char pos))          (and pos (goto-char pos))
876          (skip-chars-forward " \t")          (skip-chars-forward " \t")
# Line 891  NAME is nil if the statement has no labe Line 888  NAME is nil if the statement has no labe
888      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\      (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\
889  \\(where\\|forall\\)\\>")  \\(where\\|forall\\)\\>")
890        (let ((struct (match-string 3))        (let ((struct (match-string 3))
891              (label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1)))              (label (match-string 2))
892              (pos (scan-lists (point) 1 0)))              (pos (scan-lists (point) 1 0)))
893          (and pos (goto-char pos))          (and pos (goto-char pos))
894          (skip-chars-forward " \t")          (skip-chars-forward " \t")
# Line 915  NAME is non-nil only for type." Line 912  NAME is non-nil only for type."
912           (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))           (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
913      (list (match-string 1) (match-string 2)))      (list (match-string 1) (match-string 2)))
914     ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))     ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
915           (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)\           (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
916  [ \t]+\\(\\sw+\\)"))  \\(\\sw+\\)"))
917      (list (match-string 1) (match-string 2)))))      (list (match-string 1) (match-string 2)))))
918    
919  (defsubst f90-looking-at-program-block-end ()  (defsubst f90-looking-at-program-block-end ()
# Line 966  Comment lines embedded amongst continued Line 963  Comment lines embedded amongst continued
963    "If `f90-leave-line-no' is nil, left-justify a line number.    "If `f90-leave-line-no' is nil, left-justify a line number.
964  Leaves point at the first non-blank character after the line number.  Leaves point at the first non-blank character after the line number.
965  Call from beginning of line."  Call from beginning of line."
966    (if (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]"))    (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]")
967        (delete-horizontal-space))         (delete-horizontal-space))
968    (skip-chars-forward " \t0-9"))    (skip-chars-forward " \t0-9"))
969    
970  (defsubst f90-no-block-limit ()  (defsubst f90-no-block-limit ()
971    "Return nil if point is at the edge of a code block.    "Return nil if point is at the edge of a code block.
972  Searches line forward for \"function\" or \"subroutine\",  Searches line forward for \"function\" or \"subroutine\",
973  if all else fails."  if all else fails."
974    (let ((eol (line-end-position)))    (save-excursion
975      (save-excursion      (not (or (looking-at "end")
976        (not (or (looking-at "end")               (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
                (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\  
977  \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")  \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
978                 (looking-at "\\(program\\|module\\|interface\\|\               (looking-at "\\(program\\|module\\|interface\\|\
979  block[ \t]*data\\)\\>")  block[ \t]*data\\)\\>")
980                 (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")               (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
981                 (looking-at f90-type-def-re)               (looking-at f90-type-def-re)
982                 (re-search-forward "\\(function\\|subroutine\\)" eol t))))))               (re-search-forward "\\(function\\|subroutine\\)"
983                                    (line-end-position) t)))))
984    
985  (defsubst f90-update-line ()  (defsubst f90-update-line ()
986    "Change case of current line as per `f90-auto-keyword-case'."    "Change case of current line as per `f90-auto-keyword-case'."
# Line 1196  and completes outermost block if necessa Line 1193  and completes outermost block if necessa
1193                       start-list (cdr start-list)                       start-list (cdr start-list)
1194                       start-type (car start-this)                       start-type (car start-this)
1195                       start-label (cadr start-this))                       start-label (cadr start-this))
1196                 (if (not (f90-equal-symbols start-type end-type))                 (or (f90-equal-symbols start-type end-type)
1197                     (error "End type `%s' does not match start type `%s'"                     (error "End type `%s' does not match start type `%s'"
1198                            end-type start-type))                            end-type start-type))
1199                 (if (not (f90-equal-symbols start-label end-label))                 (or (f90-equal-symbols start-label end-label)
1200                     (error "End label `%s' does not match start label `%s'"                     (error "End label `%s' does not match start label `%s'"
1201                            end-label start-label)))))                            end-label start-label)))))
1202        (end-of-line))        (end-of-line))
# Line 1221  Does not check the outermost block, beca Line 1218  Does not check the outermost block, beca
1218    (if (and num (< num 0)) (f90-end-of-block (- num)))    (if (and num (< num 0)) (f90-end-of-block (- num)))
1219    (let ((case-fold-search t)    (let ((case-fold-search t)
1220          (count (or num 1))          (count (or num 1))
1221          end-list end-this end-type end-label start-this start-type start-label)          end-list end-this end-type end-label
1222            start-this start-type start-label)
1223      (if (interactive-p) (push-mark (point) t))      (if (interactive-p) (push-mark (point) t))
1224      (beginning-of-line)                 ; probably want this      (beginning-of-line)                 ; probably want this
1225      (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move))      (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move))
# Line 1250  Does not check the outermost block, beca Line 1248  Does not check the outermost block, beca
1248                       end-list (cdr end-list)                       end-list (cdr end-list)
1249                       end-type (car end-this)                       end-type (car end-this)
1250                       end-label (cadr end-this))                       end-label (cadr end-this))
1251                 (if (not (f90-equal-symbols start-type end-type))                 (or (f90-equal-symbols start-type end-type)
1252                     (error "Start type `%s' does not match end type `%s'"                     (error "Start type `%s' does not match end type `%s'"
1253                            start-type end-type))                            start-type end-type))
1254                 (if (not (f90-equal-symbols start-label end-label))                 (or (f90-equal-symbols start-label end-label)
1255                     (error "Start label `%s' does not match end label `%s'"                     (error "Start label `%s' does not match end label `%s'"
1256                            start-label end-label))))))                            start-label end-label))))))
1257       (if (> count 0) (error "Missing block start"))))       (if (> count 0) (error "Missing block start"))))
# Line 1313  A block is a subroutine, if-endif, etc." Line 1311  A block is a subroutine, if-endif, etc."
1311  Insert the variable `f90-comment-region' at the start of every line  Insert the variable `f90-comment-region' at the start of every line
1312  in the region, or, if already present, remove it."  in the region, or, if already present, remove it."
1313    (interactive "*r")    (interactive "*r")
1314    (let ((end (make-marker)))    (let ((end (copy-marker end-region)))
     (set-marker end end-region)  
1315      (goto-char beg-region)      (goto-char beg-region)
1316      (beginning-of-line)      (beginning-of-line)
1317      (if (looking-at (regexp-quote f90-comment-region))      (if (looking-at (regexp-quote f90-comment-region))
1318          (delete-region (point) (match-end 0))          (delete-region (point) (match-end 0))
1319        (insert f90-comment-region))        (insert f90-comment-region))
1320      (while (and (zerop (forward-line 1))      (while (and (zerop (forward-line 1))
1321                  (< (point) (marker-position end)))                  (< (point) end))
1322        (if (looking-at (regexp-quote f90-comment-region))        (if (looking-at (regexp-quote f90-comment-region))
1323            (delete-region (point) (match-end 0))            (delete-region (point) (match-end 0))
1324          (insert f90-comment-region)))          (insert f90-comment-region)))
# Line 1332  in the region, or, if already present, r Line 1329  in the region, or, if already present, r
1329  Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'  Unless optional argument NO-UPDATE is non-nil, call `f90-update-line'
1330  after indenting."  after indenting."
1331    (interactive "*P")    (interactive "*P")
1332    (let (indent no-line-number (pos (make-marker)) (case-fold-search t))    (let ((case-fold-search t)
1333      (set-marker pos (point))          (pos (point-marker))
1334      (beginning-of-line)                ; digits after & \n are not line-nos          indent no-line-number)
1335      (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))      (beginning-of-line)           ; digits after & \n are not line-nos
1336          (progn (setq no-line-number t) (skip-chars-forward " \t"))      (if (not (save-excursion (and (f90-previous-statement)
1337        (f90-indent-line-no))                                    (f90-line-continued))))
1338            (f90-indent-line-no)
1339          (setq no-line-number t)
1340          (skip-chars-forward " \t"))
1341      (if (looking-at "!")      (if (looking-at "!")
1342          (setq indent (f90-comment-indent))          (setq indent (f90-comment-indent))
1343        (if (and (looking-at "end") f90-smart-end)        (and f90-smart-end (looking-at "end")
1344            (f90-match-end))             (f90-match-end))
1345        (setq indent (f90-calculate-indent)))        (setq indent (f90-calculate-indent)))
1346      (if (not (zerop (- indent (current-column))))      (or (= indent (current-column))
1347          (f90-indent-to indent no-line-number))          (f90-indent-to indent no-line-number))
1348      ;; If initial point was within line's indentation,      ;; If initial point was within line's indentation,
1349      ;; position after the indentation.  Else stay at same point in text.      ;; position after the indentation.  Else stay at same point in text.
1350      (if (< (point) (marker-position pos))      (and (< (point) pos)
1351          (goto-char (marker-position pos)))           (goto-char pos))
1352      (if auto-fill-function      (if auto-fill-function
1353          (f90-do-auto-fill)              ; also updates line          (f90-do-auto-fill)              ; also updates line
1354        (if (not no-update) (f90-update-line)))        (or no-update (f90-update-line)))
1355      (set-marker pos nil)))      (set-marker pos nil)))
1356    
1357  (defun f90-indent-new-line ()  (defun f90-indent-new-line ()
# Line 1359  after indenting." Line 1359  after indenting."
1359  An abbrev before point is expanded if the variable `abbrev-mode' is non-nil.  An abbrev before point is expanded if the variable `abbrev-mode' is non-nil.
1360  If run in the middle of a line, the line is not broken."  If run in the middle of a line, the line is not broken."
1361    (interactive "*")    (interactive "*")
1362    (let (string cont (case-fold-search t))    (if abbrev-mode (expand-abbrev))
1363      (if abbrev-mode (expand-abbrev))    (beginning-of-line)             ; reindent where likely to be needed
1364      (beginning-of-line)                ; reindent where likely to be needed    (f90-indent-line-no)
1365      (f90-indent-line-no)    (f90-indent-line 'no-update)
1366      (f90-indent-line 'no-update)    (end-of-line)
1367      (end-of-line)    (delete-horizontal-space)             ; destroy trailing whitespace
1368      (delete-horizontal-space)           ; destroy trailing whitespace    (let ((string (f90-in-string))
1369      (setq string (f90-in-string)          (cont (f90-line-continued)))
1370            cont (f90-line-continued))      (and string (not cont) (insert "&"))
     (if (and string (not cont)) (insert "&"))  
1371      (f90-update-line)      (f90-update-line)
1372      (newline)      (newline)
1373      (if (or string (and cont f90-beginning-ampersand)) (insert "&"))      (if (or string (and cont f90-beginning-ampersand)) (insert "&")))
1374      (f90-indent-line 'no-update)))    (f90-indent-line 'no-update))
1375    
1376    
1377  (defun f90-indent-region (beg-region end-region)  (defun f90-indent-region (beg-region end-region)
1378    "Indent every line in region by forward parsing."    "Indent every line in region by forward parsing."
1379    (interactive "*r")    (interactive "*r")
1380    (let ((end-region-mark (make-marker))    (let ((end-region-mark (copy-marker end-region))
1381          (save-point (point-marker))          (save-point (point-marker))
1382          block-list ind-lev ind-curr ind-b cont          block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct)
         struct beg-struct end-struct)  
     (set-marker end-region-mark end-region)  
1383      (goto-char beg-region)      (goto-char beg-region)
1384      ;; First find a line which is not a continuation line or comment.      ;; First find a line which is not a continuation line or comment.
1385      (beginning-of-line)      (beginning-of-line)
# Line 1419  If run in the middle of a line, the line Line 1416  If run in the middle of a line, the line
1416                  (< (point) end-region-mark))                  (< (point) end-region-mark))
1417        (if (looking-at "[ \t]*!")        (if (looking-at "[ \t]*!")
1418            (f90-indent-to (f90-comment-indent))            (f90-indent-to (f90-comment-indent))
1419          (if (not (zerop (- (current-indentation)          (or (= (current-indentation)
1420                             (+ ind-curr f90-continuation-indent))))                 (+ ind-curr f90-continuation-indent))
1421              (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))              (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))
1422      ;; Process all following lines.      ;; Process all following lines.
1423      (while (and (zerop (forward-line 1)) (< (point) end-region-mark))      (while (and (zerop (forward-line 1)) (< (point) end-region-mark))
# Line 1465  If run in the middle of a line, the line Line 1462  If run in the middle of a line, the line
1462               (setq ind-curr ind-lev))               (setq ind-curr ind-lev))
1463              (t (setq ind-curr ind-lev)))              (t (setq ind-curr ind-lev)))
1464        ;; Do the indentation if necessary.        ;; Do the indentation if necessary.
1465        (if (not (zerop (- ind-curr (current-column))))        (or (= ind-curr (current-column))
1466            (f90-indent-to ind-curr))            (f90-indent-to ind-curr))
1467        (while (and (f90-line-continued) (zerop (forward-line 1))        (while (and (f90-line-continued) (zerop (forward-line 1))
1468                    (< (point) end-region-mark))                    (< (point) end-region-mark))
1469          (if (looking-at "[ \t]*!")          (if (looking-at "[ \t]*!")
1470              (f90-indent-to (f90-comment-indent))              (f90-indent-to (f90-comment-indent))
1471            (if (not (zerop (- (current-indentation)            (or (= (current-indentation)
1472                               (+ ind-curr f90-continuation-indent))))                   (+ ind-curr f90-continuation-indent))
1473                (f90-indent-to                (f90-indent-to
1474                 (+ ind-curr f90-continuation-indent) 'no-line-no)))))                 (+ ind-curr f90-continuation-indent) 'no-line-no)))))
1475      ;; Restore point, etc.      ;; Restore point, etc.
# Line 1517  is non-nil, call `f90-update-line' after Line 1514  is non-nil, call `f90-update-line' after
1514    
1515  (defun f90-find-breakpoint ()  (defun f90-find-breakpoint ()
1516    "From `fill-column', search backward for break-delimiter."    "From `fill-column', search backward for break-delimiter."
1517    (let ((bol (line-beginning-position)))    (re-search-backward f90-break-delimiters (line-beginning-position))
1518      (re-search-backward f90-break-delimiters bol)    (if (not f90-break-before-delimiters)
1519      (if (not f90-break-before-delimiters)        (forward-char (if (looking-at f90-no-break-re) 2 1))
1520          (if (looking-at f90-no-break-re)      (backward-char)
1521              (forward-char 2)      (or (looking-at f90-no-break-re)
1522            (forward-char))          (forward-char)))))
       (backward-char)  
       (if (not (looking-at f90-no-break-re))  
           (forward-char)))))  
1523    
1524  (defun f90-do-auto-fill ()  (defun f90-do-auto-fill ()
1525    "Break line if non-white characters beyond `fill-column'.    "Break line if non-white characters beyond `fill-column'.
# Line 1570  Like `join-line', but handles F90 syntax Line 1564  Like `join-line', but handles F90 syntax
1564  (defun f90-fill-region (beg-region end-region)  (defun f90-fill-region (beg-region end-region)
1565    "Fill every line in region by forward parsing.  Join lines if possible."    "Fill every line in region by forward parsing.  Join lines if possible."
1566    (interactive "*r")    (interactive "*r")
1567    (let ((end-region-mark (make-marker))    (let ((end-region-mark (copy-marker end-region))
1568          (go-on t)          (go-on t)
1569          f90-smart-end f90-auto-keyword-case auto-fill-function)          f90-smart-end f90-auto-keyword-case auto-fill-function)
     (set-marker end-region-mark end-region)  
1570      (goto-char beg-region)      (goto-char beg-region)
1571      (while go-on      (while go-on
1572        ;; Join as much as possible.        ;; Join as much as possible.
# Line 1588  Like `join-line', but handles F90 syntax Line 1581  Like `join-line', but handles F90 syntax
1581          (move-to-column fill-column)          (move-to-column fill-column)
1582          (f90-find-breakpoint)          (f90-find-breakpoint)
1583          (f90-break-line 'no-update))          (f90-break-line 'no-update))
1584        (setq go-on (and (< (point) (marker-position end-region-mark))        (setq go-on (and (< (point) end-region-mark)
1585                         (zerop (forward-line 1)))                         (zerop (forward-line 1)))
1586              f90-cache-position (point)))              f90-cache-position (point)))
1587      (setq f90-cache-position nil)      (setq f90-cache-position nil)
1588        (set-marker end-region-mark nil)
1589      (if (fboundp 'zmacs-deactivate-region)      (if (fboundp 'zmacs-deactivate-region)
1590          (zmacs-deactivate-region)          (zmacs-deactivate-region)
1591        (deactivate-mark))))        (deactivate-mark))))
# Line 1605  END-NAME is the block end name (may be n Line 1599  END-NAME is the block end name (may be n
1599  Leave point at the end of line."  Leave point at the end of line."
1600    (search-forward "end" (line-end-position))    (search-forward "end" (line-end-position))
1601    (catch 'no-match    (catch 'no-match
1602      (if (not (f90-equal-symbols beg-block end-block))      (if (f90-equal-symbols beg-block end-block)
1603          (if end-block          (search-forward end-block)
1604              (progn        (if end-block
1605                (message "END %s does not match %s." end-block beg-block)            (progn
1606                (end-of-line)              (message "END %s does not match %s." end-block beg-block)
1607                (throw 'no-match nil))              (end-of-line)
1608            (message "Inserting %s." beg-block)              (throw 'no-match nil))
1609            (insert (concat " " beg-block)))          (message "Inserting %s." beg-block)
1610        (search-forward end-block))          (insert (concat " " beg-block))))
1611      (if (not (f90-equal-symbols beg-name end-name))      (if (f90-equal-symbols beg-name end-name)
1612          (cond ((and beg-name (not end-name))          (and end-name (search-forward end-name))
1613                 (message "Inserting %s." beg-name)        (cond ((and beg-name (not end-name))
1614                 (insert (concat " " beg-name)))               (message "Inserting %s." beg-name)
1615                ((and beg-name end-name)               (insert (concat " " beg-name)))
1616                 (message "Replacing %s with %s." end-name beg-name)              ((and beg-name end-name)
1617                 (search-forward end-name)               (message "Replacing %s with %s." end-name beg-name)
1618                 (replace-match beg-name))               (search-forward end-name)
1619                ((and (not beg-name) end-name)               (replace-match beg-name))
1620                 (message "Deleting %s." end-name)              ((and (not beg-name) end-name)
1621                 (search-forward end-name)               (message "Deleting %s." end-name)
1622                 (replace-match "")))               (search-forward end-name)
1623        (if end-name (search-forward end-name)))               (replace-match ""))))
1624      (if (not (looking-at "[ \t]*!")) (delete-horizontal-space))))      (or (looking-at "[ \t]*!") (delete-horizontal-space))))
1625    
1626  (defun f90-match-end ()  (defun f90-match-end ()
1627    "From an end block statement, find the corresponding block and name."    "From an end block statement, find the corresponding block and name."
1628    (interactive)    (interactive)
1629    (let ((count 1) (top-of-window (window-start))    (let ((count 1)
1630          (end-point (point)) (case-fold-search t)          (top-of-window (window-start))
1631            (end-point (point))
1632            (case-fold-search t)
1633          matching-beg beg-name end-name beg-block end-block end-struct)          matching-beg beg-name end-name beg-block end-block end-struct)
1634      (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")      (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
1635                            (setq end-struct (f90-looking-at-program-block-end)))                            (setq end-struct (f90-looking-at-program-block-end)))
# Line 1643  Leave point at the end of line." Line 1639  Leave point at the end of line."
1639          (beginning-of-line)          (beginning-of-line)
1640          (while (and (> count 0) (re-search-backward f90-blocks-re nil t))          (while (and (> count 0) (re-search-backward f90-blocks-re nil t))
1641            (beginning-of-line)            (beginning-of-line)
1642              ;; GM not a line number if continued line.
1643    ;;;          (skip-chars-forward " \t")
1644    ;;;          (skip-chars-forward "0-9")
1645            (skip-chars-forward " \t0-9")            (skip-chars-forward " \t0-9")
1646            (cond ((or (f90-in-string) (f90-in-comment)))            (cond ((or (f90-in-string) (f90-in-comment)))
1647                  ((setq matching-beg                  ((setq matching-beg
# Line 1764  CHANGE-WORD should be one of 'upcase-wor Line 1763  CHANGE-WORD should be one of 'upcase-wor
1763              (unless (progn              (unless (progn
1764                        (setq state (parse-partial-sexp ref-point (point)))                        (setq state (parse-partial-sexp ref-point (point)))
1765                        (or (nth 3 state) (nth 4 state)                        (or (nth 3 state) (nth 4 state)
1766                              ;; GM f90-directive-comment-re?
1767                            (save-excursion ; check for cpp directive                            (save-excursion ; check for cpp directive
1768                              (beginning-of-line)                              (beginning-of-line)
1769                              (skip-chars-forward " \t0-9")                              (skip-chars-forward " \t0-9")

Legend:
Removed from v.1.68  
changed lines
  Added in v.1.69

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