From 6e228c970cbcf78eae1939acdf644ef6de5b4404 Mon Sep 17 00:00:00 2001 From: Michael Olson Date: Sat, 4 Nov 2006 04:51:01 +0000 Subject: [PATCH] Try to make relative links to project pages work 2006-11-03 Michael Olson * lisp/muse-project.el (muse-project-page-file): Make relative links work as expected, hopefully. git-archimport-id: mwolson@gnu.org--2006/muse--main--1.0--patch-239 --- ChangeLog | 3 +++ lisp/muse-project.el | 30 +++++++++++++++++++++--------- 2 files changed, 24 insertions(+), 9 deletions(-) diff --git a/ChangeLog b/ChangeLog index 050b284..9636311 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2006-11-03 Michael Olson + * lisp/muse-project.el (muse-project-page-file): Make relative + links work as expected, hopefully. + * lisp/muse-publish.el (muse-publish-this-file): Set the current output style manually, since it will differ from anything in the publishing style list. diff --git a/lisp/muse-project.el b/lisp/muse-project.el index 75700d1..740a69f 100644 --- a/lisp/muse-project.el +++ b/lisp/muse-project.el @@ -318,20 +318,32 @@ For an example of the use of this function, see (defun muse-project-page-file (page project &optional no-check-p) "Return a filename if PAGE exists within the given Muse PROJECT." (setq project (muse-project project)) - (let ((dir (file-name-directory page))) - (when dir (setq page (file-name-nondirectory page))) + (let ((dir (file-name-directory page)) + (expanded-path nil)) + (when dir + (setq expanded-path (concat (expand-file-name + page + (file-name-directory (muse-current-file))) + (when muse-file-extension + (concat "." muse-file-extension)))) + (setq page (file-name-nondirectory page))) (let ((files (muse-collect-alist (muse-project-file-alist project no-check-p) page)) (matches nil)) (if dir - (save-match-data - (dolist (file files) - (let ((pos (string-match (concat (regexp-quote dir) "\\'") - (file-name-directory (cdr file))))) - (when pos - (setq matches (cons (cons pos (cdr file)) - matches))))) + (catch 'done + (save-match-data + (dolist (file files) + (if (and expanded-path + (string= expanded-path (cdr file))) + (throw 'done (cdr file)) + (let ((pos (string-match (concat (regexp-quote dir) "\\'") + (file-name-directory (cdr file))))) + (when pos + (setq matches (cons (cons pos (cdr file)) + matches))))))) + ;; if we haven't found an exact match, pick a candidate (car (muse-sort-by-rating matches))) (dolist (file files) (setq matches (cons (cons (length (cdr file)) (cdr file)) -- 2.11.4.GIT