* src/scm/path.scm: rework doc-path handling completely, migrating

much of the code to command-line.scm.
(gnc:expand-path): new function.
(gnc:load-system-config-if-needed): use gnc:*config-path*, not
gnc:*config-dir*.
(gnc:locale-prefixes): removed.
(gnc:default-doc-dirs): removed.
(gnc:_expand-doc-path_): removed.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@6363 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Rob Browning 2001-12-11 16:40:19 +00:00
parent 2659b8bdcf
commit 97a6deee86

View File

@ -15,42 +15,20 @@
;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652
;; Boston, MA 02111-1307, USA gnu@gnu.org ;; Boston, MA 02111-1307, USA gnu@gnu.org
(define (gnc:locale-prefixes) (define (gnc:expand-path new-list current-list default-generator)
(let* ((locale (setlocale LC_MESSAGES)) (define (expand-path-item item)
(strings (cond ((not (string? locale)) '()) (cond ((string? item) (list item))
((equal? locale "C") '()) ((symbol? item)
((<= (string-length locale) 2) (list locale)) (case item
(else (list (substring locale 0 2) locale))))) ((default) (default-generator))
(reverse (cons "C" strings)))) ((current) current-list)
(else
(define (gnc:default-doc-dirs) (gnc:warn "bad symbol " item " in gnc path. Ignoring.")
(let ((user-paths (list '())))
(list (getenv "HOME") ".gnucash" "html"))) (else
(locale-paths (map (lambda (prefix) (gnc:warn "bad item " item " in gnc path. Ignoring.")
(list gnc:_install-help-dir_ prefix)) '())))
(gnc:locale-prefixes))) (apply append (map expand-path-item new-list)))
(base-paths (list
(list gnc:_install-help-dir_))))
(map (lambda (paths) (apply build-path paths))
(append user-paths locale-paths base-paths))))
(define (gnc:_expand-doc-path_ new-path)
(gnc:debug "expanding doc-path value " new-path)
(let ((path-interpret
(lambda (item)
(cond ((string? item) (list item))
((symbol? item)
(case item
((default) (gnc:default-doc-dirs))
((current)
(gnc:config-var-value-get gnc:*doc-path*))
(else
(gnc:warn "bad item " item " in doc-path. Ignoring.")
'())))
(else
(gnc:warn "bad item " item " in doc-path. Ignoring.")
'())))))
(apply append (map path-interpret new-path))))
(define (gnc:make-dir dir) (define (gnc:make-dir dir)
(if (access? dir X_OK) (if (access? dir X_OK)
@ -98,10 +76,9 @@
(begin (begin
(gnc:debug "loading system configuration") (gnc:debug "loading system configuration")
(let ((system-config (build-path (let ((system-config (gnc:find-file
(gnc:config-var-value-get gnc:*config-dir*) "config"
"config"))) (gnc:config-var-value-get gnc:*config-path*))))
(if (false-if-exception (primitive-load system-config)) (if (false-if-exception (primitive-load system-config))
(set! system-config-loaded? #t) (set! system-config-loaded? #t)
(begin (begin