gen.el (9120B)
1 (require 'ox-html) 2 (require 'ob-emacs-lisp) 3 (require 'ob-lilypond) 4 (require 'htmlize (or (getenv "HTMLIZE_PATH") 5 "/var/www/git/htmlize.el")) 6 7 (defun org-html-link (link desc info) 8 "Transcode a LINK object from Org to HTML. 9 DESC is the description part of the link, or the empty string. 10 INFO is a plist holding contextual information. See 11 `org-export-data'." 12 (let* ((link-org-files-as-html-maybe 13 (lambda (raw-path info) 14 ;; Treat links to `file.org' as links to `file.html', if 15 ;; needed. See `org-html-link-org-files-as-html'. 16 (cond 17 ((and (plist-get info :html-link-org-files-as-html) 18 (string= ".org" 19 (downcase (file-name-extension raw-path ".")))) 20 (concat (file-name-sans-extension raw-path) "." 21 (plist-get info :html-extension))) 22 (t raw-path)))) 23 (type (org-element-property :type link)) 24 (raw-path (org-element-property :path link)) 25 ;; Ensure DESC really exists, or set it to nil. 26 (desc (org-string-nw-p desc)) 27 (path 28 (cond 29 ((member type '("http" "https" "ftp" "mailto" "news")) 30 (url-encode-url (concat type ":" raw-path))) 31 ((string= type "file") 32 ;; During publishing, turn absolute file names belonging 33 ;; to base directory into relative file names. Otherwise, 34 ;; append "file" protocol to absolute file name. 35 (setq raw-path 36 (org-export-file-uri 37 (org-publish-file-relative-name raw-path info))) 38 ;; Possibly append `:html-link-home' to relative file 39 ;; name. 40 (let ((home (and (plist-get info :html-link-home) 41 (org-trim (plist-get info :html-link-home))))) 42 (when (and home 43 (plist-get info :html-link-use-abs-url) 44 (file-name-absolute-p raw-path)) 45 (setq raw-path (concat (file-name-as-directory home) raw-path)))) 46 ;; Maybe turn ".org" into ".html". 47 (setq raw-path (funcall link-org-files-as-html-maybe raw-path info)) 48 ;; Add search option, if any. A search option can be 49 ;; relative to a custom-id, a headline title, a name or 50 ;; a target. 51 (let ((option (org-element-property :search-option link)) 52 (raw-path (format "file/%s.html" raw-path))) 53 (if (not option) raw-path 54 (let ((path (org-element-property :path link))) 55 (concat raw-path 56 "#" 57 (org-publish-resolve-external-link option path t)))))) 58 (t raw-path))) 59 (attributes-plist 60 (org-combine-plists 61 ;; Extract attributes from parent's paragraph. HACK: Only 62 ;; do this for the first link in parent (inner image link 63 ;; for inline images). This is needed as long as 64 ;; attributes cannot be set on a per link basis. 65 (let* ((parent (org-export-get-parent-element link)) 66 (link (let ((container (org-export-get-parent link))) 67 (if (and (eq 'link (org-element-type container)) 68 (org-html-inline-image-p link info)) 69 container 70 link)))) 71 (and (eq link (org-element-map parent 'link #'identity info t)) 72 (org-export-read-attribute :attr_html parent))) 73 ;; Also add attributes from link itself. Currently, those 74 ;; need to be added programmatically before `org-html-link' 75 ;; is invoked, for example, by backends building upon HTML 76 ;; export. 77 (org-export-read-attribute :attr_html link))) 78 (attributes 79 (let ((attr (org-html--make-attribute-string attributes-plist))) 80 (if (org-string-nw-p attr) (concat " " attr) "")))) 81 (cond 82 ;; Link type is handled by a special function. 83 ((org-export-custom-protocol-maybe link desc 'html)) 84 ;; Image file. 85 ((and (plist-get info :html-inline-images) 86 (org-export-inline-image-p 87 link (plist-get info :html-inline-image-rules))) 88 (org-html--format-image path attributes-plist info)) 89 ;; Radio target: Transcode target's contents and use them as 90 ;; link's description. 91 ((string= type "radio") 92 (let ((destination (org-export-resolve-radio-link link info))) 93 (if (not destination) desc 94 (format "<a href=\"#%s\"%s>%s</a>" 95 (org-export-get-reference destination info) 96 attributes 97 desc)))) 98 ;; Links pointing to a headline: Find destination and build 99 ;; appropriate referencing command. 100 ((member type '("custom-id" "fuzzy" "id")) 101 (let ((destination (if (string= type "fuzzy") 102 (org-export-resolve-fuzzy-link link info) 103 (org-export-resolve-id-link link info)))) 104 (pcase (org-element-type destination) 105 ;; ID link points to an external file. 106 (`plain-text 107 (let ((fragment (concat "ID-" path)) 108 ;; Treat links to ".org" files as ".html", if needed. 109 (path (funcall link-org-files-as-html-maybe 110 destination info))) 111 (format "<a href=\"%s#%s\"%s>%s</a>" 112 path fragment attributes (or desc destination)))) 113 ;; Fuzzy link points nowhere. 114 (`nil 115 (format "<i>%s</i>" 116 (or desc 117 (org-export-data 118 (org-element-property :raw-link link) info)))) 119 ;; Link points to a headline. 120 (`headline 121 (let ((href (or (org-element-property :CUSTOM_ID destination) 122 (org-export-get-reference destination info))) 123 ;; What description to use? 124 (desc 125 ;; Case 1: Headline is numbered and LINK has no 126 ;; description. Display section number. 127 (if (and (org-export-numbered-headline-p destination info) 128 (not desc)) 129 (mapconcat #'number-to-string 130 (org-export-get-headline-number 131 destination info) ".") 132 ;; Case 2: Either the headline is un-numbered or 133 ;; LINK has a custom description. Display LINK's 134 ;; description or headline's title. 135 (or desc 136 (org-export-data 137 (org-element-property :title destination) info))))) 138 (format "<a href=\"#%s\"%s>%s</a>" href attributes desc))) 139 ;; Fuzzy link points to a target or an element. 140 (_ 141 (if (and destination 142 (memq (plist-get info :with-latex) '(mathjax t)) 143 (eq 'latex-environment (org-element-type destination)) 144 (eq 'math (org-latex--environment-type destination))) 145 ;; Caption and labels are introduced within LaTeX 146 ;; environment. Use "eqref" macro to refer to those in 147 ;; the document. 148 (format "\\eqref{%s}" 149 (org-export-get-reference destination info)) 150 (let* ((ref (org-export-get-reference destination info)) 151 (org-html-standalone-image-predicate 152 #'org-html--has-caption-p) 153 (counter-predicate 154 (if (eq 'latex-environment (org-element-type destination)) 155 #'org-html--math-environment-p 156 #'org-html--has-caption-p)) 157 (number 158 (cond 159 (desc nil) 160 ((org-html-standalone-image-p destination info) 161 (org-export-get-ordinal 162 (org-element-map destination 'link #'identity info t) 163 info 'link 'org-html-standalone-image-p)) 164 (t (org-export-get-ordinal 165 destination info nil counter-predicate)))) 166 (desc 167 (cond (desc) 168 ((not number) "No description for this link") 169 ((numberp number) (number-to-string number)) 170 (t (mapconcat #'number-to-string number "."))))) 171 (format "<a href=\"#%s\"%s>%s</a>" ref attributes desc))))))) 172 ;; Coderef: replace link with the reference name or the 173 ;; equivalent line number. 174 ((string= type "coderef") 175 (let ((fragment (concat "coderef-" (org-html-encode-plain-text path)))) 176 (format "<a href=\"#%s\" %s%s>%s</a>" 177 fragment 178 (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \ 179 '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" 180 fragment fragment) 181 attributes 182 (format (org-export-get-coderef-format path desc) 183 (org-export-resolve-coderef path info))))) 184 ;; External link with a description part. 185 ((and path desc) 186 (format "<a href=\"%s\"%s>%s</a>" 187 (org-html-encode-plain-text path) 188 attributes 189 desc)) 190 ;; External link without a description part. 191 (path 192 (let ((path (org-html-encode-plain-text path))) 193 (format "<a href=\"%s\"%s>%s</a>" path attributes path))) 194 ;; No path, only description. Try to do something useful. 195 (t 196 (format "<i>%s</i>" desc))))) 197 198 (defun ol-help--export (link description format) 199 (let* ((desc (or description link)) 200 (sym (intern link)) 201 (type (if (fboundp sym) 202 "Fun" 203 "Var"))) 204 (when (eq format 'html) 205 (format "<a target=\"_blank\" href=\"https://doc.endlessparentheses.com/%s/%s.html\">%s</a>" 206 type link desc)))) 207 208 (org-link-set-parameters "help" :export #'ol-help--export) 209 210 (defun generate-html-file (infile outfile) 211 (let ((infile (expand-file-name infile)) 212 (outfile (expand-file-name outfile)) 213 (org-export-with-toc nil) 214 (org-export-with-section-numbers nil) 215 (org-html-xml-declaration nil) 216 (org-html-link-org-files-as-html nil) 217 (org-html-postamble nil)) 218 (with-current-buffer (find-file-noselect infile) 219 (org-export-to-file 'html outfile)))) 220 221 ;;; (copy-file (buffer-file-name) "/ssh:git@jamzattack.xyz:/var/www/git/gen.el" t)