[Emacs-diffs] Changes to emacs/lisp/progmodes/f90.el

[Glenn Morris]

Index: emacs/lisp/progmodes/f90.el
diff -c emacs/lisp/progmodes/f90.el:1.40 emacs/lisp/progmodes/f90.el:1.41
*** emacs/lisp/progmodes/f90.el:1.40    Sun Apr 28 18:15:51 2002
--- emacs/lisp/progmodes/f90.el Sun Apr 28 18:28:38 2002
***************
*** 664,675 ****
  (defun f90-add-imenu-menu ()
    "Add an imenu menu to the menubar."
    (interactive)
!   (if (not f90-imenu)
!       (progn
!       (imenu-add-to-menubar "F90-imenu")
!       (redraw-frame (selected-frame))
!       (setq f90-imenu t))
!     (message "%s" "F90-imenu already exists.")))
  (put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu))
  
  
--- 664,675 ----
  (defun f90-add-imenu-menu ()
    "Add an imenu menu to the menubar."
    (interactive)
!   (if f90-imenu
!       (message "%s" "F90-imenu already exists.")
!     (imenu-add-to-menubar "F90-imenu")
!     (redraw-frame (selected-frame))
!     (setq f90-imenu t)))
! 
  (put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu))
  
  
***************
*** 899,911 ****
  (defsubst f90-get-present-comment-type ()
    (save-excursion
      (let ((type nil) (eol (line-end-position)))
!       (if (f90-in-comment)
!         (progn
!           (beginning-of-line)
!           (re-search-forward "[!]+" eol)
!           (while (f90-in-string)
!             (re-search-forward "[!]+" eol))
!           (setq type (match-string 0))))
        type)))
  
  (defsubst f90-equal-symbols (a b)
--- 899,910 ----
  (defsubst f90-get-present-comment-type ()
    (save-excursion
      (let ((type nil) (eol (line-end-position)))
!       (when (f90-in-comment)
!         (beginning-of-line)
!         (re-search-forward "[!]+" eol)
!         (while (f90-in-string)
!           (re-search-forward "[!]+" eol))
!         (setq type (match-string 0)))
        type)))
  
  (defsubst f90-equal-symbols (a b)
***************
*** 942,962 ****
  Name is nil if the statement has no label."
    (save-excursion
      (let (struct (label nil))
!       (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
!         (progn
!           (setq struct (match-string 3))
!           (if (looking-at "\\(\\sw+\\)[ \t]*\:")
!               (setq label (match-string 1)))
!           (let ((pos (scan-lists (point) 1 0)))
!             (and pos (goto-char pos)))
!           (skip-chars-forward " \t")
!           (if (or (looking-at "then\\>")
!                   (if (f90-line-continued)
!                       (progn
!                         (f90-next-statement)
!                         (skip-chars-forward " \t0-9&")
!                         (looking-at "then\\>"))))
!               (list struct label)))))))
  
  (defsubst f90-looking-at-where-or-forall ()
    "Return (kind name) if a where or forall block starts after point.
--- 941,959 ----
  Name is nil if the statement has no label."
    (save-excursion
      (let (struct (label nil))
!       (when (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
!         (setq struct (match-string 3))
!         (if (looking-at "\\(\\sw+\\)[ \t]*\:")
!             (setq label (match-string 1)))
!         (let ((pos (scan-lists (point) 1 0)))
!           (and pos (goto-char pos)))
!         (skip-chars-forward " \t")
!         (if (or (looking-at "then\\>")
!                 (when (f90-line-continued)
!                   (f90-next-statement)
!                   (skip-chars-forward " \t0-9&")
!                   (looking-at "then\\>")))
!             (list struct label))))))
  
  (defsubst f90-looking-at-where-or-forall ()
    "Return (kind name) if a where or forall block starts after point.
***************
*** 1043,1053 ****
  
  (defsubst f90-update-line ()
    (let (bol eol)
!     (if f90-auto-keyword-case
!       (progn (setq bol (line-beginning-position)
!                    eol (line-end-position))
!              (if f90-auto-keyword-case
!                  (f90-change-keywords f90-auto-keyword-case bol eol))))))
  
  (defun f90-electric-insert ()
    "Call `f90-do-auto-fill' at each operator insertion."
--- 1040,1050 ----
  
  (defsubst f90-update-line ()
    (let (bol eol)
!     (when f90-auto-keyword-case
!       (setq bol (line-beginning-position)
!             eol (line-end-position))
!       (if f90-auto-keyword-case
!           (f90-change-keywords f90-auto-keyword-case bol eol)))))
  
  (defun f90-electric-insert ()
    "Call `f90-do-auto-fill' at each operator insertion."
***************
*** 1068,1084 ****
                      (looking-at "[ \t]*[0-9]"))))
        (setq icol (current-indentation))
        (beginning-of-line)
!       (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
!                            (line-end-position) t)
!         (progn
!           (beginning-of-line) (skip-chars-forward " \t")
!           (cond ((f90-looking-at-do)
!                  (setq icol (+ icol f90-do-indent)))
!                 ((or (f90-looking-at-if-then)
!                      (f90-looking-at-where-or-forall)
!                      (f90-looking-at-select-case))
!                  (setq icol (+ icol f90-if-indent))))
!           (end-of-line)))
        (while (re-search-forward
              "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
        (beginning-of-line) (skip-chars-forward " \t0-9")
--- 1065,1080 ----
                      (looking-at "[ \t]*[0-9]"))))
        (setq icol (current-indentation))
        (beginning-of-line)
