# HG changeset patch # User Stefan Monnier # Date 1259252676 0 # Node ID 8d51419ae1f357c208a10bbd0baeb4f0e6618cd6 # Parent d059492ca39b0ef692f9895671444d87a7fc4bbd Misc coding convention cleanups. * htmlfontify.el (hfy-init-kludge-hook): Rename from hfy-init-kludge-hooks. (hfy-etags-cmd, hfy-flatten-style, hfy-invisible-name, hfy-face-at) (hfy-fontify-buffer, hfy-prepare-index-i, hfy-subtract-maps) (hfy-save-kill-buffers, htmlfontify-copy-and-link-dir): Use dolist and push. (hfy-slant, hfy-weight): Use tables rather than code. (hfy-box-to-border-assoc, hfy-box-to-style, hfy-decor) (hfy-face-to-style-i, hfy-fontify-buffer): Use `case'. (hfy-face-attr-for-class): Initialize `face-spec' directly. (hfy-face-to-css): Remove `nconc' with single arg. (hfy-p-to-face-lennart): Use `or'. (hfy-face-at): Hoist common code. Remove spurious quotes in `case'. (hfy-overlay-props-at, hfy-mark-tag-hrefs): Eta-reduce. (hfy-compile-stylesheet, hfy-merge-adjacent-spans) (hfy-compile-face-map, hfy-parse-tags-buffer): Use push. (hfy-force-fontification): Use run-hooks. diff -r d059492ca39b -r 8d51419ae1f3 lisp/ChangeLog --- a/lisp/ChangeLog Thu Nov 26 15:22:27 2009 +0000 +++ b/lisp/ChangeLog Thu Nov 26 16:24:36 2009 +0000 @@ -1,3 +1,24 @@ +2009-11-26 Stefan Monnier + + Misc coding convention cleanups. + * htmlfontify.el (hfy-init-kludge-hook): Rename from + hfy-init-kludge-hooks. + (hfy-etags-cmd, hfy-flatten-style, hfy-invisible-name, hfy-face-at) + (hfy-fontify-buffer, hfy-prepare-index-i, hfy-subtract-maps) + (hfy-save-kill-buffers, htmlfontify-copy-and-link-dir): Use dolist + and push. + (hfy-slant, hfy-weight): Use tables rather than code. + (hfy-box-to-border-assoc, hfy-box-to-style, hfy-decor) + (hfy-face-to-style-i, hfy-fontify-buffer): Use `case'. + (hfy-face-attr-for-class): Initialize `face-spec' directly. + (hfy-face-to-css): Remove `nconc' with single arg. + (hfy-p-to-face-lennart): Use `or'. + (hfy-face-at): Hoist common code. Remove spurious quotes in `case'. + (hfy-overlay-props-at, hfy-mark-tag-hrefs): Eta-reduce. + (hfy-compile-stylesheet, hfy-merge-adjacent-spans) + (hfy-compile-face-map, hfy-parse-tags-buffer): Use push. + (hfy-force-fontification): Use run-hooks. + 2009-11-26 Vivek Dasmohapatra Various minor fixes. diff -r d059492ca39b -r 8d51419ae1f3 lisp/htmlfontify.el --- a/lisp/htmlfontify.el Thu Nov 26 15:22:27 2009 +0000 +++ b/lisp/htmlfontify.el Thu Nov 26 16:24:36 2009 +0000 @@ -183,17 +183,19 @@ :prefix "hfy-") (defcustom hfy-page-header 'hfy-default-header - "*Function called with two arguments \(the filename relative to the top + "Function called with two arguments \(the filename relative to the top level source directory being etag\'d and fontified), and a string containing the text to embed in the document- 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 + ;; own Custom preference on your users? --Stef :tag "page-header" :type '(function)) (defcustom hfy-split-index nil - "*Whether or not to split the index `hfy-index-file' alphabetically + "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." :group 'htmlfontify @@ -201,32 +203,32 @@ :type '(boolean)) (defcustom hfy-page-footer 'hfy-default-footer - "*As `hfy-page-header', but generates the output footer + "As `hfy-page-header', but generates the output footer \(and takes only 1 argument, the filename\)." :group 'htmlfontify :tag "page-footer" :type '(function)) (defcustom hfy-extn ".html" - "*File extension used for output files." + "File extension used for output files." :group 'htmlfontify :tag "extension" :type '(string)) (defcustom hfy-src-doc-link-style "text-decoration: underline;" - "*String to add to the \'\n")) (funcall hfy-page-header file stylesheet))) @@ -1665,38 +1668,36 @@ ;; property has already served its main purpose by this point. ;;(message "mapcar over the CSS-MAP") (message "invis-ranges:\n%S" invis-ranges) - (mapc - (lambda (point-face) - (let ((pt (car point-face)) - (fn (cdr point-face)) - (move-link nil)) - (goto-char pt) - (setq move-link - (or (get-text-property pt 'hfy-linkp) - (get-text-property pt 'hfy-endl ))) - (if (eq 'end fn) - (insert "") - (if (not (and srcdir file)) - nil - (when move-link - (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) - (put-text-property pt (1+ pt) 'hfy-endl t) )) - ;; if we have invisible blocks, we need to do some extra magic: - (if invis-ranges - (let ((iname (hfy-invisible-name pt invis-ranges)) - (fname (hfy-lookup fn css-sheet ))) - (when (assq pt invis-ranges) - (insert - (format "" iname)) - (insert "…")) - (insert - (format "" fname iname pt))) - (insert (format "" (hfy-lookup fn css-sheet)))) - (if (not move-link) nil - ;;(message "removing prop2 @ %d" (point)) - (if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) - (put-text-property pt (1+ pt) 'hfy-endl t))) ))) - css-map) + (dolist (point-face css-map) + (let ((pt (car point-face)) + (fn (cdr point-face)) + (move-link nil)) + (goto-char pt) + (setq move-link + (or (get-text-property pt 'hfy-linkp) + (get-text-property pt 'hfy-endl ))) + (if (eq 'end fn) + (insert "") + (if (not (and srcdir file)) + nil + (when move-link + (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) + (put-text-property pt (1+ pt) 'hfy-endl t) )) + ;; if we have invisible blocks, we need to do some extra magic: + (if invis-ranges + (let ((iname (hfy-invisible-name pt invis-ranges)) + (fname (hfy-lookup fn css-sheet ))) + (when (assq pt invis-ranges) + (insert + (format "" iname)) + (insert "…")) + (insert + (format "" fname iname pt))) + (insert (format "" (hfy-lookup fn css-sheet)))) + (if (not move-link) nil + ;;(message "removing prop2 @ %d" (point)) + (if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) + (put-text-property pt (1+ pt) 'hfy-endl t)))))) ;; ##################################################################### ;; Invisibility ;; Maybe just make the text invisible in XHTML? @@ -1724,13 +1725,13 @@ (if (not (setq pr (get-text-property pt lp))) nil (goto-char pt) (remove-text-properties pt (1+ pt) (list lp nil)) - (cond - ((eq lp 'hfy-link) + (case lp + (hfy-link (if (setq rr (get-text-property pt 'hfy-inst)) (insert (format "" rr))) (insert (format "" pr)) (setq lp 'hfy-endl)) - ((eq lp 'hfy-endl) + (hfy-endl (insert "") (setq lp 'hfy-link)) ))) )) ;; ##################################################################### @@ -1760,7 +1761,7 @@ (defun hfy-force-fontification () "Try to force font-locking even when it is optimised away." - (mapc (lambda (fun) (funcall fun)) hfy-init-kludge-hooks) + (run-hooks 'hfy-init-kludge-hook) (eval-and-compile (require 'font-lock)) (if (boundp 'font-lock-cache-position) (or font-lock-cache-position @@ -1811,6 +1812,7 @@ "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?? (cd directory) (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F) F)) (split-string (shell-command-to-string hfy-find-cmd))) ) @@ -1995,7 +1997,7 @@ (rmap-line nil) (tag-regex (hfy-word-regex TAG)) (tag-map (gethash TAG cache-hash)) - (tag-files (mapcar (lambda (X) (car X)) tag-map))) + (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) @@ -2098,17 +2100,17 @@ (setq tag-point (round (string-to-number (match-string 3)))) (setq hash-entry (gethash tag-string cache-hash)) (setq new-entry (list etags-file tag-line tag-point)) - (setq hash-entry (cons new-entry hash-entry)) + (push new-entry hash-entry) ;;(message "HASH-ENTRY %s %S" tag-string new-entry) (puthash tag-string hash-entry cache-hash)))) ))) ;; cache a list of tags in descending length order: - (maphash (lambda (K V) (setq tags-list (cons 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: (if tlist-cache (setcar (cdr tlist-cache) tags-list) - (setq hfy-tags-sortl (cons (list srcdir tags-list) hfy-tags-sortl))) + (push (list srcdir tags-list) hfy-tags-sortl)) ;; return the number of tags found: (length tags-list) )) @@ -2134,36 +2136,33 @@ (setq cache-hash (cadr cache-entry)) (setq index-buf (get-buffer-create index-file)))) nil ;; noop - (maphash (lambda (K V) (setq tag-list (cons 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) (insert (funcall hfy-page-header filename "")) (insert "\n") - (mapc - (lambda (TAG) - (let ((tag-started nil)) - (mapc - (lambda (DEF) - (if (and stub (not (string-match (concat "^" stub) TAG))) - nil ;; we have a stub and it didn't match: NOOP - (let ((file (car DEF)) - (line (cadr DEF))) - (insert - (format - (concat - " \n" - " \n" - " \n" - " \n" - " \n") - (if (string= TAG tag-started) " " - (format "%s" TAG TAG)) - file (or hfy-link-extn hfy-extn) file - file (or hfy-link-extn hfy-extn) TAG line line)) - (setq tag-started TAG)))) - (gethash TAG cache-hash)))) tag-list) + (dolist (TAG tag-list) + (let ((tag-started nil)) + (dolist (DEF (gethash TAG cache-hash)) + (if (and stub (not (string-match (concat "^" stub) TAG))) + nil ;; we have a stub and it didn't match: NOOP + (let ((file (car DEF)) + (line (cadr DEF))) + (insert + (format + (concat + " \n" + " \n" + " \n" + " \n" + " \n") + (if (string= TAG tag-started) " " + (format "%s" TAG TAG)) + file (or hfy-link-extn hfy-extn) file + file (or hfy-link-extn hfy-extn) TAG line line)) + (setq tag-started TAG)))))) (insert "
%s%s%d
%s%s%d
\n") (insert (funcall hfy-page-footer filename)) (and dstdir (cd dstdir)) @@ -2237,20 +2236,15 @@ (fwd-map (cadr (assoc srcdir hfy-tags-cache))) (rev-map (cadr (assoc srcdir hfy-tags-rmap ))) (taglist (cadr (assoc srcdir hfy-tags-sortl)))) - (mapc - (lambda (TAG) - (setq def-list (gethash TAG fwd-map) - old-list (gethash TAG rev-map) - new-list nil - exc-list nil) - (mapc - (lambda (P) - (setq exc-list (cons (list (car P) (cadr P)) exc-list))) def-list) - (mapc - (lambda (P) - (or (member (list (car P) (cadr P)) exc-list) - (setq new-list (cons P new-list)))) old-list) - (puthash TAG new-list rev-map)) taglist) )) + (dolist (TAG taglist) + (setq def-list (gethash TAG fwd-map) + old-list (gethash TAG rev-map) + exc-list (mapcar (lambda (P) (list (car P) (cadr P))) def-list) + new-list nil) + (dolist (P old-list) + (or (member (list (car P) (cadr P)) exc-list) + (push P new-list))) + (puthash TAG new-list rev-map)))) (defun htmlfontify-run-etags (srcdir) "Load the etags cache for SRCDIR. @@ -2264,11 +2258,11 @@ ;; (message "foo: %S\nbar: %S" foo bar)) (defun hfy-save-kill-buffers (buffer-list &optional dstdir) - (mapc (lambda (B) - (set-buffer B) - (and dstdir (file-directory-p dstdir) (cd dstdir)) - (save-buffer) - (kill-buffer B)) buffer-list) ) + (dolist (B buffer-list) + (set-buffer B) + (and dstdir (file-directory-p dstdir) (cd dstdir)) + (save-buffer) + (kill-buffer B))) (defun htmlfontify-copy-and-link-dir (srcdir dstdir &optional f-ext l-ext) "Trawl SRCDIR and write fontified-and-hyperlinked output in DSTDIR. @@ -2291,8 +2285,8 @@ (clrhash (cadr tr-cache)) (hfy-make-directory dstdir) (setq source-files (hfy-list-files srcdir)) - (mapc (lambda (file) - (hfy-copy-and-fontify-file srcdir dstdir file)) source-files) + (dolist (file source-files) + (hfy-copy-and-fontify-file srcdir dstdir file)) (hfy-subtract-maps srcdir) (hfy-save-kill-buffers (hfy-prepare-index srcdir dstdir) dstdir) (hfy-save-kill-buffers (hfy-prepare-tag-map srcdir dstdir) dstdir) )) @@ -2345,8 +2339,11 @@ (custom-save-delete 'hfy-init-progn) (setq start-pos (point)) (princ "(hfy-init-progn\n;;auto-generated, only one copy allowed\n") + ;; FIXME: This saving&restoring of global customization + ;; variables can interfere with other customization settings for + ;; those vars (in .emacs or in Customize). (mapc 'hfy-save-initvar - (list 'auto-mode-alist 'interpreter-mode-alist)) + '(auto-mode-alist interpreter-mode-alist)) (princ ")\n") (indent-region start-pos (point) nil)) (custom-save-all) ))