-;;; htmlfontify.el --- htmlise a buffer/source tree with optional hyperlinks
+;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks
-;; Copyright (C) 2002, 2003, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2012 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
;; Package: htmlfontify
;; Author: Vivek Dasmohapatra <vivek@etla.org>
;; Maintainer: Vivek Dasmohapatra <vivek@etla.org>
;; Created: 2002-01-05
-;; Description: htmlise a buffer/source tree with optional hyperlinks
+;; Description: htmlize a buffer/source tree with optional hyperlinks
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
;; Compatibility: Emacs23, Emacs22
;; Incompatibility: Emacs19, Emacs20, Emacs21
;; Last Updated: Thu 2009-11-19 01:31:21 +0000
+;; Version: 0.21
;; This file is part of GNU Emacs.
`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
: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 a string that 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
: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
-be large and take a long time to render or be difficult to navigate."
+ "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))
-(defcustom hfy-extn ".html"
+(defcustom hfy-extn ".html"
"File extension used for output files."
:group 'htmlfontify
:tag "extension"
: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
: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."
(defcustom hfy-post-html-hooks nil
"List of functions to call after creating and filling the HTML buffer.
-These functions will be called with the html buffer as the current buffer."
+These functions will be called with the HTML buffer as the current buffer."
:group 'htmlfontify
:tag "post-html-hooks"
:options '(set-auto-mode)
:group 'htmlfontify
:tag "html-quote-map"
:type '(alist :key-type (string)))
-(eval-and-compile
- (defconst hfy-e2x-etags-cmd "for src in `find . -type f`;
+(defconst hfy-e2x-etags-cmd "for src in `find . -type f`;
do
ETAGS=%s;
case ${src} in
esac;
done;")
- (defconst hfy-etags-cmd-alist-default
- `(("emacs etags" . ,hfy-e2x-etags-cmd)
- ("exuberant ctags" . "%s -R -f -" )))
+(defconst hfy-etags-cmd-alist-default
+ `(("emacs etags" . ,hfy-e2x-etags-cmd)
+ ("exuberant ctags" . "%s -R -f -" )))
- (defcustom hfy-etags-cmd-alist
- hfy-etags-cmd-alist-default
- "Alist of possible shell commands that will generate etags output that
+(defcustom hfy-etags-cmd-alist
+ hfy-etags-cmd-alist-default
+ "Alist of possible shell commands that will generate etags output that
`htmlfontify' can use. '%s' will be replaced by `hfy-etags-bin'."
- :group 'htmlfontify
- :tag "etags-cmd-alist"
- :type '(alist :key-type (string) :value-type (string)) ))
+ :group 'htmlfontify
+ :tag "etags-cmd-alist"
+ :type '(alist :key-type (string) :value-type (string)))
(defcustom hfy-etags-bin "etags"
"Location of etags binary (we begin by assuming it's in your path).\n
:type '(file))
(defcustom hfy-shell-file-name "/bin/sh"
- "Shell (bourne or compatible) to invoke for complex shell operations."
+ "Shell (Bourne or compatible) to invoke for complex shell operations."
:group 'htmlfontify
:tag "shell-file-name"
:type '(file))
:type '(repeat symbol))
(defun hfy-which-etags ()
- "Return a string indicating which flavour of etags we are using."
+ "Return a string indicating which flavor of etags we are using."
(let ((v (shell-command-to-string (concat hfy-etags-bin " --version"))))
(cond ((string-match "exube" v) "exuberant ctags")
((string-match "GNU E" v) "emacs etags" )) ))
(defcustom hfy-etags-cmd
- (eval-and-compile (cdr (assoc (hfy-which-etags) hfy-etags-cmd-alist)))
+ ;; We used to wrap this in a `eval-and-compile', but:
+ ;; - it had no effect because this expression was not seen by the
+ ;; byte-compiler (defcustom used to quote this argument).
+ ;; - it signals an error (`hfy-which-etags' is not defined at compile-time).
+ ;; - we want this auto-detection to reflect the system on which Emacs is run
+ ;; rather than the one on which it's compiled.
+ (cdr (assoc (hfy-which-etags) hfy-etags-cmd-alist))
"The etags equivalent command to run in a source directory to generate a tags
file for the whole source tree from there on down. The command should emit
the etags output on stdout.\n
exuberant-ctags' etags respectively."
:group 'htmlfontify
:tag "etags-command"
- :type (eval-and-compile
- (let ((clist (list '(string))))
- (dolist (C hfy-etags-cmd-alist)
- (push (list 'const :tag (car C) (cdr C)) clist))
- (cons 'choice clist)) ))
+ :type (let ((clist (list '(string))))
+ (dolist (C hfy-etags-cmd-alist)
+ (push (list 'const :tag (car C) (cdr C)) clist))
+ (cons 'choice clist)))
(defcustom hfy-istext-command "file %s | sed -e 's@^[^:]*:[ \t]*@@'"
"Command to run with the name of a file, to see whether it is a text file
(const :tag "Lucid Toolkit" lucid )
(const :tag "Motif Toolkit" motif )))
- (class (choice (const :tag "Colour" color )
- (const :tag "Greyscale" grayscale)))
+ (class (choice (const :tag "Color" color )
+ (const :tag "Grayscale" grayscale)))
(background (choice (const :tag "Dark" dark )
(const :tag "Bright" light ))) ))
(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
(color-values colour)
;;(message "[%S]" window-system)
(x-color-values colour))
- ;; blarg - tty colours are no good - go fetch some X colours:
+ ;; blarg - tty colors are no good - go fetch some X colors:
(hfy-fallback-colour-values colour))))
(defvar hfy-cperl-mode-kludged-p nil)
(defun hfy-kludge-cperl-mode ()
- "CPerl mode does its damndest not to do some of its fontification when not
+ "CPerl mode does its damnedest not to do some of its fontification when not
in a windowing system - try to trick it..."
(if (not hfy-cperl-mode-kludged-p)
(progn (if (not window-system)
(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'.
<body onload=\"stripe('index'); return true;\">\n"
file style))
-(defun hfy-default-footer (file)
+(defun hfy-default-footer (_file)
"Default value for `hfy-page-footer'.
FILE is the name of the file being rendered, in case it is needed."
"\n </body>\n</html>\n")
(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:
((stringp box) (list (cons "border" (format "solid %s 1px" box))))
((listp box) (hfy-box-to-style box) ))) )
-(defun hfy-decor (tag val)
+(defun hfy-decor (tag _val)
"Derive CSS text-decoration specifiers from various Emacs font attributes.
TAG is an Emacs font attribute key (eg :underline).
VAL is ignored."
(:overline (cons "text-decoration" "overline" ))
(:strike-through (cons "text-decoration" "line-through")))))
-(defun hfy-invisible (&optional val)
+(defun hfy-invisible (&optional _val)
"This text should be invisible.
Do something in CSS to make that happen.
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.
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
;; text-decoration is not inherited.
;; but it's not wrong and if this ever changes it will
;; be needed, so I think it's better to leave it in? -- v
- (nconc final-style '(("text-decoration"."none"))))))
+ (nconc final-style '(("text-decoration" . "none"))))))
final-style))
;; strip redundant bits from a name. Technically, this could result in
(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
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.
;; 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)
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)
(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:
;; 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))
(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)))
(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)))
(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
(delete-overlay rovl))
(copy-to-buffer html-buffer (point-min) (point-max))
(set-buffer html-buffer)
- ;; rip out props that could interfere with our htmlisation of the buffer:
+ ;; rip out props that could interfere with our htmlization of the buffer:
(remove-text-properties (point-min) (point-max) hfy-ignored-properties)
;; Apply overlay invisible spec
(setq orig-ovls
;; (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
;; 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))
(save-excursion ;; Keep region
(hfy-force-fontification)))
- (if (interactive-p) ;; display the buffer in interactive mode:
+ (if (called-interactively-p 'any) ;; display the buffer in interactive mode:
(switch-to-buffer (hfy-fontify-buffer srcdir file))
(hfy-fontify-buffer srcdir file)))
"Return a list of files under DIRECTORY.
Strips any leading \"./\" from each filename."
;;(message "hfy-list-files");;DBUG
- ;; FIXME: this changes the dir of the currrent buffer. Is that right??
+ ;; FIXME: this changes the dir of the current buffer. Is that right??
(cd directory)
(mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F) F))
(split-string (shell-command-to-string hfy-find-cmd))) )
-;; strip the filename off, return a directiry name
-;; not a particularly thorough implementaion, but it will be
+;; strip the filename off, return a directory name
+;; not a particularly thorough implementation, but it will be
;; fed pretty carefully, so it should be Ok:
(defun hfy-dirname (file)
"Return everything preceding the last \"/\" from a relative filename FILE,
"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:
(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
"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
(+ 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
;;(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.
tags-list) )))
(defun hfy-shell ()
- "Return `shell-file-name', or \"/bin/sh\" if it is a non-bourne shell."
+ "Return `shell-file-name', or \"/bin/sh\" if it is a non-Bourne shell."
(if (string-match "\\<bash\\>\\|\\<sh\\>\\|\\<dash\\>" shell-file-name)
shell-file-name
(or hfy-shell-file-name "/bin/sh")))
(hash-entry nil) (tag-string nil) (tag-line nil)
(tag-point nil) (new-entry nil) (etags-file nil))
- ;; (re)initialise the tag reverse map:
+ ;; (re)initialize the tag reverse map:
(if trmap-cache (setq trmap-hash (cadr trmap-cache))
(setq trmap-hash (make-hash-table :test 'equal))
(setq hfy-tags-rmap (list (list srcdir trmap-hash) hfy-tags-rmap)))
(clrhash trmap-hash)
- ;; (re)initialise the tag cache:
+ ;; (re)initialize the tag cache:
(if cache-entry (setq cache-hash (cadr cache-entry))
(setq cache-hash (make-hash-table :test 'equal))
(setq hfy-tags-cache (list (list srcdir cache-hash) hfy-tags-cache)))
(puthash tag-string hash-entry cache-hash)))) )))
;; cache a list of tags in descending length order:
- (maphash (lambda (K V) (push K tags-list)) cache-hash)
+ (maphash (lambda (K _V) (push K tags-list)) cache-hash)
(setq tags-list (sort tags-list (lambda (A B) (< (length B) (length A)))))
;; put the tag list into the cache:
(setq cache-hash (cadr cache-entry))
(setq index-buf (get-buffer-create index-file))))
nil ;; noop
- (maphash (lambda (K V) (push K tag-list)) cache-hash)
+ (maphash (lambda (K _V) (push K tag-list)) cache-hash)
(setq tag-list (sort tag-list 'string<))
(set-buffer index-buf)
(erase-buffer)
(cache-entry (assoc srcdir hfy-tags-cache)))
(if (and cache-entry (setq cache-hash (cadr cache-entry)))
(maphash
- (lambda (K V)
+ (lambda (K _V)
(let ((stub (upcase (substring K 0 1))))
(if (member stub stub-list)
nil ;; seen this already: NOOP
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
(if (and cache-entry (setq cache-hash (cadr cache-entry)))
(maphash
- (lambda (K V)
+ (lambda (K _V)
(let ((stub (upcase (substring K 0 1))))
(if (member stub stub-list)
nil ;; seen this already: NOOP
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.
"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: ")
;; (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)))
\f
;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)
-;;;;;; "hfy-cmap" "hfy-cmap.el" "3de2db2d213813bb3afe170ffd66cdde")
+;;;;;; "hfy-cmap" "hfy-cmap.el" "8dce008297f15826cc6ab82203c46fa6")
;;; Generated autoloads from hfy-cmap.el
(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
(provide 'htmlfontify)
-;; arch-tag: 944e5e63-c81d-4baa-a82a-0275f9c30e61
+;; Local Variables:
+;; coding: utf-8
+;; End:
+
;;; htmlfontify.el ends here
HCoop / bpt / emacs.git / blobdiff