* lisp/htmlfontify.el: Make it obey the font-lock-face text property.

Miscellaneous cleanup such as:
- Don't hide expressions after a closing paren.
- Move initial setq into let.
- Hoist common parts out of ifs.
(hfy-p-to-face, hfy-p-to-face-lennart): Remove.
(hfy-face-at): Use get-text-property instead.
(hfy-prop-invisible-p): Use invisible-p if available.
(htmlfontify-manual): Use \\[...].
(hfy-html-quote-regex): Use [...].
(hfy-combined-face-spec): Simplify.
(hfy-compile-face-map): Don't presume point-min==1.
(hfy-css-name, hfy-buffer, htmlfontify-buffer): Use \' rather than $ to
match end of string.
(hfy-text-p): η-reduce.
(hfy-tags-for-file): Receive cache-hash directly.
(hfy-mark-tag-names): Adjust call.

1 files changed, 128 insertions, 166 deletions

diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index d359bb0da86..5ecc529e561 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -108,13 +108,13 @@
   `htmlfontify-load-rgb-file'
   `htmlfontify-unload-rgb-file'\n
 In order to:\n
-fontify a file you have open:           M-x htmlfontify-buffer
-prepare the etags map for a directory:  M-x htmlfontify-run-etags
-copy a directory, fontifying as you go: M-x htmlfontify-copy-and-link-dir\n
+fontify a file you have open:           \\[htmlfontify-buffer]
+prepare the etags map for a directory:  \\[htmlfontify-run-etags]
+copy a directory, fontifying as you go: \\[htmlfontify-copy-and-link-dir]\n
 The following might be useful when running non-windowed or in batch mode:
 \(note that they shouldn't be necessary - we have a built in map)\n
-load an X11 style rgb.txt file:         M-x htmlfontify-load-rgb-file
-unload the current rgb.txt file:        M-x htmlfontify-unload-rgb-file\n
+load an X11 style rgb.txt file:         \\[htmlfontify-load-rgb-file]
+unload the current rgb.txt file:        \\[htmlfontify-unload-rgb-file]\n
 And here's a programmatic example:\n
 \(defun rtfm-build-page-header (file style)
   (format \"#define  TEMPLATE red+black.html
@@ -150,10 +150,12 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
   :prefix "hfy-")
 
 (defcustom hfy-page-header 'hfy-default-header
-  "Function called with two arguments (the filename relative to the top
+  "Function called to build the header of the html source.
+This is called with two arguments (the filename relative to the top
 level source directory being etag'd and fontified), and a string containing
-the <style>...</style> text to embed in the document- the string returned will
-be used as the header for the htmlfontified version of the source file.\n
+the <style>...</style> text to embed in the document.
+It should return the string returned will be used as the header for the
+htmlfontified version of the source file.\n
 See also `hfy-page-footer'."
   :group 'htmlfontify
   ;; FIXME: Why place such a :tag everywhere?  Isn't it imposing your
@@ -162,16 +164,17 @@ See also `hfy-page-footer'."
   :type  '(function))
 
 (defcustom hfy-split-index nil
-  "Whether or not to split the index `hfy-index-file' alphabetically
-on the first letter of each tag.  Useful when the index would otherwise
+  "Whether or not to split the index `hfy-index-file' alphabetically.
+If non-nil, the index is split on the first letter of each tag.
+Useful when the index would otherwise
 be large and take a long time to render or be difficult to navigate."
   :group 'htmlfontify
   :tag   "split-index"
   :type  '(boolean))
 
 (defcustom hfy-page-footer 'hfy-default-footer
-  "As `hfy-page-header', but generates the output footer
-\(and takes only one argument, the filename)."
+  "As `hfy-page-header', but generates the output footer.
+It takes only one argument, the filename."
   :group 'htmlfontify
   :tag   "page-footer"
   :type  '(function))
@@ -204,7 +207,8 @@ code using this should fall back to `hfy-extn'."
   :type  '(choice string (const nil)))
 
 (defcustom hfy-link-style-fun 'hfy-link-style-string
-  "Set this to a function, which will be called with one argument
+  "Function to customize the appearance of hyperlinks.
+Set this to a function, which will be called with one argument
 \(a \"{ foo: bar; ...}\" CSS style-string) - it should return a copy of
 its argument, altered so as to make any changes you want made for text which
 is a hyperlink, in addition to being in the class to which that style would
@@ -227,7 +231,7 @@ fontification-and-hyperlinking."
   :tag   "instance-file"
   :type  '(string))
 
-(defcustom hfy-html-quote-regex "\\(<\\|\"\\|&\\|>\\)"
+(defcustom hfy-html-quote-regex "\\([<\"&>]\\)"
   "Regex to match (with a single back-reference per match) strings in HTML
 which should be quoted with `hfy-html-quote' (and `hfy-html-quote-map')
 to make them safe."
@@ -555,7 +559,8 @@ therefore no longer care about) will be invalid at any time.\n
     (while sa
       (setq elt (car sa)
             sa  (cdr sa))
-      (if (memq elt set-b) (setq interq (cons elt interq)))) interq))
+      (if (memq elt set-b) (setq interq (cons elt interq))))
+    interq))
 
 (defun hfy-colour-vals (colour)
   "Where COLOUR is a color name or #XXXXXX style triplet, return a
@@ -586,7 +591,8 @@ in a windowing system - try to trick it..."
                    (setq cperl-syntaxify-by-font-lock t)))
              (setq hfy-cperl-mode-kludged-p t))) )
 
