RptCleanup - Generalize report loading function to allow use for modules other than the reports

gnucash/report/report.scm

@@ -791,4 +791,71 @@
 (define category-barchart-expense-uuid "b1f15b2052c149df93e698fe85a81ea6")
 (define category-barchart-asset-uuid "e9cf815f79db44bcb637d0295093ae3d")
 (define category-barchart-liability-uuid "faf410e8f8da481fbc09e4763da40bcc")
+
+(export report-module-loader)
+;; Given a list of module prefixes, load all guile modules with these prefixes
+;; This assumes the modules are located on the file system in a
+;; path matching the module prefix
+;; For example passing
+;; '('(gnucash report stylesheets) '(gnucash report reports standard))
+;; will search for scm files in
+;; - <gnc-guile-dir>/gnucash/report/stylesheets
+;; - <gnc-guile-dir>/gnucash/report/reports/standard
+;; and try to load them.
+;; This function is non-recursive so it won't
+;; descend in subdirectories.
+(define (report-module-loader mod-prefix-list)
+
+  ;; Returns a list of files in a directory
+  ;;
+  ;; Param:
+  ;;   dir - directory name
+  ;;
+  ;; Return value:
+  ;;   list of files in the directory
+  (define (directory-files dir)
+    (cond
+      ((file-exists? dir)
+       (let ((dir-stream (opendir dir)))
+            (let loop ((fname (readdir dir-stream))
+                       (acc '()))
+                      (cond
+                        ((eof-object? fname)
+                         (closedir dir-stream)
+                         acc)
+                        (else
+                          (loop (readdir dir-stream)
+                                (if (string-suffix? ".scm" fname)
+                                    (cons (string-drop-right fname 4) acc)
+                                    acc)))))))
+      (else
+        (gnc:warn "Can't access " dir ".\nEmpty list will be returned.")
+        '())))
+
+    ;; Return a list of symbols representing modules in the directory
+    ;; matching the prefix
+    ;;
+    ;; Return value:
+    ;;  List of symbols for modules
+  (define (get-module-list mod-prefix)
+    (let* ((subdir (string-join (map symbol->string mod-prefix) "/"))
+           (mod-dir (gnc-build-scm-path subdir))
+           (mod-list (directory-files mod-dir)))
+          (gnc:debug "rpt-subdir=" subdir)
+          (gnc:debug "mod-dir=" mod-dir)
+          (gnc:debug "dir-files=" mod-list)
+     (map string->symbol mod-list)))
+
+  (for-each
+    (lambda (mod-prefix)
+      (for-each
+        (lambda (mod-file)
+                (let* ((module (append mod-prefix (list mod-file))))
+                      (module-use!
+                       (current-module)
+                       (resolve-interface module))))
+        (get-module-list mod-prefix)))
+    mod-prefix-list))
+
+;; Add hooks when this module is loaded
 (gnc-hook-add-scm-dangler HOOK-SAVE-OPTIONS gnc:save-style-sheet-options)

gnucash/report/reports/aging.scm

@@ -32,8 +32,6 @@
 
 (gnc:module-load "gnucash/report" 0)
 
-(use-modules (gnucash report reports))
-
 (define optname-to-date (N_ "To"))
 (define optname-sort-by (N_ "Sort By"))
 (define optname-sort-order (N_ "Sort Order"))

gnucash/report/reports/reports.scm

@@ -42,60 +42,11 @@
 ;owner-report-create)
 
 (define report-dirs (list
-    "standard" ; base directory for standard reports included in gnucash
-    "example"  ; base directory for example reports included in gnucash
+    '(gnucash report reports standard) ; base directory for standard reports included in gnucash
+    '(gnucash report reports example)  ; base directory for example reports included in gnucash
 ))
 
-;; Returns a list of files in a directory
-;;
-;; Param:
-;;   dir - directory name
-;;
-;; Return value:
-;;   list of files in the directory
-
-(define (directory-files dir)
-  (cond
-   ((file-exists? dir)
-    (let ((dir-stream (opendir dir)))
-      (let loop ((fname (readdir dir-stream))
-                 (acc '()))
-        (cond
-         ((eof-object? fname)
-          (closedir dir-stream)
-          acc)
-         (else
-          (loop (readdir dir-stream)
-                (if (string-suffix? ".scm" fname)
-                    (cons (string-drop-right fname 4) acc)
-                    acc)))))))
-   (else
-    (gnc:warn "Can't access " dir ".\nEmpty list will be returned.")
-    '())))
-
-;; Return a list of symbols representing reports in the standard reports directory
-;;
-;; Return value:
-;;  List of symbols for reports
-(define (get-report-list subdir)
-  (let* ((rpt-dir (gnc-build-reports-path subdir))
-         (rpt-list (directory-files rpt-dir)))
-        (gnc:debug "rpt-subdir=" subdir)
-        (gnc:debug "rpt-dir=" rpt-dir)
-        (gnc:debug "dir-files=" rpt-list)
-        rpt-list))
-
-(for-each
-  (lambda (rpt-dir-str)
-    (for-each
-     (lambda (rpt-file-str)
-       (let ((rpt-file (string->symbol rpt-file-str))
-             (rpt-dir (string->symbol rpt-dir-str)))
-       (module-use!
-        (current-module)
-        (resolve-interface `(gnucash report reports ,rpt-dir ,rpt-file)))))
-     (get-report-list rpt-dir-str)))
-  report-dirs)
+(report-module-loader report-dirs)
 
 (use-modules (gnucash gnc-module))
 (gnc:module-load "gnucash/engine" 0)

gnucash/report/reports/standard/customer-summary.scm

@@ -34,7 +34,6 @@
 (use-modules (gnucash gettext))
 
 (gnc:module-load "gnucash/report" 0)
-(use-modules (gnucash report reports))
 
 ;; Option names
 (define optname-from-date (N_ "From"))

gnucash/report/reports/standard/invoice.scm

@@ -30,7 +30,6 @@
 (use-modules (gnucash utilities))
 
 (gnc:module-load "gnucash/report" 0)
-(use-modules (gnucash report reports))
 
 (define (addif pred . data) (if pred data '()))
 

gnucash/report/reports/standard/job-report.scm

@@ -32,7 +32,6 @@
 (use-modules (gnucash gettext))
 
 (gnc:module-load "gnucash/report" 0)
-(use-modules (gnucash report reports))
 
 (define acct-string (N_ "Account"))
 (define owner-string (N_ "Job"))

gnucash/report/reports/standard/owner-report.scm

@@ -33,7 +33,6 @@
 (use-modules (gnucash gettext))
 
 (gnc:module-load "gnucash/report" 0)
-(use-modules (gnucash report reports))
 
 ;; Option names
 (define optname-from-date (N_ "From"))

gnucash/report/reports/standard/payables.scm

@@ -32,7 +32,6 @@
 (gnc:module-load "gnucash/report" 0)
 
 (use-modules (gnucash report reports aging))
-(use-modules (gnucash report reports))
 
 (define acc-page gnc:pagename-general)
 (define this-acc (N_ "Payable Account"))

gnucash/report/reports/standard/receipt.scm

@@ -24,8 +24,6 @@
 (gnc:module-load "gnucash/html" 0)
 (gnc:module-load "gnucash/engine" 0)
 
-(use-modules (gnucash report reports))
-
 (use-modules (gnucash report eguile-utilities))
 (use-modules (gnucash report eguile-html-utilities))
 (use-modules (gnucash report eguile-gnc))

gnucash/report/reports/standard/receivables.scm

@@ -32,7 +32,6 @@
 (gnc:module-load "gnucash/report" 0)
 
 (use-modules (gnucash report reports aging))
-(use-modules (gnucash report reports))
 
 (define acc-page gnc:pagename-general)
 (define this-acc (N_ "Receivables Account"))

gnucash/report/reports/standard/taxinvoice.scm

@@ -32,8 +32,6 @@
 (gnc:module-load "gnucash/html" 0)
 (gnc:module-load "gnucash/engine" 0)
 
-(use-modules (gnucash report reports))
-
 (use-modules (gnucash report eguile-utilities))
 (use-modules (gnucash report eguile-html-utilities))
 (use-modules (gnucash report eguile-gnc))

gnucash/report/reports/standard/test/test-stress-options.scm

@@ -4,7 +4,6 @@
 (use-modules (gnucash gnc-module))
 (gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
 (use-modules (tests test-engine-extras))
-(use-modules (gnucash report reports))
 (use-modules (gnucash report reports standard view-column))
 (use-modules (gnucash report stylesheets))
 (use-modules (gnucash report reports standard taxinvoice))

libgnucash/core-utils/core-utils.i

@@ -74,6 +74,7 @@ gchar * gnc_build_userdata_path(const gchar *);
 %newobject gnc_file_path_absolute;
 gchar *gnc_file_path_absolute (const gchar *, const gchar *);
 
+gchar * gnc_build_scm_path(const gchar *);
 gchar * gnc_build_report_path(const gchar *);
 gchar * gnc_build_stdreports_path(const gchar *);
 gchar * gnc_build_reports_path(const gchar *);

libgnucash/core-utils/core-utils.scm

@@ -39,6 +39,7 @@
 (re-export gnc-path-get-stdreportsdir)
 (re-export gnc-path-find-localized-html-file)
 (re-export gnc-build-userdata-path)
+(re-export gnc-build-scm-path)
 (re-export gnc-build-report-path)
 (re-export gnc-build-stdreports-path)
 (re-export gnc-build-reports-path)

libgnucash/core-utils/gnc-filepath-utils.cpp

@@ -1165,6 +1165,22 @@ gnc_build_data_path (const gchar *filename)
     return g_strdup(path.c_str());
 }
 
+/** @fn gchar * gnc_build_scm_path (const gchar *filename)
+ *  @brief Make a path to filename in the scm directory.
+ *
+ * @param filename The name of the file
+ *
+ *  @return An absolute path. The returned string should be freed by the user
+ *  using g_free().
+ */
+
+gchar *
+gnc_build_scm_path (const gchar *filename)
+{
+    gchar *result = g_build_filename(gnc_path_get_scmdir(), filename, (gchar *)NULL);
+    return result;
+}
+
 /** @fn gchar * gnc_build_report_path (const gchar *filename)
  *  @brief Make a path to filename in the report directory.
  *

libgnucash/core-utils/gnc-filepath-utils.h

@@ -110,6 +110,7 @@ gchar *gnc_build_userconfig_path (const gchar *filename);
 gchar *gnc_build_book_path (const gchar *filename);
 gchar *gnc_build_translog_path (const gchar *filename);
 gchar *gnc_build_data_path (const gchar *filename);
+gchar *gnc_build_scm_path (const gchar *filename);
 gchar *gnc_build_report_path (const gchar *filename);
 gchar *gnc_build_reports_path (const gchar *dirname);
 gchar *gnc_build_stdreports_path (const gchar *filename);