Function: hfy-mark-tag-hrefs

hfy-mark-tag-hrefs is a byte-compiled function defined in htmlfontify.el.gz.

Signature

(hfy-mark-tag-hrefs SRCDIR FILE)

Documentation

Mark href start points with the hfy-link prop (value: href string).

Mark href end points with the hfy-endl prop (value t).

Avoid overlapping links, and mark links in descending length of tag name in order to prevent subtags from usurping supertags,
(eg "term" for "terminal").
SRCDIR is the directory being "published". FILE is the specific file we are rendering.

Source Code

;; Defined in /usr/src/emacs/lisp/htmlfontify.el.gz
;; mark all tags for hyperlinking, except the tags at
;; their own points of definition, iyswim:
(defun hfy-mark-tag-hrefs (srcdir file)
  "Mark href start points with the `hfy-link' prop (value: href string).

Mark href end points with the `hfy-endl' prop (value t).

Avoid overlapping links, and mark links in descending length of
tag name in order to prevent subtags from usurping supertags,
\(eg \"term\" for \"terminal\").
SRCDIR is the directory being \"published\".
FILE is the specific file we are rendering."
  ;;(message "hfy-mark-tag-hrefs");;DBUG
  (let ((cache-entry (assoc srcdir hfy-tags-cache))
        (list-cache  (assoc srcdir hfy-tags-sortl))
        (rmap-cache  (assoc srcdir hfy-tags-rmap ))
        (no-comment  (hfy-opt  'zap-comment-links))
        (no-strings  (hfy-opt  'zap-string-links ))
        (cache-hash                            nil)
        (tags-list                             nil)
        (tags-rmap                             nil)
        (case-fold-search                      nil))
    ;; extract the tag mapping hashes (fwd and rev) and the tag list:
    (if (and (setq cache-hash (cadr cache-entry))
             (setq tags-rmap  (cadr rmap-cache ))
             (setq tags-list  (cadr list-cache )))
        (mapcar
         (lambda (TAG)
           (let* ((start            nil)
                  (stop             nil)
                  (href             nil)
                  (name             nil)
                  (case-fold-search nil)
                  (tmp-point        nil)
                  (maybe-start      nil)
                  (face-at          nil)
                  (rmap-entry       nil)
                  (rnew-elt         nil)
                  (rmap-line        nil)
                  (tag-regex       (hfy-word-regex TAG))
                  (tag-map         (gethash TAG cache-hash))
                  (tag-files       (mapcar #'car tag-map)))
             ;; find instances of TAG and do what needs to be done:
             (goto-char (point-min))
             (while (search-forward TAG nil 'NOERROR)
               (setq tmp-point   (point)
                     maybe-start (- (match-beginning 0) 1))
               (goto-char maybe-start)
               (if (not (looking-at tag-regex))
                   nil
                 (setq start   (match-beginning 1))
                 (setq stop    (match-end 1))
                 (setq face-at
                       (and (or no-comment no-strings) (hfy-face-at start)))
                 (if (listp face-at)
                     (setq face-at (cadr (memq :inherit face-at))))
                 (if (or (text-property-any   start  (1+ stop)  'hfy-linkp  t)
                         (and no-comment (eq 'font-lock-comment-face face-at))
                         (and no-strings (eq 'font-lock-string-face  face-at)))
                     nil ;; already a link, NOOP

                   ;; set a reverse map entry:
                   (setq rmap-line  (line-number-at-pos)
                         rmap-entry (gethash    TAG     tags-rmap)
                         rnew-elt   (list  file  rmap-line  start)
                         rmap-entry (cons   rnew-elt   rmap-entry)
                         name       (format "%s.%d" TAG rmap-line))
                   (put-text-property start (1+ start) 'hfy-inst name)
                   (puthash TAG rmap-entry tags-rmap)

                   ;; mark the link. link to index if the tag has > 1 def
                   ;; add the line number to the #name if it does not:
                   (setq href (hfy-href file tag-files TAG tag-map))
                   (put-text-property start (1+ start) 'hfy-link  href)
                   (put-text-property stop  (1+ stop ) 'hfy-endl  t   )
                   (put-text-property start (1+ stop ) 'hfy-linkp t   )))
               (goto-char tmp-point)) ))
         tags-list) )))