Mercurial > emacs
changeset 50610:a8eb65a987d7
(f90-indent-to, f90-indent-line-no)
(f90-no-block-limit, f90-end-of-block, f90-beginning-of-block)
(f90-comment-region, f90-indent-line, f90-indent-region)
(f90-find-breakpoint, f90-block-match): Trivial simplifications.
(f90-looking-at-do, f90-looking-at-select-case)
(f90-looking-at-if-then, f90-looking-at-where-or-forall): Drop
XEmacs 19 support and simplify.
(f90-indent-new-line): No need for case-fold-search. Simplify.
(f90-fill-region): Make marker nil when done. Simplify.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Wed, 16 Apr 2003 11:08:58 +0000 |
| parents | 4abe2802e78c |
| children | 5ac877b692fe |
| files | lisp/progmodes/f90.el |
| diffstat | 1 files changed, 103 insertions(+), 103 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/progmodes/f90.el Wed Apr 16 09:52:55 2003 +0000 +++ b/lisp/progmodes/f90.el Wed Apr 16 11:08:58 2003 +0000 @@ -770,7 +770,6 @@ f90-font-lock-keywords-3 f90-font-lock-keywords-4) nil t)) - ;; Tell imenu how to handle f90. (set (make-local-variable 'imenu-case-fold-search) t) (set (make-local-variable 'imenu-generic-expression) f90-imenu-generic-expression) @@ -817,6 +816,9 @@ (skip-chars-backward " \t") (= (preceding-char) ?&))) +;; GM this is not right, eg a continuation line starting with a number. +;; Need f90-code-start-position function. +;; And yet, things seems to work with this... (defsubst f90-current-indentation () "Return indentation of current line. Line-numbers are considered whitespace characters." @@ -827,12 +829,11 @@ If optional argument NO-LINE-NUMBER is nil, jump over a possible line-number before indenting." (beginning-of-line) - (if (not no-line-number) + (or no-line-number (skip-chars-forward " \t0-9")) (delete-horizontal-space) - (if (zerop (current-column)) - (indent-to col) - (indent-to col 1))) ; leave >= 1 space after line number + ;; Leave >= 1 space after line number. + (indent-to col (if (zerop (current-column)) 0 1))) (defsubst f90-get-present-comment-type () "If point lies within a comment, return the string starting the comment. @@ -850,22 +851,18 @@ (equal (if a (downcase a) nil) (if b (downcase b) nil))) -;; XEmacs 19.11 & 19.12 return a single char when matching an empty regexp. -;; The next 2 functions are therefore longer than necessary. (defsubst f90-looking-at-do () "Return (\"do\" NAME) if a do statement starts after point. NAME is nil if the statement has no label." (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(do\\)\\>") - (list (match-string 3) - (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))))) + (list (match-string 3) (match-string 2))) (defsubst f90-looking-at-select-case () "Return (\"select\" NAME) if a select-case statement starts after point. NAME is nil if the statement has no label." (if (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ \\(select\\)[ \t]*case[ \t]*(") - (list (match-string 3) - (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))))) + (list (match-string 3) (match-string 2)))) (defsubst f90-looking-at-if-then () "Return (\"if\" NAME) if an if () then statement starts after point. @@ -873,7 +870,7 @@ (save-excursion (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\\(if\\)\\>") (let ((struct (match-string 3)) - (label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))) + (label (match-string 2)) (pos (scan-lists (point) 1 0))) (and pos (goto-char pos)) (skip-chars-forward " \t") @@ -891,7 +888,7 @@ (when (looking-at "\\(\\(\\sw+\\)[ \t]*:\\)?[ \t]*\ \\(where\\|forall\\)\\>") (let ((struct (match-string 3)) - (label (if (looking-at "\\(\\sw+\\)[ \t]*:") (match-string 1))) + (label (match-string 2)) (pos (scan-lists (point) 1 0))) (and pos (goto-char pos)) (skip-chars-forward " \t") @@ -915,8 +912,8 @@ (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>")) (list (match-string 1) (match-string 2))) ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)")) - (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)\ -[ \t]+\\(\\sw+\\)")) + (looking-at "[^!'\"\&\n]*\\(function\\|subroutine\\)[ \t]+\ +\\(\\sw+\\)")) (list (match-string 1) (match-string 2))))) (defsubst f90-looking-at-program-block-end () @@ -966,24 +963,24 @@ "If `f90-leave-line-no' is nil, left-justify a line number. Leaves point at the first non-blank character after the line number. Call from beginning of line." - (if (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]")) - (delete-horizontal-space)) + (and (null f90-leave-line-no) (looking-at "[ \t]+[0-9]") + (delete-horizontal-space)) (skip-chars-forward " \t0-9")) (defsubst f90-no-block-limit () "Return nil if point is at the edge of a code block. Searches line forward for \"function\" or \"subroutine\", if all else fails." - (let ((eol (line-end-position))) - (save-excursion - (not (or (looking-at "end") - (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ + (save-excursion + (not (or (looking-at "end") + (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\ \\|select[ \t]*case\\|case\\|where\\|forall\\)\\>") - (looking-at "\\(program\\|module\\|interface\\|\ + (looking-at "\\(program\\|module\\|interface\\|\ block[ \t]*data\\)\\>") - (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") - (looking-at f90-type-def-re) - (re-search-forward "\\(function\\|subroutine\\)" eol t)))))) + (looking-at "\\(contains\\|\\sw+[ \t]*:\\)") + (looking-at f90-type-def-re) + (re-search-forward "\\(function\\|subroutine\\)" + (line-end-position) t))))) (defsubst f90-update-line () "Change case of current line as per `f90-auto-keyword-case'." @@ -1196,10 +1193,10 @@ start-list (cdr start-list) start-type (car start-this) start-label (cadr start-this)) - (if (not (f90-equal-symbols start-type end-type)) + (or (f90-equal-symbols start-type end-type) (error "End type `%s' does not match start type `%s'" end-type start-type)) - (if (not (f90-equal-symbols start-label end-label)) + (or (f90-equal-symbols start-label end-label) (error "End label `%s' does not match start label `%s'" end-label start-label))))) (end-of-line)) @@ -1221,7 +1218,8 @@ (if (and num (< num 0)) (f90-end-of-block (- num))) (let ((case-fold-search t) (count (or num 1)) - end-list end-this end-type end-label start-this start-type start-label) + end-list end-this end-type end-label + start-this start-type start-label) (if (interactive-p) (push-mark (point) t)) (beginning-of-line) ; probably want this (while (and (> count 0) (re-search-backward f90-blocks-re nil 'move)) @@ -1250,10 +1248,10 @@ end-list (cdr end-list) end-type (car end-this) end-label (cadr end-this)) - (if (not (f90-equal-symbols start-type end-type)) + (or (f90-equal-symbols start-type end-type) (error "Start type `%s' does not match end type `%s'" start-type end-type)) - (if (not (f90-equal-symbols start-label end-label)) + (or (f90-equal-symbols start-label end-label) (error "Start label `%s' does not match end label `%s'" start-label end-label)))))) (if (> count 0) (error "Missing block start")))) @@ -1313,15 +1311,14 @@ Insert the variable `f90-comment-region' at the start of every line in the region, or, if already present, remove it." (interactive "*r") - (let ((end (make-marker))) - (set-marker end end-region) + (let ((end (copy-marker end-region))) (goto-char beg-region) (beginning-of-line) (if (looking-at (regexp-quote f90-comment-region)) (delete-region (point) (match-end 0)) (insert f90-comment-region)) (while (and (zerop (forward-line 1)) - (< (point) (marker-position end))) + (< (point) end)) (if (looking-at (regexp-quote f90-comment-region)) (delete-region (point) (match-end 0)) (insert f90-comment-region))) @@ -1332,26 +1329,29 @@ Unless optional argument NO-UPDATE is non-nil, call `f90-update-line' after indenting." (interactive "*P") - (let (indent no-line-number (pos (make-marker)) (case-fold-search t)) - (set-marker pos (point)) - (beginning-of-line) ; digits after & \n are not line-nos - (if (save-excursion (and (f90-previous-statement) (f90-line-continued))) - (progn (setq no-line-number t) (skip-chars-forward " \t")) - (f90-indent-line-no)) + (let ((case-fold-search t) + (pos (point-marker)) + indent no-line-number) + (beginning-of-line) ; digits after & \n are not line-nos + (if (not (save-excursion (and (f90-previous-statement) + (f90-line-continued)))) + (f90-indent-line-no) + (setq no-line-number t) + (skip-chars-forward " \t")) (if (looking-at "!") (setq indent (f90-comment-indent)) - (if (and (looking-at "end") f90-smart-end) - (f90-match-end)) + (and f90-smart-end (looking-at "end") + (f90-match-end)) (setq indent (f90-calculate-indent))) - (if (not (zerop (- indent (current-column)))) + (or (= indent (current-column)) (f90-indent-to indent no-line-number)) ;; If initial point was within line's indentation, ;; position after the indentation. Else stay at same point in text. - (if (< (point) (marker-position pos)) - (goto-char (marker-position pos))) + (and (< (point) pos) + (goto-char pos)) (if auto-fill-function (f90-do-auto-fill) ; also updates line - (if (not no-update) (f90-update-line))) + (or no-update (f90-update-line))) (set-marker pos nil))) (defun f90-indent-new-line () @@ -1359,30 +1359,27 @@ An abbrev before point is expanded if the variable `abbrev-mode' is non-nil. If run in the middle of a line, the line is not broken." (interactive "*") - (let (string cont (case-fold-search t)) - (if abbrev-mode (expand-abbrev)) - (beginning-of-line) ; reindent where likely to be needed - (f90-indent-line-no) - (f90-indent-line 'no-update) - (end-of-line) - (delete-horizontal-space) ; destroy trailing whitespace - (setq string (f90-in-string) - cont (f90-line-continued)) - (if (and string (not cont)) (insert "&")) + (if abbrev-mode (expand-abbrev)) + (beginning-of-line) ; reindent where likely to be needed + (f90-indent-line-no) + (f90-indent-line 'no-update) + (end-of-line) + (delete-horizontal-space) ; destroy trailing whitespace + (let ((string (f90-in-string)) + (cont (f90-line-continued))) + (and string (not cont) (insert "&")) (f90-update-line) (newline) - (if (or string (and cont f90-beginning-ampersand)) (insert "&")) - (f90-indent-line 'no-update))) + (if (or string (and cont f90-beginning-ampersand)) (insert "&"))) + (f90-indent-line 'no-update)) (defun f90-indent-region (beg-region end-region) "Indent every line in region by forward parsing." (interactive "*r") - (let ((end-region-mark (make-marker)) + (let ((end-region-mark (copy-marker end-region)) (save-point (point-marker)) - block-list ind-lev ind-curr ind-b cont - struct beg-struct end-struct) - (set-marker end-region-mark end-region) + block-list ind-lev ind-curr ind-b cont struct beg-struct end-struct) (goto-char beg-region) ;; First find a line which is not a continuation line or comment. (beginning-of-line) @@ -1419,8 +1416,8 @@ (< (point) end-region-mark)) (if (looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent)) - (if (not (zerop (- (current-indentation) - (+ ind-curr f90-continuation-indent)))) + (or (= (current-indentation) + (+ ind-curr f90-continuation-indent)) (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))) ;; Process all following lines. (while (and (zerop (forward-line 1)) (< (point) end-region-mark)) @@ -1465,14 +1462,14 @@ (setq ind-curr ind-lev)) (t (setq ind-curr ind-lev))) ;; Do the indentation if necessary. - (if (not (zerop (- ind-curr (current-column)))) + (or (= ind-curr (current-column)) (f90-indent-to ind-curr)) (while (and (f90-line-continued) (zerop (forward-line 1)) (< (point) end-region-mark)) (if (looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent)) - (if (not (zerop (- (current-indentation) - (+ ind-curr f90-continuation-indent)))) + (or (= (current-indentation) + (+ ind-curr f90-continuation-indent)) (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))) ;; Restore point, etc. @@ -1517,15 +1514,12 @@ (defun f90-find-breakpoint () "From `fill-column', search backward for break-delimiter." - (let ((bol (line-beginning-position))) - (re-search-backward f90-break-delimiters bol) - (if (not f90-break-before-delimiters) - (if (looking-at f90-no-break-re) - (forward-char 2) - (forward-char)) - (backward-char) - (if (not (looking-at f90-no-break-re)) - (forward-char))))) + (re-search-backward f90-break-delimiters (line-beginning-position)) + (if (not f90-break-before-delimiters) + (forward-char (if (looking-at f90-no-break-re) 2 1)) + (backward-char) + (or (looking-at f90-no-break-re) + (forward-char))))) (defun f90-do-auto-fill () "Break line if non-white characters beyond `fill-column'. @@ -1570,10 +1564,9 @@ (defun f90-fill-region (beg-region end-region) "Fill every line in region by forward parsing. Join lines if possible." (interactive "*r") - (let ((end-region-mark (make-marker)) + (let ((end-region-mark (copy-marker end-region)) (go-on t) f90-smart-end f90-auto-keyword-case auto-fill-function) - (set-marker end-region-mark end-region) (goto-char beg-region) (while go-on ;; Join as much as possible. @@ -1588,10 +1581,11 @@ (move-to-column fill-column) (f90-find-breakpoint) (f90-break-line 'no-update)) - (setq go-on (and (< (point) (marker-position end-region-mark)) + (setq go-on (and (< (point) end-region-mark) (zerop (forward-line 1))) f90-cache-position (point))) (setq f90-cache-position nil) + (set-marker end-region-mark nil) (if (fboundp 'zmacs-deactivate-region) (zmacs-deactivate-region) (deactivate-mark)))) @@ -1605,35 +1599,37 @@ Leave point at the end of line." (search-forward "end" (line-end-position)) (catch 'no-match - (if (not (f90-equal-symbols beg-block end-block)) - (if end-block - (progn - (message "END %s does not match %s." end-block beg-block) - (end-of-line) - (throw 'no-match nil)) - (message "Inserting %s." beg-block) - (insert (concat " " beg-block))) - (search-forward end-block)) - (if (not (f90-equal-symbols beg-name end-name)) - (cond ((and beg-name (not end-name)) - (message "Inserting %s." beg-name) - (insert (concat " " beg-name))) - ((and beg-name end-name) - (message "Replacing %s with %s." end-name beg-name) - (search-forward end-name) - (replace-match beg-name)) - ((and (not beg-name) end-name) - (message "Deleting %s." end-name) - (search-forward end-name) - (replace-match ""))) - (if end-name (search-forward end-name))) - (if (not (looking-at "[ \t]*!")) (delete-horizontal-space)))) + (if (f90-equal-symbols beg-block end-block) + (search-forward end-block) + (if end-block + (progn + (message "END %s does not match %s." end-block beg-block) + (end-of-line) + (throw 'no-match nil)) + (message "Inserting %s." beg-block) + (insert (concat " " beg-block)))) + (if (f90-equal-symbols beg-name end-name) + (and end-name (search-forward end-name)) + (cond ((and beg-name (not end-name)) + (message "Inserting %s." beg-name) + (insert (concat " " beg-name))) + ((and beg-name end-name) + (message "Replacing %s with %s." end-name beg-name) + (search-forward end-name) + (replace-match beg-name)) + ((and (not beg-name) end-name) + (message "Deleting %s." end-name) + (search-forward end-name) + (replace-match "")))) + (or (looking-at "[ \t]*!") (delete-horizontal-space)))) (defun f90-match-end () "From an end block statement, find the corresponding block and name." (interactive) - (let ((count 1) (top-of-window (window-start)) - (end-point (point)) (case-fold-search t) + (let ((count 1) + (top-of-window (window-start)) + (end-point (point)) + (case-fold-search t) matching-beg beg-name end-name beg-block end-block end-struct) (when (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9") (setq end-struct (f90-looking-at-program-block-end))) @@ -1643,6 +1639,9 @@ (beginning-of-line) (while (and (> count 0) (re-search-backward f90-blocks-re nil t)) (beginning-of-line) + ;; GM not a line number if continued line. +;;; (skip-chars-forward " \t") +;;; (skip-chars-forward "0-9") (skip-chars-forward " \t0-9") (cond ((or (f90-in-string) (f90-in-comment))) ((setq matching-beg @@ -1764,6 +1763,7 @@ (unless (progn (setq state (parse-partial-sexp ref-point (point))) (or (nth 3 state) (nth 4 state) + ;; GM f90-directive-comment-re? (save-excursion ; check for cpp directive (beginning-of-line) (skip-chars-forward " \t0-9")