Org-mode src block fixes

v8/orgmode/init.el

@@ -32,25 +32,16 @@
            (expand-file-name "macros.org" (file-name-directory load-file-name)))
         (org-macro--collect-macros)))
 
-;;; Code highlighting
-(defun org-html-decode-plain-text (text)
-  "Convert HTML character to plain TEXT. i.e. do the inversion of
-     `org-html-encode-plain-text`. Possible conversions are set in
-     `org-html-protect-char-alist'."
-  (mapc
-   (lambda (pair)
-     (setq text (replace-regexp-in-string (cdr pair) (car pair) text t t)))
-   (reverse org-html-protect-char-alist))
-  text)
-
 ;; Use pygments highlighting for code
 (defun pygmentize (lang code)
   "Use Pygments to highlight the given code and return the output"
   (with-temp-buffer
     (insert code)
-    (let ((lang (or (cdr (assoc lang org-pygments-language-alist)) "text")))
+    (let ((lang (get-pygments-language lang)))
       (shell-command-on-region (point-min) (point-max)
-                               (format "pygmentize -f html -l %s" lang)
+                               (if lang
+                                   (format "pygmentize -f html -l %s" lang)
+                                 "pygmentize -f html -g")
                                (buffer-name) t))
     (buffer-string)))
 
@@ -64,7 +55,8 @@
     ("clojure" . "clojure")
     ("css" . "css")
     ("d" . "d")
-    ("emacs-lisp" . "scheme")
+    ("emacs-lisp" . "emacs-lisp")
+    ("elisp" . "elisp")
     ("F90" . "fortran")
     ("gnuplot" . "gnuplot")
     ("groovy" . "groovy")
@@ -91,27 +83,62 @@
     ("shell-session" . "shell-session")
     ("sql" . "sql")
     ("sqlite" . "sqlite3")
-    ("tcl" . "tcl"))
+    ("tcl" . "tcl")
+    ("text" . "text"))
   "Alist between org-babel languages and Pygments lexers.
 lang is downcased before assoc, so use lowercase to describe language available.
 See: http://orgmode.org/worg/org-contrib/babel/languages.html and
 http://pygments.org/docs/lexers/ for adding new languages to the mapping.")
 
+(defvar org-pygments-detected-languages nil
+  "List of languages supported by Pygments, detected at runtime.")
+
+(defun get-pygments-language (lang)
+  "Try to find a Pygments lexer that matches the provided language."
+  (let ((pygmentize-lang (cdr (assoc lang org-pygments-language-alist))))
+    (if pygmentize-lang
+        pygmentize-lang
+      (when (null org-pygments-detected-languages)
+        (with-temp-buffer
+          ;; Extracts supported languages from "pygmentize -L lexers --json"
+          (setq org-pygments-detected-languages
+                (if (= 0 (call-process "pygmentize" nil (current-buffer) nil
+                                       "-L" "lexers" "--json"))
+                    (progn
+                      (goto-char (point-min))
+                      (if (featurep 'json)
+                          ;; Use json to parse supported languages
+                          (let ((lexers (alist-get 'lexers
+                                                   (json-parse-buffer
+                                                    :object-type 'alist
+                                                    :array-type 'list))))
+                            (mapcan (lambda (lexer)
+                                      (alist-get 'aliases (cdr lexer)))
+                                    lexers))
+                        ;; Use regexp on a best effort basis
+                        (let ((case-fold-search nil) langs)
+                          (while (re-search-forward "\"\\([a-z+#/-]+\\)\""
+                                                    nil t)
+                            (let ((s (match-string 1)))
+                              (unless (member s '("lexers" "aliases"
+                                                  "filenames" "mimetypes"))
+                                (push s langs))))
+                          langs)))
+                  ;; Fallback
+                  '("text")))))
+      (if (member lang org-pygments-detected-languages) lang))))
+
 ;; Override the html export function to use pygments
-(defun org-html-src-block (src-block contents info)
+(define-advice org-html-src-block (:around (old-src-block src-block contents info))
   "Transcode a SRC-BLOCK element from Org to HTML.
 CONTENTS holds the contents of the item.  INFO is a plist holding
 contextual information."
-  (if (org-export-read-attribute :attr_html src-block :textarea)
-      (org-html--textarea-block src-block)
-    (let ((lang (org-element-property :language src-block))
-          (code (org-element-property :value src-block))
-          (code-html (org-html-format-code src-block info)))
-      (if nikola-use-pygments
-          (progn
-            (unless lang (setq lang ""))
-            (pygmentize (downcase lang) (org-html-decode-plain-text code)))
-        code-html))))
+  (if (or (not nikola-use-pygments)
+          (org-export-read-attribute :attr_html src-block :textarea))
+      (funcall old-src-block src-block contents info)
+    (let ((lang (or (org-element-property :language src-block) ""))
+          (code (car (org-export-unravel-code src-block))))
+      (pygmentize (downcase lang) code))))
 
 ;; Export images with custom link type
 (defun org-custom-link-img-url-export (path desc format)
@@ -129,12 +156,12 @@ contextual information."
 
 ;; Support for magic links (link:// scheme)
 (org-link-set-parameters
-  "link"
-  :export (lambda (path desc backend)
-             (cond
-               ((eq 'html backend)
-                (format "<a href=\"link:%s\">%s</a>"
-                        path (or desc path))))))
+ "link"
+ :export (lambda (path desc backend)
+           (cond
+            ((eq 'html backend)
+             (format "<a href=\"link:%s\">%s</a>"
+                     path (or desc path))))))
 
 ;; Export function used by Nikola.
 (defun nikola-html-export (infile outfile)