/[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.76 by rms, Thu Nov 4 10:16:51 2004 UTC revision 1.77 by gm, Thu Nov 25 00:46:42 2004 UTC
# Line 217  Line 217 
217    :group 'f90)    :group 'f90)
218    
219  (defcustom f90-smart-end 'blink  (defcustom f90-smart-end 'blink
220    "*From an END statement, check and fill the end using matching block start.    "*Qualification of END statements according to the matching block start.
221  Allowed values are 'blink, 'no-blink, and nil, which determine  For example, the END that closes an IF block is changed to END
222  whether to blink the matching beginning."  IF.  If the block has a label, this is added as well.  Allowed
223    values are 'blink, 'no-blink, and nil.  If nil, nothing is done.
224    The other two settings have the same effect, but 'blink
225    additionally blinks the cursor to the start of the block."
226    :type  '(choice (const blink) (const no-blink) (const nil))    :type  '(choice (const blink) (const no-blink) (const nil))
227    :group 'f90)    :group 'f90)
228    
# Line 428  Can be overridden by the value of `font- Line 431  Can be overridden by the value of `font-
431      (modify-syntax-entry ?=  "."  table)      (modify-syntax-entry ?=  "."  table)
432      (modify-syntax-entry ?*  "."  table)      (modify-syntax-entry ?*  "."  table)
433      (modify-syntax-entry ?/  "."  table)      (modify-syntax-entry ?/  "."  table)
434        ;; I think that the f95 standard leaves the behaviour of \
435        ;; unspecified, but that f2k will require it to be non-special.
436        ;; Use `f90-backslash-not-special' to change.
437      (modify-syntax-entry ?\\ "\\" table) ; escape chars      (modify-syntax-entry ?\\ "\\" table) ; escape chars
438      table)      table)
439    "Syntax table used in F90 mode.")    "Syntax table used in F90 mode.")
# Line 967  NAME is non-nil only for type." Line 973  NAME is non-nil only for type."
973    
974  (defsubst f90-looking-at-program-block-start ()  (defsubst f90-looking-at-program-block-start ()
975    "Return (KIND NAME) if a program block with name NAME starts after point."    "Return (KIND NAME) if a program block with name NAME starts after point."
976    ;;;NAME is nil for an un-named main PROGRAM block."
977    (cond    (cond
978     ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")     ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
979      (list (match-string 1) (match-string 2)))      (list (match-string 1) (match-string 2)))
# Line 977  NAME is non-nil only for type." Line 984  NAME is non-nil only for type."
984           (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\           (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\
985  \\(\\sw+\\)"))  \\(\\sw+\\)"))
986      (list (match-string 1) (match-string 2)))))      (list (match-string 1) (match-string 2)))))
987    ;; Following will match an un-named main program block; however
988    ;; one needs to check if there is an actual PROGRAM statement after
989    ;; point (and before any END program). Adding this will require
990    ;; change to eg f90-calculate-indent.
991    ;;;   ((save-excursion
992    ;;;     (not (f90-previous-statement)))
993    ;;;    '("program" nil))))
994    
995  (defsubst f90-looking-at-program-block-end ()  (defsubst f90-looking-at-program-block-end ()
996    "Return (KIND NAME) if a block with name NAME ends after point."    "Return (KIND NAME) if a block with name NAME ends after point."
# Line 1104  Does not check type and subprogram inden Line 1118  Does not check type and subprogram inden
1118    (let (icol cont (case-fold-search t) (pnt (point)))    (let (icol cont (case-fold-search t) (pnt (point)))
1119      (save-excursion      (save-excursion
1120        (if (not (f90-previous-statement))        (if (not (f90-previous-statement))
1121            (setq icol 0)            ;; First statement in buffer.
1122              (setq icol (if (save-excursion
1123                               (f90-next-statement)
1124                               (f90-looking-at-program-block-start))
1125                             0
1126                           ;; No explicit PROGRAM start statement.
1127                           f90-program-indent))
1128          (setq cont (f90-present-statement-cont))          (setq cont (f90-present-statement-cont))
1129          (if (eq cont 'end)          (if (eq cont 'end)
1130              (while (not (eq 'begin (f90-present-statement-cont)))              (while (not (eq 'begin (f90-present-statement-cont)))
# Line 1151  Does not check type and subprogram inden Line 1171  Does not check type and subprogram inden
1171    
1172  (defun f90-previous-statement ()  (defun f90-previous-statement ()
1173    "Move point to beginning of the previous F90 statement.    "Move point to beginning of the previous F90 statement.
1174  Return nil if no previous statement is found.  If no previous statement is found (i.e. if called from the first
1175  A statement is a line which is neither blank nor a comment."  statement in the buffer), move to the start of the buffer and
1176    return nil.  A statement is a line which is neither blank nor a
1177    comment."
1178    (interactive)    (interactive)
1179    (let (not-first-statement)    (let (not-first-statement)
1180      (beginning-of-line)      (beginning-of-line)
# Line 1189  Return (TYPE NAME), or nil if not found. Line 1211  Return (TYPE NAME), or nil if not found.
1211      (beginning-of-line)      (beginning-of-line)
1212      (if (zerop count)      (if (zerop count)
1213          matching-beg          matching-beg
1214          ;; Note this includes the case of an un-named main program,
1215          ;; in which case we go to (point-min).
1216        (message "No beginning found.")        (message "No beginning found.")
1217        nil)))        nil)))
1218    
# Line 1221  Return (TYPE NAME), or nil if not found. Line 1245  Return (TYPE NAME), or nil if not found.
1245  (defun f90-end-of-block (&optional num)  (defun f90-end-of-block (&optional num)
1246    "Move point forward to the end of the current code block.    "Move point forward to the end of the current code block.
1247  With optional argument NUM, go forward that many balanced blocks.  With optional argument NUM, go forward that many balanced blocks.
1248  If NUM is negative, go backward to the start of a block.  If NUM is negative, go backward to the start of a block.  Checks
1249  Checks for consistency of block types and labels (if present),  for consistency of block types and labels (if present), and
1250  and completes outermost block if necessary.  completes outermost block if `f90-smart-end' is non-nil.
1251  Some of these things (which?) are not done if NUM is nil,  Interactively, pushes mark before moving point."
 which only happens in a noninteractive call."  