!       (when (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
!                                (line-end-position) t)
!         (beginning-of-line) (skip-chars-forward " \t")
!         (cond ((f90-looking-at-do)
!                (setq icol (+ icol f90-do-indent)))
!               ((or (f90-looking-at-if-then)
!                    (f90-looking-at-where-or-forall)
!                    (f90-looking-at-select-case))
!                (setq icol (+ icol f90-if-indent))))
!         (end-of-line))
        (while (re-search-forward
              "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
        (beginning-of-line) (skip-chars-forward " \t0-9")
***************
*** 1453,1465 ****
    "From `fill-column', search backward for break-delimiter."
    (let ((bol (line-beginning-position)))
      (re-search-backward f90-break-delimiters bol)
!     (if f90-break-before-delimiters
!       (progn (backward-char)
!              (if (not (looking-at f90-no-break-re))
!                  (forward-char)))
!       (if (looking-at f90-no-break-re)
!         (forward-char 2)
!       (forward-char)))))
  
  (defun f90-do-auto-fill ()
    "Break line if non-white characters beyond `fill-column'. Also, update 
line."
--- 1449,1461 ----
    "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)))))
  
  (defun f90-do-auto-fill ()
    "Break line if non-white characters beyond `fill-column'. Also, update 
line."
***************
*** 1491,1498 ****
           (skip-chars-forward " \t")
           (if (looking-at "\&") (delete-char 1))
           (delete-region pos (point))
!          (if (not (f90-in-string))
!              (progn (delete-horizontal-space) (insert " ")))
           (if (and auto-fill-function
                    (> (save-excursion (end-of-line)
                                       (current-column))
--- 1487,1495 ----
           (skip-chars-forward " \t")
           (if (looking-at "\&") (delete-char 1))
           (delete-region pos (point))
!          (unless (f90-in-string)
!              (delete-horizontal-space)
!              (insert " "))
           (if (and auto-fill-function
                    (> (save-excursion (end-of-line)
                                       (current-column))
***************
*** 1561,1614 ****
    (let ((count 1) (top-of-window (window-start)) (matching-beg nil)
        (end-point (point)) (case-fold-search t)
        beg-name end-name beg-block end-block end-struct)
!     (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
!                       (setq end-struct (f90-looking-at-program-block-end)))
!       (progn
!         (setq end-block (car end-struct))
!         (setq end-name  (car (cdr end-struct)))
!         (save-excursion
!           (beginning-of-line)
!           (while 
!               (and (not (zerop count))
!                    (let ((stop nil) notexist)
!                      (while (not stop)
!                        (setq notexist
!                              (not (re-search-backward 
!                                    (concat "\\(" f90-blocks-re "\\)") nil t)))
!                        (if notexist
!                            (setq stop t)
!                          (setq stop
!                                (not (or (f90-in-string)
!                                         (f90-in-comment))))))
!                      (not notexist)))
!             (beginning-of-line) (skip-chars-forward " \t0-9")
!             (cond ((setq matching-beg
!                          (cond
!                           ((f90-looking-at-do))
!                           ((f90-looking-at-if-then))
!                           ((f90-looking-at-where-or-forall))
!                           ((f90-looking-at-select-case))
!                           ((f90-looking-at-type-like))
!                           ((f90-looking-at-program-block-start))))
!                    (setq count (- count 1)))
!                   ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))
!                    (setq count (+ count 1)))))
!           (if (not (zerop count))
!               (message "No matching beginning.")
!             (f90-update-line)
!             (if (eq f90-smart-end 'blink)
!                 (if (< (point) top-of-window)
!                     (message "Matches %s: %s"
!                              (what-line)
!                              (buffer-substring
!                               (line-beginning-position)
!                               (line-end-position)))
!                   (sit-for 1)))
!             (setq beg-block (car matching-beg))
!             (setq beg-name (car (cdr matching-beg)))
!             (goto-char end-point)
!             (beginning-of-line)
!             (f90-block-match beg-block beg-name end-block end-name)))))))
  
  (defun f90-insert-end ()
    "Insert a complete end statement matching beginning of present block."
--- 1558,1610 ----
    (let ((count 1) (top-of-window (window-start)) (matching-beg nil)
        (end-point (point)) (case-fold-search t)
        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)))
!       (setq end-block (car end-struct))
!       (setq end-name  (car (cdr end-struct)))
!       (save-excursion
!         (beginning-of-line)
!         (while 
!             (and (not (zerop count))
!                  (let ((stop nil) notexist)
!                    (while (not stop)
!                      (setq notexist
!                            (not (re-search-backward 
!                                  (concat "\\(" f90-blocks-re "\\)") nil t)))
!                      (if notexist
!                          (setq stop t)
!                        (setq stop
!                              (not (or (f90-in-string)
!                                       (f90-in-comment))))))
!                    (not notexist)))
!           (beginning-of-line) (skip-chars-forward " \t0-9")
!           (cond ((setq matching-beg
!                        (cond
!                         ((f90-looking-at-do))
!                         ((f90-looking-at-if-then))
!                         ((f90-looking-at-where-or-forall))
!                         ((f90-looking-at-select-case))
!                         ((f90-looking-at-type-like))
!                         ((f90-looking-at-program-block-start))))
!                  (setq count (- count 1)))
!                 ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))
!                  (setq count (+ count 1)))))
!         (if (not (zerop count))
!             (message "No matching beginning.")
!           (f90-update-line)
!           (if (eq f90-smart-end 'blink)
!               (if (< (point) top-of-window)
!                   (message "Matches %s: %s"
!                            (what-line)
!                            (buffer-substring
!                             (line-beginning-position)
!                             (line-end-position)))
!                 (sit-for 1)))
!           (setq beg-block (car matching-beg))
!           (setq beg-name (car (cdr matching-beg)))
!           (goto-char end-point)
!           (beginning-of-line)
!           (f90-block-match beg-block beg-name end-block end-name))))))
  
  (defun f90-insert-end ()
    "Insert a complete end statement matching beginning of present block."
***************
*** 1697,1710 ****
        (goto-char beg)
        (unwind-protect
          (while (re-search-forward keyword-re end t)
!           (if (progn
!                 (setq state (parse-partial-sexp ref-point (point)))
!                 (or (nth 3 state) (nth 4 state)
!                     (save-excursion   ; Check for cpp directive.
!                       (beginning-of-line)
!                       (skip-chars-forward " \t0-9")
!                       (looking-at "#"))))
!               ()
              (setq ref-point (point)
                    back-point (save-excursion (backward-word 1) (point)))
              (setq saveword (buffer-substring back-point ref-point))
--- 1693,1705 ----
        (goto-char beg)
        (unwind-protect
          (while (re-search-forward keyword-re end t)
!           (unless (progn
!                       (setq state (parse-partial-sexp ref-point (point)))
!                       (or (nth 3 state) (nth 4 state)
!                           (save-excursion ; Check for cpp directive.
!                             (beginning-of-line)
!                             (skip-chars-forward " \t0-9")
!                             (looking-at "#"))))
              (setq ref-point (point)
                    back-point (save-excursion (backward-word 1) (point)))
              (setq saveword (buffer-substring back-point ref-point))