-(defun hfy-opt (symbol) "Is option SYMBOL set." (memq symbol hfy-optimisations))
+(defun hfy-opt (symbol) "Is option SYMBOL set."
+  (memq symbol hfy-optimisations))
 
 (defun hfy-default-header (file style)
   "Default value for `hfy-page-header'.
@@ -717,7 +723,8 @@ of the variable `hfy-src-doc-link-style', removing text matching the regex
       (concat (replace-match hfy-src-doc-link-style
                              'fixed-case
                              'literal
-                             style-string) " }") style-string))
+                             style-string) " }")
+    style-string))
 
 ;; utility functions - cast emacs style specification values into their
 ;; css2 equivalents:
@@ -835,11 +842,11 @@ VAL is ignored here."
   "Return a `defface' style alist of possible specifications for FACE.
 Entries resulting from customization (`custom-set-faces') will take
 precedence."
-  (let ((spec  nil))
-    (setq spec (append (or (get face 'saved-face)        (list))
-                       (or (get face 'face-defface-spec) (list))))
-    (if (and hfy-display-class hfy-default-face-def (eq face 'default))
-        (setq spec (append hfy-default-face-def spec))) spec))
+  (append
+   (if (and hfy-display-class hfy-default-face-def (eq face 'default))
+       hfy-default-face-def)
+   (get face 'saved-face)
+   (get face 'face-defface-spec)))
 
 (defun hfy-face-attr-for-class (face &optional class)
   "Return the face attributes for FACE.
@@ -1045,10 +1052,9 @@ haven't encountered them yet.  Returns a `hfy-style-assoc'."
 and return a `hfy-style-assoc'.\n
 See also `hfy-face-to-style-i', `hfy-flatten-style'."
   ;;(message "hfy-face-to-style");;DBUG
-  (let ((face-def (hfy-face-resolve-face fn))
-        (final-style nil))
-
-    (setq final-style (hfy-flatten-style (hfy-face-to-style-i face-def)))
+  (let* ((face-def (hfy-face-resolve-face fn))
+         (final-style
+          (hfy-flatten-style (hfy-face-to-style-i face-def))))
     ;;(message "%S" final-style)
     (if (not (assoc "text-decoration" final-style))
         (progn (setq final-style
@@ -1090,8 +1096,9 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
             (string-match "^[Ii]nfo-\\(.*\\)"   face-name))
         (progn
           (setq face-name (match-string 1 face-name))
-          (if (string-match "\\(.*\\)-face$" face-name)
-              (setq face-name (match-string 1 face-name))) face-name)
+          (if (string-match "\\(.*\\)-face\\'" face-name)
+              (setq face-name (match-string 1 face-name)))
+          face-name)
       face-name)) )
 
 ;; construct an assoc of (stripped-name . "{ css-stuff-here }") pairs
@@ -1101,91 +1108,45 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
 and return a CSS style specification.\n
 See also `hfy-face-to-style'."
   ;;(message "hfy-face-to-css");;DBUG
-  (let ((css-list nil)
-        (css-text nil)
-        (seen     nil))
-    ;;(message "(hfy-face-to-style %S)" fn)
-    (setq css-list (hfy-face-to-style fn))
-    (setq css-text
+  (let* ((css-list (hfy-face-to-style fn))
+         (seen     nil)
+         (css-text
           (mapcar
            (lambda (E)
              (if (car E)
                  (unless (member (car E) seen)
                    (push (car E) seen)
                    (format " %s: %s; " (car E) (cdr E)))))
-           css-list))
+           css-list)))
     (cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )
 
-;; extract a face from a list of char properties, if there is one:
-(defun hfy-p-to-face (props)
-  "Given PROPS, a list of text properties, return the value of the face
-property, or nil."
-  (if props
-      (if (string= (car props) "face")
-          (let ((propval (cadr props)))
-              (if (and (listp propval) (not (cdr propval)))
-                  (car propval)
-                propval))
-        (hfy-p-to-face (cddr props)))
-    nil))
-
-(defun hfy-p-to-face-lennart (props)
-  "Given PROPS, a list of text properties, return the value of the face
-property, or nil."
-  (when props
-    (let ((face (plist-get props 'face))
-          (font-lock-face (plist-get props 'font-lock-face))
-          (button (plist-get props 'button))
-          ;;(face-rec (memq 'face props))
-          ;;(button-rec (memq 'button props)))
-          )
-      (if button
-          (let* ((category (plist-get props 'category))
-                 (face (when category (plist-get (symbol-plist category) 'face))))
-            face)
-        (or font-lock-face
-            face)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; (defun hfy-get-face-at (pos)
-;; ;;   (let ((face (get-char-property-and-overlay pos 'face)))
-;; ;;     (when (and face (listp face)) (setq face (car face)))
-;; ;;     (unless (listp face)
-;; ;;       face)))
-;;   ;;(get-char-property pos 'face)
-;;   ;; Overlays are handled later
-;;   (if (or (not show-trailing-whitespace)
-;;           (not (get-text-property pos 'hfy-show-trailing-whitespace)))
-;;       (get-text-property pos 'face)
-;;     (list 'trailing-whitespace (get-text-property pos 'face)))
-;;   )
-
-(defun hfy-prop-invisible-p (prop)
-  "Is text property PROP an active invisibility property?"
-  (or (and (eq buffer-invisibility-spec t) prop)
-      (or (memq prop buffer-invisibility-spec)
-          (assq prop buffer-invisibility-spec))))
+(defalias 'hfy-prop-invisible-p
+  (if (fboundp 'invisible-p) #'invisible-p
+    (lambda (prop)
+      "Is text property PROP an active invisibility property?"
+      (or (and (eq buffer-invisibility-spec t) prop)
+          (or (memq prop buffer-invisibility-spec)
+              (assq prop buffer-invisibility-spec))))))
 
 (defun hfy-find-invisible-ranges ()
   "Return a list of (start-point . end-point) cons cells of invisible regions."
-  (let (invisible p i e s) ;; return-value pos invisible end start
-    (save-excursion
+  (save-excursion
+    (let (invisible p i s) ;; return-value pos invisible end start
       (setq p (goto-char (point-min)))
       (when (invisible-p p) (setq s p i t))
       (while (< p (point-max))
         (if i ;; currently invisible
             (when (not (invisible-p p)) ;; but became visible
-              (setq e         p
-                    i         nil
-                    invisible (cons (cons s e) invisible)))
+              (setq i         nil
+                    invisible (cons (cons s p) invisible)))
           ;; currently visible:
           (when (invisible-p p)  ;; but have become invisible
             (setq s p i t)))
         (setq p (next-char-property-change p)))
       ;; still invisible at buffer end?
       (when i
-        (setq e         (point-max)
-              invisible (cons (cons s e) invisible))) ) invisible))
+        (setq invisible (cons (cons s (point-max)) invisible))) 
+      invisible)))
 
 (defun hfy-invisible-name (point map)
   "Generate a CSS style name for an invisible section of the buffer.
@@ -1215,9 +1176,7 @@ return a `defface' style list of face properties instead of a face symbol."
   ;; not sure why we'd want to remove face-name? -- v
   (let ((overlay-data nil)
         (base-face    nil)
-        ;; restored hfy-p-to-face as it handles faces like (bold) as
-        ;; well as face like 'bold - hfy-get-face-at doesn't dtrt -- v
-        (face-name   (hfy-p-to-face (text-properties-at p)))
+        (face-name   (get-text-property p 'face))
         ;; (face-name    (hfy-get-face-at p))
         (prop-seen    nil)
         (extra-props  nil)
@@ -1333,9 +1292,9 @@ return a `defface' style list of face properties instead of a face symbol."
                           extra-props (cons p (cons v extra-props))))))))))
       ;;(message "+ %d: %s; %S" p face-name extra-props)
       (if extra-props
-          (if (listp face-name)
-              (nconc extra-props face-name)
-            (nconc extra-props (face-attr-construct face-name)))
+          (nconc extra-props (if (listp face-name)
+                                 face-name
+                               (face-attr-construct face-name)))
         face-name)) ))
 
 (defun hfy-overlay-props-at (p)
@@ -1378,7 +1337,8 @@ variable `font-lock-mode' and variable `font-lock-fontified' for truth."
                (goto-char pt)
                (while (and (< pt (point-max)) (not face-name))
                  (setq face-name (hfy-face-at pt))
-                 (setq pt (next-char-property-change pt)))) face-name)
+                 (setq pt (next-char-property-change pt))))
+             face-name)
          font-lock-mode)))
 
 ;; remember, the map is in reverse point order:
