Merge branch 'master-wip3'

lisp/ob-tangle.el

@@ -198,21 +198,10 @@ used to limit the exported source code blocks by language."
   ;; Possibly Restrict the buffer to the current code block
   (save-restriction
     (when (equal arg '(4))
-      (unless (org-babel-where-is-src-block-head)
-	(error "Point is not currently inside of a code block"))
-      (save-match-data
-	(unless (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
-		    target-file)
-	  (setq target-file
-		(read-from-minibuffer "Tangle to: " (buffer-file-name)))))
-      (narrow-to-region
-       (save-match-data
-	 (save-excursion
-	   (goto-char (org-babel-where-is-src-block-head))
-	   (while (and (forward-line -1)
-		       (looking-at org-babel-multi-line-header-regexp)))
-	   (point)))
-       (match-end 0)))
+      (let ((head (org-babel-where-is-src-block-head)))
+	  (if head
+	      (goto-char head)
+	    (user-error "Point is not in a source code block"))))
     (save-excursion
       (let ((block-counter 0)
 	    (org-babel-default-header-args
@@ -223,7 +212,7 @@ used to limit the exported source code blocks by language."
 	    (tangle-file
 	     (when (equal arg '(16))
 	       (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
-		   (read-from-minibuffer "Tangle to: " (buffer-file-name)))))
+		   (user-error "Point is not in a source code block"))))
 	    path-collector)
 	(mapc ;; map over all languages
 	 (lambda (by-lang)
@@ -284,7 +273,9 @@ used to limit the exported source code blocks by language."
 		      (setq block-counter (+ 1 block-counter))
 		      (add-to-list 'path-collector file-name)))))
 	      specs)))
-	 (org-babel-tangle-collect-blocks lang tangle-file))
+	 (if (equal arg '(4))
+	     (org-babel-tangle-single-block 1 t)
+	   (org-babel-tangle-collect-blocks lang tangle-file)))
 	(message "Tangled %d code block%s from %s" block-counter
 		 (if (= block-counter 1) "" "s")
 		 (file-name-nondirectory
@@ -368,7 +359,7 @@ the form used by `org-babel-spec-to-string' grouped by language.
 Optional argument LANG can be used to limit the collected source
 code blocks by language.  Optional argument TANGLE-FILE can be
 used to limit the collected code blocks by target file."
-  (let ((block-counter 1) (current-heading "") blocks)
+  (let ((block-counter 1) (current-heading "") blocks by-lang)
     (org-babel-map-src-blocks (buffer-file-name)
       (lambda (new-heading)
 	(if (not (string= new-heading current-heading))
@@ -381,85 +372,22 @@ used to limit the collected code blocks by target file."
 				    (or (nth 4 (org-heading-components))
 					"(dummy for heading without text)")
 				  (error (buffer-file-name))))
-      (let* ((start-line
-	      (save-restriction (widen) (+ 1 (line-number-at-pos (point)))))
-	     (file (buffer-file-name))
-	     (info (org-babel-get-src-block-info 'light))
+      (let* ((info (org-babel-get-src-block-info 'light))
 	     (src-lang (nth 0 info))
 	     (src-tfile (cdr (assoc :tangle (nth 2 info)))))
         (unless (or (string-match (concat "^" org-comment-string) current-heading)
 		    (string= (cdr (assoc :tangle (nth 2 info))) "no")
 		    (and tangle-file (not (equal tangle-file src-tfile))))
           (unless (and lang (not (string= lang src-lang)))
-	    (let* ((info (org-babel-get-src-block-info))
-		   (params (nth 2 info))
-		   (extra (nth 3 info))
-		   (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
-				      (match-string 1 extra))
-				 org-coderef-label-format))
-		   (link ((lambda (link)
-			    (and (string-match org-bracket-link-regexp link)
-				 (match-string 1 link)))
-			  (org-no-properties
-			   (org-store-link nil))))
-		   (source-name
-		    (intern (or (nth 4 info)
-				(format "%s:%d"
-					current-heading block-counter))))
-		   (expand-cmd
-		    (intern (concat "org-babel-expand-body:" src-lang)))
-		   (assignments-cmd
-		    (intern (concat "org-babel-variable-assignments:" src-lang)))
-		   (body
-		    ((lambda (body) ;; Run the tangle-body-hook
-		       (with-temp-buffer
-			 (insert body)
-			 (when (string-match "-r" extra)
-			   (goto-char (point-min))
-			   (while (re-search-forward
-				   (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
-			     (replace-match "")))
-			 (run-hooks 'org-babel-tangle-body-hook)
-			 (buffer-string)))
-		     ((lambda (body) ;; Expand the body in language specific manner
-			(if (assoc :no-expand params)
-			    body
-			  (if (fboundp expand-cmd)
-			      (funcall expand-cmd body params)
-			    (org-babel-expand-body:generic
-			     body params
-			     (and (fboundp assignments-cmd)
-				  (funcall assignments-cmd params))))))
-		      (if (org-babel-noweb-p params :tangle)
-			  (org-babel-expand-noweb-references info)
-			(nth 1 info)))))
-		   (comment
-		    (when (or (string= "both" (cdr (assoc :comments params)))
-			      (string= "org" (cdr (assoc :comments params))))
-		      ;; From the previous heading or code-block end
-		      (funcall
-		       org-babel-process-comment-text
-		       (buffer-substring
-			(max (condition-case nil
-				 (save-excursion
-				   (org-back-to-heading t)  ; Sets match data
-				   (match-end 0))
-			       (error (point-min)))
-			     (save-excursion
-			       (if (re-search-backward
-				    org-babel-src-block-regexp nil t)
-				   (match-end 0)
-				 (point-min))))
-			(point)))))
-		   by-lang)
-	      ;; Add the spec for this block to blocks under it's language
-	      (setq by-lang (cdr (assoc src-lang blocks)))
-	      (setq blocks (delq (assoc src-lang blocks) blocks))
-	      (setq blocks (cons
-			    (cons src-lang
-				  (cons (list start-line file link
-					      source-name params body comment)
-					by-lang)) blocks)))))))
+	    ;; Add the spec for this block to blocks under it's language
+	    (setq by-lang (cdr (assoc src-lang blocks)))
+	    (setq blocks (delq (assoc src-lang blocks) blocks))
+	    (setq blocks (cons
+			  (cons src-lang
+				(cons
+				 (org-babel-tangle-single-block
+				  block-counter)
+				 by-lang)) blocks))))))
     ;; Ensure blocks are in the correct order
     (setq blocks
           (mapcar
@@ -467,6 +395,86 @@ used to limit the collected code blocks by target file."
 	   blocks))
     blocks))
 
+(defun org-babel-tangle-single-block
+  (block-counter &optional only-this-block)
+  "Collect the tangled source for current block.
+Return the list of block attributes needed by
+`org-babel-tangle-collect-blocks'.
+When ONLY-THIS-BLOCK is non-nil, return the full association
+list to be used by `org-babel-tangle' directly."
+  (let* ((info (org-babel-get-src-block-info))
+	 (start-line
+	  (save-restriction (widen)
+			    (+ 1 (line-number-at-pos (point)))))
+	 (file (buffer-file-name))
+	 (src-lang (nth 0 info))
+	 (params (nth 2 info))
+	 (extra (nth 3 info))
+	 (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
+			    (match-string 1 extra))
+		       org-coderef-label-format))
+	 (link ((lambda (link)
+		  (and (string-match org-bracket-link-regexp link)
+		       (match-string 1 link)))
+		(org-no-properties
+		 (org-store-link nil))))
+	 (source-name
+	  (intern (or (nth 4 info)
+		      (format "%s:%d"
+			      (or (ignore-errors (nth 4 (org-heading-components)))
+				  "No heading")
+			      block-counter))))
+	 (expand-cmd
+	  (intern (concat "org-babel-expand-body:" src-lang)))
+	 (assignments-cmd
+	  (intern (concat "org-babel-variable-assignments:" src-lang)))
+	 (body
+	  ((lambda (body) ;; Run the tangle-body-hook
+	     (with-temp-buffer
+	       (insert body)
+	       (when (string-match "-r" extra)
+		 (goto-char (point-min))
+		 (while (re-search-forward
+			 (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
+		   (replace-match "")))
+	       (run-hooks 'org-babel-tangle-body-hook)
+	       (buffer-string)))
+	   ((lambda (body) ;; Expand the body in language specific manner
+	      (if (assoc :no-expand params)
+		  body
+		(if (fboundp expand-cmd)
+		    (funcall expand-cmd body params)
+		  (org-babel-expand-body:generic
+		   body params
+		   (and (fboundp assignments-cmd)
+			(funcall assignments-cmd params))))))
+	    (if (org-babel-noweb-p params :tangle)
+		(org-babel-expand-noweb-references info)
+	      (nth 1 info)))))
+	 (comment
+	  (when (or (string= "both" (cdr (assoc :comments params)))
+		    (string= "org" (cdr (assoc :comments params))))
+	    ;; From the previous heading or code-block end
+	    (funcall
+	     org-babel-process-comment-text
+	     (buffer-substring
+	      (max (condition-case nil
+		       (save-excursion
+			 (org-back-to-heading t)  ; Sets match data
+			 (match-end 0))
+		     (error (point-min)))
+		   (save-excursion
+		     (if (re-search-backward
+			  org-babel-src-block-regexp nil t)
+			 (match-end 0)
+		       (point-min))))
+	      (point)))))
+	 (result
+	  (list start-line file link source-name params body comment)))
+    (if only-this-block
+	(list (cons src-lang (list result)))
+      result)))
+
 (defun org-babel-tangle-comment-links ( &optional info)
   "Return a list of begin and end link comments for the code block at point."
   (let* ((start-line (org-babel-where-is-src-block-head))

lisp/ox-html.el

@@ -118,10 +118,9 @@
    (:html-mathjax "HTML_MATHJAX" nil "" space)
    (:html-postamble nil "html-postamble" org-html-postamble)
    (:html-preamble nil "html-preamble" org-html-preamble)
-   (:html-style nil nil org-html-style)
-   (:html-style-extra "HTML_STYLE" nil org-html-style-extra newline)
-   (:html-style-include-default nil nil org-html-style-include-default)
-   (:html-style-include-scripts nil nil org-html-style-include-scripts)
+   (:html-head "HTML_HEAD" nil org-html-head newline)
+   (:html-style-include-default nil nil org-html-head-include-default-style)
+   (:html-head-include-scripts nil nil org-html-head-include-scripts)
    (:html-table-tag nil nil org-html-table-tag)
    (:html-htmlized-css-url "HTML_HTMLIZED_CSS_URL" nil org-html-htmlized-org-css-url)
    ;; Redefine regular options.
@@ -244,10 +243,9 @@ for the JavaScript code in this tag.
   /*]]>*/-->
 </style>"
   "The default style specification for exported HTML files.
-Please use the variables `org-html-style' and
-`org-html-style-extra' to add to this style.  If you wish to not
-have the default style included, customize the variable
-`org-html-style-include-default'.")
+You can use `org-html-head' and `org-html-head-extra' to add to
+this style.  If you don't want to include this default style,
+customize `org-html-head-include-default-style'.")
 
 
 
@@ -452,8 +450,8 @@ export back-end currently used."
 	     (setq style (replace-match style t t template))
 	     (setq exp-plist
 		   (plist-put
-		    exp-plist :html-style-extra
-		    (concat (or (plist-get exp-plist :html-style-extra) "")
+		    exp-plist :html-head-extra
+		    (concat (or (plist-get exp-plist :html-head-extra) "")
 			    "\n"
 			    style)))))
       ;; This script absolutely needs the table of contents, so we
@@ -714,21 +712,6 @@ in all modes you want.  Then, use the command
   :group 'org-export-html
   :type 'string)
 
-(defcustom org-html-htmlized-org-css-url nil
-  "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
-Normally when creating an htmlized version of an Org buffer, htmlize will
-create CSS to define the font colors.  However, this does not work when
-converting in batch mode, and it also can look bad if different people
-with different fontification setup work on the same website.
-When this variable is non-nil, creating an htmlized version of an Org buffer
-using `org-export-as-org' will include a link to this URL if the
-setting of `org-html-htmlize-output-type' is 'css."
-  :group 'org-export-html
-  :type '(choice
-	  (const :tag "Don't include external stylesheet link" nil)
-	  (string :tag "URL or local href")))
-
-
 ;;;; Table
 
 (defcustom org-html-table-tag
@@ -1069,33 +1052,42 @@ ignored."
 
 ;;;; Template :: Scripts
 
-(defcustom org-html-style-include-scripts t
+(define-obsolete-variable-alias
+  'org-html-style-include-scripts 'org-html-head-include-scripts "24.4")
+(defcustom org-html-head-include-scripts t
   "Non-nil means include the JavaScript snippets in exported HTML files.
 The actual script is defined in `org-html-scripts' and should
 not be modified."
   :group 'org-export-html
+  :version "24.4"
+  :package-version '(Org . "8.0")
   :type 'boolean)
 
 
 ;;;; Template :: Styles
 
-(defcustom org-html-style-include-default t
+(define-obsolete-variable-alias
+  'org-html-style-include-default 'org-html-head-include-default-style "24.4")
+(defcustom org-html-head-include-default-style t
   "Non-nil means include the default style in exported HTML files.
-The actual style is defined in `org-html-style-default' and should
-not be modified.  Use the variables `org-html-style' to add
-your own style information."
+The actual style is defined in `org-html-style-default' and
+should not be modified.  Use `org-html-head' to add your own
+style information."
   :group 'org-export-html
+  :version "24.4"
+  :package-version '(Org . "8.0")
   :type 'boolean)
 ;;;###autoload
-(put 'org-html-style-include-default 'safe-local-variable 'booleanp)
+(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
 
-(defcustom org-html-style ""
-  "Org-wide style definitions for exported HTML files.
+(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
+(defcustom org-html-head ""
+  "Org-wide head definitions for exported HTML files.
 
-This variable needs to contain the full HTML structure to provide a style,
-including the surrounding HTML tags.  If you set the value of this variable,
-you should consider to include definitions for the following classes:
- title, todo, done, timestamp, timestamp-kwd, tag, target.
+This variable can contain the full HTML structure to provide a
+style, including the surrounding HTML tags.  You can consider
+including definitions for the following classes: title, todo,
+done, timestamp, timestamp-kwd, tag, target.
 
 For example, a valid value would be:
 
@@ -1109,29 +1101,19 @@ For example, a valid value would be:
     ]]>
    </style>
 
-If you'd like to refer to an external style file, use something like
+If you want to refer to an external style, use something like
 
-   <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
+   <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\" />
 
-As the value of this option simply gets inserted into the HTML <head> header,
-you can \"misuse\" it to add arbitrary text to the header.
-See also the variable `org-html-style-extra'."
-  :group 'org-export-html
-  :type 'string)
-;;;###autoload
-(put 'org-html-style 'safe-local-variable 'stringp)
-
-(defcustom org-html-style-extra ""
-  "Additional style information for HTML export.
-The value of this variable is inserted into the HTML buffer right after
-the value of `org-html-style'.  Use this variable for per-file
-settings of style information, and do not forget to surround the style
-settings with <style>...</style> tags."
+As the value of this option simply gets inserted into the HTML
+<head> header, you can use it to add any arbitrary text to the
+header."
   :group 'org-export-html
+  :version "24.4"
+  :package-version '(Org . "8.0")
   :type 'string)
 ;;;###autoload
-(put 'org-html-style-extra 'safe-local-variable 'stringp)
-
+(put 'org-html-head 'safe-local-variable 'stringp)
 
 ;;;; Todos
 
@@ -1383,8 +1365,7 @@ INFO is a plist used as a communication channel."
 	       (eq org-html-htmlize-output-type 'css))
       (format "<link rel=\"stylesheet\" href=\"%s\" type=\"text/css\" />\n"
 	      (plist-get info :html-htmlized-css-url)))
-    (org-element-normalize-string (plist-get info :html-style-extra))
-    (when (plist-get info :html-style-include-scripts) org-html-scripts))))
+    (when (plist-get info :html-head-include-scripts) org-html-scripts))))
 
 (defun org-html--build-mathjax-config (info)
   "Insert the user setup into the mathjax template.

lisp/ox-org.el

@@ -27,6 +27,30 @@
 ;;; Code:
 (require 'ox)
 
+(defgroup org-export-org nil
+  "Options for exporting Org mode files to Org."
+  :tag "Org Export Org"
+  :group 'org-export)
+
+(define-obsolete-variable-alias
+  'org-export-htmlized-org-css-url org-org-htmlized-css-url "24.4")
+(defcustom org-org-htmlized-css-url nil
+  "URL pointing to the CSS defining colors for htmlized Emacs buffers.
+Normally when creating an htmlized version of an Org buffer,
+htmlize will create the CSS to define the font colors.  However,
+this does not work when converting in batch mode, and it also can
+look bad if different people with different fontification setup
+work on the same website.  When this variable is non-nil,
+creating an htmlized version of an Org buffer using
+`org-org-export-as-org' will include a link to this URL if the
+setting of `org-html-htmlize-output-type' is 'css."
+  :group 'org-export-org
+  :version "24.4"
+  :package-version '(Org . "8.0")
+  :type '(choice
+	  (const :tag "Don't include external stylesheet link" nil)
+	  (string :tag "URL or local href")))
+
 (org-export-define-backend org
   ((babel-call . org-org-identity)
    (bold . org-org-identity)
@@ -115,7 +139,27 @@ is the property list for the given project.  PUB-DIR is the
 publishing directory.
 
 Return output file name."
-  (org-publish-org-to 'org filename ".org" plist pub-dir))
+  (org-publish-org-to 'org filename ".org" plist pub-dir)
+  (when (plist-get plist :htmlized-source)
+    (require 'htmlize)
+    (require 'ox-html)
+    (or (find-buffer-visiting filename)
+	(find-file filename))
+    (font-lock-fontify-buffer)
+    (let* ((htmlize-output-type 'css)
+	   (newbuf (htmlize-buffer)))
+      (with-current-buffer newbuf
+	(when org-org-htmlized-css-url
+	  (goto-char (point-min))
+	  (and (re-search-forward
+		"<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
+	       (replace-match
+		(format
+		 "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
+		 org-org-htmlized-css-url) t t)))
+	(write-file (concat pub-dir (file-name-nondirectory filename) ".html")))
+      (kill-buffer newbuf))
+    (set-buffer-modified-p nil)))
 
 (provide 'ox-org)