1252    (interactive "p")    (interactive "p")
1253    (if (and num (< num 0)) (f90-beginning-of-block (- num)))    (if (interactive-p) (push-mark (point) t)) ; can move some distance
1254    (let ((f90-smart-end nil)             ; for the final `f90-match-end'    (and num (< num 0) (f90-beginning-of-block (- num)))
1255      (let ((f90-smart-end (if f90-smart-end 'no-blink)) ; for final match-end
1256          (case-fold-search t)          (case-fold-search t)
1257          (count (or num 1))          (count (or num 1))
1258          start-list start-this start-type start-label end-type end-label)          start-list start-this start-type start-label end-type end-label)
     (if num (push-mark (point) t))  
1259      (end-of-line)                       ; probably want this      (end-of-line)                       ; probably want this
1260      (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))      (while (and (> count 0) (re-search-forward f90-blocks-re nil 'move))
1261        (beginning-of-line)        (beginning-of-line)
# Line 1268  which only happens in a noninteractive c Line 1291  which only happens in a noninteractive c
1291        (end-of-line))        (end-of-line))
1292      (if (> count 0) (error "Missing block end"))      (if (> count 0) (error "Missing block end"))
1293      ;; Check outermost block.      ;; Check outermost block.
1294      (if num      (when f90-smart-end
1295          (save-excursion        (save-excursion
1296            (beginning-of-line)          (beginning-of-line)
1297            (skip-chars-forward " \t0-9")          (skip-chars-forward " \t0-9")
1298            (f90-match-end)))))          (f90-match-end)))))
1299    
1300  (defun f90-beginning-of-block (&optional num)  (defun f90-beginning-of-block (&optional num)
1301    "Move point backwards to the start of the current code block.    "Move point backwards to the start of the current code block.
1302  With optional argument NUM, go backward that many balanced blocks.  With optional argument NUM, go backward that many balanced blocks.
1303  If NUM is negative, go forward to the end of a block.  If NUM is negative, go forward to the end of a block.
1304  Checks for consistency of block types and labels (if present).  Checks for consistency of block types and labels (if present).
1305  Does not check the outermost block, because it may be incomplete."  Does not check the outermost block, because it may be incomplete.
1306    Interactively, pushes mark before moving point."
1307    (interactive "p")    (interactive "p")
1308    (if (and num (< num 0)) (f90-end-of-block (- num)))    (and num (< num 0) (f90-end-of-block (- num)))
1309    (let ((case-fold-search t)    (let ((case-fold-search t)
1310          (count (or num 1))          (count (or num 1))
1311          end-list end-this end-type end-label          end-list end-this end-type end-label
# Line 1320  Does not check the outermost block, beca Line 1344  Does not check the outermost block, beca
1344                 (or (f90-equal-symbols start-label end-label)                 (or (f90-equal-symbols start-label end-label)
1345                     (error "Start label `%s' does not match end label `%s'"                     (error "Start label `%s' does not match end label `%s'"
1346                            start-label end-label))))))                            start-label end-label))))))
1347       (if (> count 0) (error "Missing block start"))))      ;; Includes an un-named main program block.
1348        (if (> count 0) (error "Missing block start"))))
1349    
1350  (defun f90-next-block (&optional num)  (defun f90-next-block (&optional num)
1351    "Move point forward to the next end or start of a code block.    "Move point forward to the next end or start of a code block.
# Line 1439  If run in the middle of a line, the line Line 1464  If run in the middle of a line, the line
1464    (f90-indent-line 'no-update))         ; nothing to update    (f90-indent-line 'no-update))         ; nothing to update
1465    
1466    
1467    ;; TODO not add spaces to empty lines at the start.
1468    ;; Why is second line getting extra indent over first?
1469  (defun f90-indent-region (beg-region end-region)  (defun f90-indent-region (beg-region end-region)
1470    "Indent every line in region by forward parsing."    "Indent every line in region by forward parsing."
1471    (interactive "*r")    (interactive "*r")
# Line 1663  BEG-NAME is the block start name (may be Line 1690  BEG-NAME is the block start name (may be
1690  END-BLOCK is the type of block as indicated at the end (may be nil).  END-BLOCK is the type of block as indicated at the end (may be nil).
1691  END-NAME is the block end name (may be nil).  END-NAME is the block end name (may be nil).
1692  Leave point at the end of line."  Leave point at the end of line."
1693      ;; Hack to deal with the case when this is called from
1694      ;; f90-indent-region on a program block without an explicit PROGRAM
1695      ;; statement at the start. Should really be an error (?).
1696      (or beg-block (setq beg-block "program"))
1697    (search-forward "end" (line-end-position))    (search-forward "end" (line-end-position))
1698    (catch 'no-match    (catch 'no-match
1699      (if (f90-equal-symbols beg-block end-block)      (if (and end-block (f90-equal-symbols beg-block end-block))
1700          (search-forward end-block)          (search-forward end-block)
1701        (if end-block        (if end-block
1702            (progn            (progn
# Line 1703  Leave point at the end of line." Line 1734  Leave point at the end of line."
1734              end-name  (car (cdr end-struct)))              end-name  (car (cdr end-struct)))
1735        (save-excursion        (save-excursion
1736          (beginning-of-line)          (beginning-of-line)
1737          (while (and (> count 0) (re-search-backward f90-blocks-re nil t))          (while (and (> count 0)
1738                        (not (= (line-beginning-position) (point-min))))
1739              (re-search-backward f90-blocks-re nil 'move)
1740            (beginning-of-line)            (beginning-of-line)
1741            ;; GM not a line number if continued line.            ;; GM not a line number if continued line.
1742  ;;;          (skip-chars-forward " \t")  ;;;          (skip-chars-forward " \t")
# Line 1717  Leave point at the end of line." Line 1750  Leave point at the end of line."
1750                          (f90-looking-at-where-or-forall)                          (f90-looking-at-where-or-forall)
1751                          (f90-looking-at-select-case)                          (f90-looking-at-select-case)
1752                          (f90-looking-at-type-like)                          (f90-looking-at-type-like)
1753                          (f90-looking-at-program-block-start)))                          (f90-looking-at-program-block-start)
1754                            ;; Interpret a single END without a block
1755                            ;; start to be the END of a program block
1756                            ;; without an initial PROGRAM line.
1757                            (if (= (line-beginning-position) (point-min))
1758                                '("program" nil))))
1759                   (setq count (1- count)))                   (setq count (1- count)))
1760                  ((looking-at (concat "end[ \t]*" f90-blocks-re))                  ((looking-at (concat "end[ \t]*" f90-blocks-re))
1761                   (setq count (1+ count)))))                   (setq count (1+ count)))))
# Line 1850  CHANGE-WORD should be one of 'upcase-wor Line 1888  CHANGE-WORD should be one of 'upcase-wor
1888    (save-excursion    (save-excursion
1889      (nth 1 (f90-beginning-of-subprogram))))      (nth 1 (f90-beginning-of-subprogram))))
1890    
1891    
1892    (defun f90-backslash-not-special (&optional all)
1893      "Make the backslash character (\\) be non-special in the current buffer.
1894    With optional argument ALL, change the default for all present
1895    and future F90 buffers.  F90 mode normally treats backslash as an
1896    escape character."
1897      (or (eq major-mode 'f90-mode)
1898          (error "This function should only be used in F90 buffers"))
1899      (when (equal (char-syntax ?\\ ) ?\\ )
1900        (or all (set-syntax-table (copy-syntax-table (syntax-table))))
1901        (modify-syntax-entry ?\\ ".")))
1902    
1903    
1904  (provide 'f90)  (provide 'f90)
1905    
1906  ;;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8  ;;; arch-tag: fceac97c-c147-44bd-aec0-172d4b560ef8

Legend:
Removed from v.1.76  
changed lines
  Added in v.1.77

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