@@ -1441,12 +1401,13 @@ Returns a modified copy of FACE-MAP."
 ;; Fix-me: save table for multi-buffer
   "Compile and return a `hfy-facemap-assoc' for the current buffer."
   ;;(message "hfy-compile-face-map");;DBUG
-  (let ((pt (point-min))
-        (pt-narrow  1)
-        (fn         nil)
-        (map        nil)
-        (prev-tag   nil)) ;; t   if the last tag-point was a span-start
-                          ;; nil if it was a span-stop
+  (let* ((pt         (point-min))
+         (pt-narrow  (save-restriction (widen) (point-min)))
+         (offset     (- pt pt-narrow))
+         (fn         nil)
+         (map        nil)
+         (prev-tag   nil)) ;; t   if the last tag-point was a span-start
+                           ;; nil if it was a span-stop
     (save-excursion
       (goto-char pt)
       (while (< pt (point-max))
@@ -1457,7 +1418,7 @@ Returns a modified copy of FACE-MAP."
           (if prev-tag (push (cons pt-narrow 'end) map))
           (setq prev-tag nil))
         (setq pt (next-char-property-change pt))
-        (setq pt-narrow (1+ (- pt (point-min)))))
+        (setq pt-narrow (+ offset pt)))
       (if (and map (not (eq 'end (cdar map))))
           (push (cons (- (point-max) (point-min)) 'end) map)))
     (if (hfy-opt 'merge-adjacent-tags) (hfy-merge-adjacent-spans map) map)))
@@ -1474,7 +1435,7 @@ Otherwise a plausible filename is constructed from `default-directory',
     (with-current-buffer buf
       (setq buffer-file-name
             (if src (concat src hfy-extn)
-              (expand-file-name (if (string-match "^.*/\\([^/]*\\)$" name)
+              (expand-file-name (if (string-match "^.*/\\([^/]*\\)\\'" name)
                                     (match-string 1 name)
                                   name))))
       buf)))
@@ -1492,23 +1453,22 @@ Uses `hfy-link-style-fun' to do this."
 
 (defun hfy-sprintf-stylesheet (css file)
   "Return the inline CSS style sheet for FILE as a string."
-  (let ((stylesheet nil))
-    (setq stylesheet
-          (concat
-           hfy-meta-tags
-           "\n<style type=\"text/css\"><!-- \n"
-           ;; Fix-me: Add handling of page breaks here + scan for ^L
-           ;; where appropriate.
-           (format "body %s\n" (cddr (assq 'default css)))
-           (apply 'concat
-                  (mapcar
-                   (lambda (style)
-                     (format
-                      "span.%s   %s\nspan.%s a %s\n"
-                      (cadr style) (cddr style)
-                      (cadr style) (hfy-link-style (cddr style))))
-                   css))
-           " --></style>\n"))
+  (let ((stylesheet
+         (concat
+          hfy-meta-tags
+          "\n<style type=\"text/css\"><!-- \n"
+          ;; Fix-me: Add handling of page breaks here + scan for ^L
+          ;; where appropriate.
+          (format "body %s\n" (cddr (assq 'default css)))
+          (apply 'concat
+                 (mapcar
+                  (lambda (style)
+                    (format
+                     "span.%s   %s\nspan.%s a %s\n"
+                     (cadr style) (cddr style)
+                     (cadr style) (hfy-link-style (cddr style))))
+                  css))
+          " --></style>\n")))
     (funcall hfy-page-header file stylesheet)))
 
 ;; tag all the dangerous characters we want to escape
@@ -1698,33 +1658,32 @@ FILE, if set, is the file name."
     ;; (message "checking to see whether we should link...")
     (if (and srcdir file)
         (let ((lp 'hfy-link)
-              (pt  nil)
+              (pt  (point-min))
               (pr  nil)
               (rr  nil))
           ;; (message "  yes we should.")
-            ;; translate 'hfy-anchor properties to anchors
-            (setq pt (point-min))
-            (while (setq pt (next-single-property-change pt 'hfy-anchor))
-              (if (setq pr (get-text-property pt 'hfy-anchor))
-                  (progn (goto-char pt)
-                         (remove-text-properties pt (1+ pt) '(hfy-anchor nil))
-                         (insert (concat "<a name=\"" pr "\"></a>")))))
-            ;; translate alternate 'hfy-link and 'hfy-endl props to opening
-            ;; and closing links. (this should avoid those spurious closes
-            ;; we sometimes get by generating only paired tags)
-            (setq pt (point-min))
-            (while (setq pt (next-single-property-change pt lp))
-              (if (not (setq pr (get-text-property pt lp))) nil
-                (goto-char pt)
-                (remove-text-properties pt (1+ pt) (list lp nil))
-                (case lp
-                 (hfy-link
-                  (if (setq rr (get-text-property pt 'hfy-inst))
-                      (insert (format "<a name=\"%s\"></a>" rr)))
-                  (insert (format "<a href=\"%s\">" pr))
-                  (setq lp 'hfy-endl))
-                 (hfy-endl
-                  (insert "</a>") (setq lp 'hfy-link)) ))) ))
+          ;; translate 'hfy-anchor properties to anchors
+          (while (setq pt (next-single-property-change pt 'hfy-anchor))
+            (if (setq pr (get-text-property pt 'hfy-anchor))
+                (progn (goto-char pt)
+                       (remove-text-properties pt (1+ pt) '(hfy-anchor nil))
+                       (insert (concat "<a name=\"" pr "\"></a>")))))
+          ;; translate alternate 'hfy-link and 'hfy-endl props to opening
+          ;; and closing links. (this should avoid those spurious closes
+          ;; we sometimes get by generating only paired tags)
+          (setq pt (point-min))
+          (while (setq pt (next-single-property-change pt lp))
+            (if (not (setq pr (get-text-property pt lp))) nil
+              (goto-char pt)
+              (remove-text-properties pt (1+ pt) (list lp nil))
+              (case lp
+                (hfy-link
+                 (if (setq rr (get-text-property pt 'hfy-inst))
+                     (insert (format "<a name=\"%s\"></a>" rr)))
+                 (insert (format "<a href=\"%s\">" pr))
+                 (setq lp 'hfy-endl))
+                (hfy-endl
+                 (insert "</a>") (setq lp 'hfy-link)) ))) ))
 
     ;; #####################################################################
     ;; transform the dangerous chars. This changes character positions
@@ -1790,7 +1749,7 @@ hyperlinks as appropriate."
   ;; pick up the file name in case we didn't receive it
   (if (not file)
       (progn (setq file (or (buffer-file-name) (buffer-name)))
-             (if (string-match "/\\([^/]*\\)$" file)
+             (if (string-match "/\\([^/]*\\)\\'" file)
                  (setq file (match-string 1 file)))) )
 
   (if (not (hfy-opt 'skip-refontification))
@@ -1833,7 +1792,7 @@ Hardly bombproof, but good enough in the context in which it is being used."
   "Is SRCDIR/FILE text?  Uses `hfy-istext-command' to determine this."
   (let* ((cmd (format hfy-istext-command (expand-file-name file srcdir)))
          (rsp (shell-command-to-string    cmd)))
-    (if (string-match "text" rsp) t nil)))
+    (string-match "text" rsp)))
 
 ;; open a file, check fontification, if fontified, write a fontified copy
 ;; to the destination directory, otherwise just copy the file:
@@ -1866,18 +1825,17 @@ adding an extension of `hfy-extn'.  Fontification is actually done by
       (kill-buffer source)) ))
 
 ;; list of tags in file in srcdir
-(defun hfy-tags-for-file (srcdir file)
+(defun hfy-tags-for-file (cache-hash file)
   "List of etags tags that have definitions in this FILE.
-Looks up the tags cache in `hfy-tags-cache' using SRCDIR as the key."
+CACHE-HASH is the tags cache."
   ;;(message "hfy-tags-for-file");;DBUG
-  (let ((cache-entry (assoc srcdir hfy-tags-cache))
-        (cache-hash   nil)
-        (tag-list     nil))
-    (if (setq cache-hash (cadr cache-entry))
+  (let* ((tag-list    nil))
+    (if cache-hash
         (maphash
          (lambda (K V)
            (if (assoc file V)
-               (setq tag-list (cons K tag-list)))) cache-hash))
+               (setq tag-list (cons K tag-list))))
+         cache-hash))
     tag-list))
 
 ;; mark the tags native to this file for anchors
@@ -1885,9 +1843,9 @@ Looks up the tags cache in `hfy-tags-cache' using SRCDIR as the key."
   "Mark tags in FILE (lookup SRCDIR in `hfy-tags-cache') with the `hfy-anchor'
 property, with a value of \"tag.line-number\"."
   ;;(message "(hfy-mark-tag-names %s %s)" srcdir file);;DBUG
-  (let ((cache-entry (assoc srcdir hfy-tags-cache))
-        (cache-hash   nil))
-    (if (setq cache-hash (cadr cache-entry))
+  (let* ((cache-entry (assoc srcdir hfy-tags-cache))
+         (cache-hash  (cadr cache-entry)))
+    (if cache-hash
         (mapcar
          (lambda (TAG)
            (mapcar
@@ -1900,7 +1858,7 @@ property, with a value of \"tag.line-number\"."
                                        (+ 2 chr)
                                        'hfy-anchor link))))
             (gethash TAG cache-hash)))
-         (hfy-tags-for-file srcdir file)))))
+         (hfy-tags-for-file cache-hash file)))))
 
 (defun hfy-relstub (file &optional start)
   "Return a \"../\" stub of the appropriate length for the current source
@@ -1909,7 +1867,8 @@ START is the offset at which to start looking for the / character in FILE."
   ;;(message "hfy-relstub");;DBUG
   (let ((c ""))
     (while (setq start (string-match "/" file start))
-      (setq start (1+ start)) (setq c (concat c "../"))) c))
+      (setq start (1+ start)) (setq c (concat c "../")))
+    c))
 
 (defun hfy-href-stub (this-file def-files tag)
   "Return an href stub for a tag href in THIS-FILE.
@@ -2183,7 +2142,9 @@ SRCDIR and DSTDIR are the source and output directories respectively."
                                                         dstdir
                                                         hfy-index-file
                                                         stub)
-                                   index-list)) ))) cache-hash) ) index-list)))
+                                   index-list)) )))
+           cache-hash) )
+      index-list)))
 
 (defun hfy-prepare-tag-map (srcdir dstdir)
   "Prepare the counterpart(s) to the index buffer(s) - a list of buffers
@@ -2215,7 +2176,9 @@ See also `hfy-prepare-index', `hfy-split-index'."
                                                         hfy-instance-file
                                                         stub
                                                         hfy-tags-rmap)
-                                   index-list)) ))) cache-hash) ) index-list)))
+                                   index-list)) )))
+           cache-hash) )
+      index-list)))
 
 (defun hfy-subtract-maps (srcdir)
   "Internal function - strips definitions of tags from the instance map.
@@ -2242,8 +2205,7 @@ See also `hfy-tags-cache', `hfy-tags-rmap'."
   "Load the etags cache for SRCDIR.
 See also `hfy-load-tags-cache'."
   (interactive "D source directory: ")
-  (setq srcdir (directory-file-name srcdir))
-  (hfy-load-tags-cache srcdir))
+  (hfy-load-tags-cache (directory-file-name srcdir)))
 
 ;;(defun hfy-test-read-args (foo bar)
 ;;  (interactive "D source directory: \nD target directory: ")
@@ -2296,7 +2258,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
 ;; (defalias 'hfy-set-hooks 'custom-set-variables)
 
 ;; (defun hfy-pp-hook (H)
-;;   (and (string-match "-hook$" (symbol-name H))
+;;   (and (string-match "-hook\\'" (symbol-name H))
 ;;        (boundp H)
 ;;        (symbol-value H)
 ;;        (insert (format "\n '(%S %S)" H (symbol-value H)))