diff lisp/progmodes/ada-mode.el @ 71924:c09c379b85d4

(ada-mode): Rewrite ff-special-constructs init.
author Thien-Thi Nguyen <ttn@gnuvola.org>
date Sun, 16 Jul 2006 21:11:47 +0000
parents 2a4ed80e93ba
children e1bac685e6a0 02e39decdc84 8a8e69664178
line wrap: on
line diff
--- a/lisp/progmodes/ada-mode.el	Sun Jul 16 21:08:28 2006 +0000
+++ b/lisp/progmodes/ada-mode.el	Sun Jul 16 21:11:47 2006 +0000
@@ -1208,60 +1208,36 @@
         ff-file-created-hook 'ada-make-body)
   (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
 
-  ;; Some special constructs for find-file.el
-  ;; We do not need to add the construction for 'with', which is in the
-  ;; standard find-file.el
+  ;; Some special constructs for find-file.el.
   (make-local-variable 'ff-special-constructs)
-
-  ;; Go to the parent package :
-  (add-to-list 'ff-special-constructs
-               (cons (eval-when-compile
-                       (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
-                               "\\(body[ \t]+\\)?"
-                               "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
-                     (lambda ()
-		       (if (fboundp 'ff-get-file)
-			   (if (boundp 'fname)
-			       (set 'fname (ff-get-file
-					    ada-search-directories-internal
-					    (ada-make-filename-from-adaname
-					     (match-string 3))
-					    ada-spec-suffixes)))))))
-  ;; Another special construct for find-file.el : when in a separate clause,
-  ;; go to the correct package.
-  (add-to-list 'ff-special-constructs
-               (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
-                     (lambda ()
-		       (if (fboundp 'ff-get-file)
-			   (if (boundp 'fname)
-			       (setq fname (ff-get-file
-					    ada-search-directories-internal
-					    (ada-make-filename-from-adaname
-					     (match-string 1))
-					    ada-spec-suffixes)))))))
-
-  ;; Another special construct, that redefines the one in find-file.el. The
-  ;; old one can handle only one possible type of extension for Ada files
-  ;;  remove from the list the standard "with..." that is put by find-file.el,
-  ;;  since it uses the old ada-spec-suffix variable
-  ;; This one needs to replace the standard one defined in find-file.el (with
-  ;;  Emacs <= 20.4), since that one uses the old variable ada-spec-suffix
-  (let ((old-construct
-         (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
-        (new-cdr
-         (lambda ()
-	   (if (fboundp 'ff-get-file)
-	       (if (boundp 'fname)
-		   (set 'fname (ff-get-file
-				ada-search-directories-internal
-				(ada-make-filename-from-adaname
-				 (match-string 1))
-				ada-spec-suffixes)))))))
-    (if old-construct
-        (setcdr old-construct new-cdr)
-      (add-to-list 'ff-special-constructs
-                   (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
-                         new-cdr))))
+  (mapc (lambda (pair)
+          (add-to-list 'ff-special-constructs pair))
+        `(
+          ;; Go to the parent package.
+          (,(eval-when-compile
+              (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
+                      "\\(body[ \t]+\\)?"
+                      "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
+           . ,(lambda ()
+                (ff-get-file
+                 ada-search-directories-internal
+                 (ada-make-filename-from-adaname (match-string 3))
+                 ada-spec-suffixes)))
+          ;; A "separate" clause.
+          ("^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
+           . ,(lambda ()
+                (ff-get-file
+                 ada-search-directories-internal
+                 (ada-make-filename-from-adaname (match-string 1))
+                 ada-spec-suffixes)))
+          ;; A "with" clause.
+          ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
+           . ,(lambda ()
+                (ff-get-file
+                 ada-search-directories-internal
+                 (ada-make-filename-from-adaname (match-string 1))
+                 ada-spec-suffixes)))
+          ))
 
   ;;  Support for outline-minor-mode
   (set (make-local-variable 'outline-regexp)