[Emacs-diffs] Changes to emacs/lisp/find-file.el

[Richard M. Stallman]

Index: emacs/lisp/find-file.el
diff -c emacs/lisp/find-file.el:1.16 emacs/lisp/find-file.el:1.17
*** emacs/lisp/find-file.el:1.16        Tue Jul  3 09:02:55 2001
--- emacs/lisp/find-file.el     Sun Dec 16 20:51:32 2001
***************
*** 514,519 ****
--- 514,616 ----
  
      found))                        ;; return buffer-name or filename
  
+ (defun ff-other-file-name ()
+   "Return name of the header or source file corresponding to the current file.
+ Being on a `#include' line pulls in that file, but see the help on
+ the `ff-ignore-include' variable."
+ 
+   (let (match           ;; matching regexp for this file
+         suffixes        ;; set of replacing regexps for the matching regexp
+         action          ;; function to generate the names of the other files
+         fname           ;; basename of this file
+         pos             ;; where we start matching filenames
+         stub            ;; name of the file without extension
+         alist           ;; working copy of the list of file extensions
+         pathname        ;; the pathname of the file or the #include line
+         default-name    ;; file we should create if none found
+         format          ;; what we have to match
+         found           ;; name of the file or buffer found - nil if none
+         dirs            ;; local value of ff-search-directories
+         no-match)       ;; whether we know about this kind of file
+ 
+     (message "Working...")
+ 
+     (setq dirs
+           (if (symbolp ff-search-directories)
+               (ff-list-replace-env-vars (symbol-value ff-search-directories))
+             (ff-list-replace-env-vars ff-search-directories)))
+ 
+     (save-excursion
+       (beginning-of-line 1)
+       (setq fname (ff-treat-as-special)))
+ 
+     (cond
+      ((and (not ff-ignore-include) fname)
+       (setq default-name fname)
+       (setq found (ff-get-file-name dirs fname nil)))
+ 
+      ;; let's just get the corresponding file
+      (t
+       (setq alist (if (symbolp ff-other-file-alist)
+                       (symbol-value ff-other-file-alist)
+                     ff-other-file-alist)
+             pathname (if (buffer-file-name)
+                          (buffer-file-name)
+                        "/none.none"))
+ 
+       (setq fname (file-name-nondirectory pathname)
+             no-match nil
+             match (car alist))
+ 
+       ;; find the table entry corresponding to this file
+       (setq pos (ff-string-match (car match) fname))
+       (while (and match (if (and pos (>= pos 0)) nil (not pos)))
+         (setq alist (cdr alist))
+         (setq match (car alist))
+         (setq pos (ff-string-match (car match) fname)))
+ 
+       ;; no point going on if we haven't found anything
+       (if (not match)
+           (setq no-match t)
+ 
+         ;; otherwise, suffixes contains what we need
+         (setq suffixes (car (cdr match))
+               action (car (cdr match))
+               found nil)
+ 
+         ;; if we have a function to generate new names,
+         ;; invoke it with the name of the current file
+         (if (and (atom action) (fboundp action))
+             (progn
+               (setq suffixes (funcall action (buffer-file-name))
+                     match (cons (car match) (list suffixes))
+                     stub nil
+                     default-name (car suffixes)))
+ 
+           ;; otherwise build our filename stub
+           (cond
+ 
+            ;; get around the problem that 0 and nil both mean false!
+            ((= pos 0)
+             (setq format "")
+             (setq stub "")
+             )
+ 
+            (t
+             (setq format (concat "\\(.+\\)" (car match)))
+             (string-match format fname)
+             (setq stub (substring fname (match-beginning 1) (match-end 1)))
+             ))
+ 
+           ;; if we find nothing, we should try to get a file like this one
+           (setq default-name
+                 (concat stub (car (car (cdr match))))))
+ 
+         ;; do the real work - find the file
+         (setq found
+               (ff-get-file-name dirs stub suffixes)))))
+     found))                        ;; return buffer-name or filename
+ 
  (defun ff-get-file (search-dirs filename &optional suffix-list other-window)
    "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub).
  If (optional) SUFFIX-LIST is nil, search for fname, otherwise search