mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
* 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:
parent
2659b8bdcf
commit
97a6deee86
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user