# HG changeset patch
# User Richard M. Stallman <rms@gnu.org>
# Date 1008553892 0
# Node ID e12d545c9a48c8039dcd0b2c26be8f47106fedc8
# Parent  a4794d1dada13404419224e88b6c8cf28cce5ea1
(ff-other-file-name): New function.

diff -r a4794d1dada1 -r e12d545c9a48 lisp/find-file.el
--- a/lisp/find-file.el	Sun Dec 16 21:52:36 2001 +0000
+++ b/lisp/find-file.el	Mon Dec 17 01:51:32 2001 +0000
@@ -514,6 +514,103 @@
 
     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