Browse Source

Merge branch 'master' of orgmode.org:org-mode

Enhanced the org-e-groff.el code to use the Groff MM letter macros

* org-e-groff.el (org-e-groff-classes): Added
letter classes.
(org-e-groff-special-tags): New variable to identify special tags.
(org-e-groff--get-tagged-content): New function to retrieve
special tagged content.
(org-e-groff--mt-head): New function to create "memo" type headers.
(org-e-groff--letter-head): New function to create "letter" type headers.
(org-e-groff-template): Handle the "letter" type.
(org-e-groff-headline): handle special tags.
Luis Anaya 12 years ago
parent
commit
001df96e90
11 changed files with 525 additions and 528 deletions
  1. 4 4
      lisp/ob-awk.el
  2. 4 4
      lisp/ob-sh.el
  3. 149 148
      lisp/ob-tangle.el
  4. 2 1
      lisp/org-agenda.el
  5. 85 80
      lisp/org-bibtex.el
  6. 1 1
      lisp/org-clock.el
  7. 221 225
      lisp/org-mouse.el
  8. 3 2
      lisp/org-pcomplete.el
  9. 38 37
      lisp/org-plot.el
  10. 16 24
      lisp/org-publish.el
  11. 2 2
      lisp/org.el

+ 4 - 4
lisp/ob-awk.el

@@ -97,13 +97,13 @@ called by `org-babel-execute-src-block'"
 
 (defun org-babel-awk-var-to-awk (var &optional sep)
   "Return a printed value of VAR suitable for parsing with awk."
-  (org-flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
+  (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
     (cond
      ((and (listp var) (listp (car var)))
-      (orgtbl-to-generic var  (list :sep (or sep "\t") :fmt #'echo-var)))
+      (orgtbl-to-generic var  (list :sep (or sep "\t") :fmt echo-var)))
      ((listp var)
-      (mapconcat #'echo-var var "\n"))
-     (t (echo-var var)))))
+      (mapconcat echo-var var "\n"))
+     (t (funcall echo-var var)))))
 
 (defun org-babel-awk-table-or-string (results)
   "If the results look like a table, then convert them into an

+ 4 - 4
lisp/ob-sh.el

@@ -107,13 +107,13 @@ var of the same value."
 
 (defun org-babel-sh-var-to-string (var &optional sep)
   "Convert an elisp value to a string."
-  (org-flet ((echo-var (v) (if (stringp v) v (format "%S" v))))
+  (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
     (cond
      ((and (listp var) (listp (car var)))
-      (orgtbl-to-generic var  (list :sep (or sep "\t") :fmt #'echo-var)))
+      (orgtbl-to-generic var  (list :sep (or sep "\t") :fmt echo-var)))
      ((listp var)
-      (mapconcat #'echo-var var "\n"))
-     (t (echo-var var)))))
+      (mapconcat echo-var var "\n"))
+     (t (funcall echo-var var)))))
 
 (defun org-babel-sh-table-or-results (results)
   "Convert RESULTS to an appropriate elisp value.

+ 149 - 148
lisp/ob-tangle.el

@@ -144,19 +144,19 @@ This function exports the source code using
 `org-babel-tangle' and then loads the resulting file using
 `load-file'."
   (interactive "fFile to load: ")
-  (org-flet ((age (file)
-              (float-time
-               (time-subtract (current-time)
-                              (nth 5 (or (file-attributes (file-truename file))
-                                         (file-attributes file)))))))
-    (let* ((base-name (file-name-sans-extension file))
-           (exported-file (concat base-name ".el")))
-      ;; tangle if the org-mode file is newer than the elisp file
-      (unless (and (file-exists-p exported-file)
-		   (> (age file) (age exported-file)))
-        (org-babel-tangle-file file exported-file "emacs-lisp"))
-      (load-file exported-file)
-      (message "loaded %s" exported-file))))
+  (let* ((age (lambda (file)
+		(float-time
+		 (time-subtract (current-time)
+				(nth 5 (or (file-attributes (file-truename file))
+					   (file-attributes file)))))))
+	 (base-name (file-name-sans-extension file))
+	 (exported-file (concat base-name ".el")))
+    ;; tangle if the org-mode file is newer than the elisp file
+    (unless (and (file-exists-p exported-file)
+		 (> (funcall age file) (funcall age exported-file)))
+      (org-babel-tangle-file file exported-file "emacs-lisp"))
+    (load-file exported-file)
+    (message "loaded %s" exported-file)))
 
 ;;;###autoload
 (defun org-babel-tangle-file (file &optional target-file lang)
@@ -191,96 +191,95 @@ exported source code blocks by language."
   (run-hooks 'org-babel-pre-tangle-hook)
   ;; possibly restrict the buffer to the current code block
   (save-restriction
-  (when only-this-block
-    (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 (match-beginning 0) (match-end 0)))
-  (save-excursion
-    (let ((block-counter 0)
-	  (org-babel-default-header-args
-	   (if target-file
-	       (org-babel-merge-params org-babel-default-header-args
-				       (list (cons :tangle target-file)))
-	     org-babel-default-header-args))
-          path-collector)
-      (mapc ;; map over all languages
-       (lambda (by-lang)
-         (let* ((lang (car by-lang))
-                (specs (cdr by-lang))
-		(ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
-                (lang-f (intern
-			 (concat
-			  (or (and (cdr (assoc lang org-src-lang-modes))
-				   (symbol-name
-				    (cdr (assoc lang org-src-lang-modes))))
-			      lang)
-			  "-mode")))
-                she-banged)
-           (mapc
-            (lambda (spec)
-              (org-flet ((get-spec (name)
-                               (cdr (assoc name (nth 4 spec)))))
-                (let* ((tangle (get-spec :tangle))
-                       (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
-				  (get-spec :shebang)))
-                       (base-name (cond
-				   ((string= "yes" tangle)
-				    (file-name-sans-extension
-				     (buffer-file-name)))
-				   ((string= "no" tangle) nil)
-				   ((> (length tangle) 0) tangle)))
-                       (file-name (when base-name
-                                    ;; decide if we want to add ext to base-name
-                                    (if (and ext (string= "yes" tangle))
-                                        (concat base-name "." ext) base-name))))
-                  (when file-name
-		    ;; possibly create the parent directories for file
-		    (when ((lambda (m) (and m (not (string= m "no"))))
-			   (get-spec :mkdirp))
-		      (make-directory (file-name-directory file-name) 'parents))
-                    ;; delete any old versions of file
-                    (when (and (file-exists-p file-name)
-                               (not (member file-name path-collector)))
-                      (delete-file file-name))
-                    ;; drop source-block to file
-                    (with-temp-buffer
-                      (when (fboundp lang-f) (ignore-errors (funcall lang-f)))
-                      (when (and she-bang (not (member file-name she-banged)))
-                        (insert (concat she-bang "\n"))
-                        (setq she-banged (cons file-name she-banged)))
-                      (org-babel-spec-to-string spec)
-		      ;; We avoid append-to-file as it does not work with tramp.
-		      (let ((content (buffer-string)))
-			(with-temp-buffer
-			  (if (file-exists-p file-name)
-			      (insert-file-contents file-name))
-			  (goto-char (point-max))
-			  (insert content)
-			  (write-region nil nil file-name))))
-		    ;; if files contain she-bangs, then make the executable
-		    (when she-bang (set-file-modes file-name #o755))
-                    ;; update counter
-                    (setq block-counter (+ 1 block-counter))
-                    (add-to-list 'path-collector file-name)))))
-            specs)))
-       (org-babel-tangle-collect-blocks lang))
-      (message "tangled %d code block%s from %s" block-counter
-               (if (= block-counter 1) "" "s")
-	       (file-name-nondirectory
-		(buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
-      ;; run `org-babel-post-tangle-hook' in all tangled files
-      (when org-babel-post-tangle-hook
-	(mapc
-	 (lambda (file)
-	   (org-babel-with-temp-filebuffer file
-	     (run-hooks 'org-babel-post-tangle-hook)))
-	 path-collector))
-      path-collector))))
+    (when only-this-block
+      (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 (match-beginning 0) (match-end 0)))
+    (save-excursion
+      (let ((block-counter 0)
+	    (org-babel-default-header-args
+	     (if target-file
+		 (org-babel-merge-params org-babel-default-header-args
+					 (list (cons :tangle target-file)))
+	       org-babel-default-header-args))
+	    path-collector)
+	(mapc ;; map over all languages
+	 (lambda (by-lang)
+	   (let* ((lang (car by-lang))
+		  (specs (cdr by-lang))
+		  (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang))
+		  (lang-f (intern
+			   (concat
+			    (or (and (cdr (assoc lang org-src-lang-modes))
+				     (symbol-name
+				      (cdr (assoc lang org-src-lang-modes))))
+				lang)
+			    "-mode")))
+		  she-banged)
+	     (mapc
+	      (lambda (spec)
+		(let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec))))))
+		  (let* ((tangle (funcall get-spec :tangle))
+			 (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
+				    (funcall get-spec :shebang)))
+			 (base-name (cond
+				     ((string= "yes" tangle)
+				      (file-name-sans-extension
+				       (buffer-file-name)))
+				     ((string= "no" tangle) nil)
+				     ((> (length tangle) 0) tangle)))
+			 (file-name (when base-name
+				      ;; decide if we want to add ext to base-name
+				      (if (and ext (string= "yes" tangle))
+					  (concat base-name "." ext) base-name))))
+		    (when file-name
+		      ;; possibly create the parent directories for file
+		      (when ((lambda (m) (and m (not (string= m "no"))))
+			     (funcall get-spec :mkdirp))
+			(make-directory (file-name-directory file-name) 'parents))
+		      ;; delete any old versions of file
+		      (when (and (file-exists-p file-name)
+				 (not (member file-name path-collector)))
+			(delete-file file-name))
+		      ;; drop source-block to file
+		      (with-temp-buffer
+			(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
+			(when (and she-bang (not (member file-name she-banged)))
+			  (insert (concat she-bang "\n"))
+			  (setq she-banged (cons file-name she-banged)))
+			(org-babel-spec-to-string spec)
+			;; We avoid append-to-file as it does not work with tramp.
+			(let ((content (buffer-string)))
+			  (with-temp-buffer
+			    (if (file-exists-p file-name)
+				(insert-file-contents file-name))
+			    (goto-char (point-max))
+			    (insert content)
+			    (write-region nil nil file-name))))
+		      ;; if files contain she-bangs, then make the executable
+		      (when she-bang (set-file-modes file-name #o755))
+		      ;; update counter
+		      (setq block-counter (+ 1 block-counter))
+		      (add-to-list 'path-collector file-name)))))
+	      specs)))
+	 (org-babel-tangle-collect-blocks lang))
+	(message "tangled %d code block%s from %s" block-counter
+		 (if (= block-counter 1) "" "s")
+		 (file-name-nondirectory
+		  (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+	;; run `org-babel-post-tangle-hook' in all tangled files
+	(when org-babel-post-tangle-hook
+	  (mapc
+	   (lambda (file)
+	     (org-babel-with-temp-filebuffer file
+	       (run-hooks 'org-babel-post-tangle-hook)))
+	   path-collector))
+	path-collector))))
 
 (defun org-babel-tangle-clean ()
   "Remove comments inserted by `org-babel-tangle'.
@@ -298,6 +297,53 @@ references."
 
 (defvar org-stored-links)
 (defvar org-bracket-link-regexp)
+(defun org-babel-spec-to-string (spec)
+  "Insert SPEC into the current file.
+Insert the source-code specified by SPEC into the current
+source code file.  This function uses `comment-region' which
+assumes that the appropriate major-mode is set.  SPEC has the
+form
+
+  (start-line file link source-name params body comment)"
+  (let* ((start-line (nth 0 spec))
+	 (file (nth 1 spec))
+	 (link (nth 2 spec))
+	 (source-name (nth 3 spec))
+	 (body (nth 5 spec))
+	 (comment (nth 6 spec))
+	 (comments (cdr (assoc :comments (nth 4 spec))))
+	 (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
+	 (link-p (or (string= comments "both") (string= comments "link")
+		     (string= comments "yes") (string= comments "noweb")))
+	 (link-data (mapcar (lambda (el)
+			      (cons (symbol-name el)
+				    ((lambda (le)
+				       (if (stringp le) le (format "%S" le)))
+				     (eval el))))
+			    '(start-line file link source-name)))
+	 (insert-comment (lambda (text)
+			   (when (and comments (not (string= comments "no"))
+				      (> (length text) 0))
+			     (when padline (insert "\n"))
+			     (comment-region (point) (progn (insert text) (point)))
+			     (end-of-line nil) (insert "\n")))))
+    (when comment (funcall insert-comment comment))
+    (when link-p
+      (funcall
+       insert-comment
+       (org-fill-template org-babel-tangle-comment-format-beg link-data)))
+    (when padline (insert "\n"))
+    (insert
+     (format
+      "%s\n"
+      (replace-regexp-in-string
+       "^," ""
+       (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
+    (when link-p
+      (funcall
+       insert-comment
+       (org-fill-template org-babel-tangle-comment-format-end link-data)))))
+
 (defun org-babel-tangle-collect-blocks (&optional language)
   "Collect source blocks in the current Org-mode file.
 Return an association list of source-code block specifications of
@@ -390,51 +436,6 @@ code blocks by language."
 	   blocks))
     blocks))
 
-(defun org-babel-spec-to-string (spec)
-  "Insert SPEC into the current file.
-Insert the source-code specified by SPEC into the current
-source code file.  This function uses `comment-region' which
-assumes that the appropriate major-mode is set.  SPEC has the
-form
-
-  (start-line file link source-name params body comment)"
-  (let* ((start-line (nth 0 spec))
-	 (file (nth 1 spec))
-	 (link (nth 2 spec))
-	 (source-name (nth 3 spec))
-	 (body (nth 5 spec))
-	 (comment (nth 6 spec))
-	 (comments (cdr (assoc :comments (nth 4 spec))))
-	 (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
-	 (link-p (or (string= comments "both") (string= comments "link")
-		     (string= comments "yes") (string= comments "noweb")))
-	 (link-data (mapcar (lambda (el)
-			      (cons (symbol-name el)
-				    ((lambda (le)
-				       (if (stringp le) le (format "%S" le)))
-				     (eval el))))
-			    '(start-line file link source-name))))
-    (org-flet ((insert-comment (text)
-            (when (and comments (not (string= comments "no"))
-		       (> (length text) 0))
-	      (when padline (insert "\n"))
-	      (comment-region (point) (progn (insert text) (point)))
-	      (end-of-line nil) (insert "\n"))))
-      (when comment (insert-comment comment))
-      (when link-p
-	(insert-comment
-	 (org-fill-template org-babel-tangle-comment-format-beg link-data)))
-      (when padline (insert "\n"))
-      (insert
-       (format
-	"%s\n"
-	(replace-regexp-in-string
-	 "^," ""
-	 (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
-      (when link-p
-	(insert-comment
-	 (org-fill-template org-babel-tangle-comment-format-end link-data))))))
-
 (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))

+ 2 - 1
lisp/org-agenda.el

@@ -5105,6 +5105,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
 	  (setq marker (org-agenda-new-marker beg)
 		category (org-get-category beg)
 		org-category-pos (get-text-property beg 'org-category-position)
+		tags (save-excursion (org-backward-heading-same-level 0) (org-get-tags))
 		todo-state (org-get-todo-state))
 
 	  (dolist (r (if (stringp result)
@@ -5123,7 +5124,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
 	    (org-add-props txt props 'org-marker marker)
 	    (org-add-props txt nil
 	      'org-category category 'date date 'todo-state todo-state
-	      'org-category-position org-category-pos
+	      'org-category-position org-category-pos 'tags tags
 	      'type "sexp")
 	    (push txt ee)))))
     (nreverse ee)))

+ 85 - 80
lisp/org-bibtex.el

@@ -310,14 +310,14 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
 (defun org-bibtex-headline ()
   "Return a bibtex entry of the given headline as a string."
   (org-labels
-   ((val (key lst) (cdr (assoc key lst)))
-    (to (string) (intern (concat ":" string)))
-    (from (key) (substring (symbol-name key) 1))
-    (flatten (&rest lsts)
-	     (apply #'append (mapcar
-			      (lambda (e)
-				(if (listp e) (apply #'flatten e) (list e)))
-			      lsts))))
+      ((val (key lst) (cdr (assoc key lst)))
+       (to (string) (intern (concat ":" string)))
+       (from (key) (substring (symbol-name key) 1))
+       (flatten (&rest lsts)
+		(apply #'append (mapcar
+				 (lambda (e)
+				   (if (listp e) (apply #'flatten e) (list e)))
+				 lsts))))
     (let ((notes (buffer-string))
           (id (org-bibtex-get org-bibtex-key-property))
           (type (org-bibtex-get org-bibtex-type-property-name))
@@ -337,30 +337,30 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
                        (lambda (pair)
 			 (format "  %s={%s}" (car pair) (cdr pair)))
                        (remove nil
-			 (if (and org-bibtex-export-arbitrary-fields
-				  org-bibtex-prefix)
-			     (mapcar
-			      (lambda (kv)
-				(let ((key (car kv)) (val (cdr kv)))
-				  (when (and
-					 (string-match org-bibtex-prefix key)
-					 (not (string=
-					       (downcase (concat org-bibtex-prefix
-								 org-bibtex-type-property-name))
-					       (downcase key))))
-				    (cons (downcase (replace-regexp-in-string
-						     org-bibtex-prefix "" key))
-					  val))))
-			      (org-entry-properties nil 'standard))
-			   (mapcar
-			    (lambda (field)
-			      (let ((value (or (org-bibtex-get (from field))
-					       (and (equal :title field)
-						    (nth 4 (org-heading-components))))))
-				(when value (cons (from field) value))))
-			    (flatten
-			     (val :required (val (to type) org-bibtex-types))
-			     (val :optional (val (to type) org-bibtex-types))))))
+			       (if (and org-bibtex-export-arbitrary-fields
+					org-bibtex-prefix)
+				   (mapcar
+				    (lambda (kv)
+				      (let ((key (car kv)) (val (cdr kv)))
+					(when (and
+					       (string-match org-bibtex-prefix key)
+					       (not (string=
+						     (downcase (concat org-bibtex-prefix
+								       org-bibtex-type-property-name))
+						     (downcase key))))
+					  (cons (downcase (replace-regexp-in-string
+							   org-bibtex-prefix "" key))
+						val))))
+				    (org-entry-properties nil 'standard))
+				 (mapcar
+				  (lambda (field)
+				    (let ((value (or (org-bibtex-get (from field))
+						     (and (equal :title field)
+							  (nth 4 (org-heading-components))))))
+				      (when value (cons (from field) value))))
+				  (flatten
+				   (val :required (val (to type) org-bibtex-types))
+				   (val :optional (val (to type) org-bibtex-types))))))
                        ",\n"))))
           (with-temp-buffer
             (insert entry)
@@ -405,24 +405,26 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
                     (read-from-minibuffer "id: "))))
 
 (defun org-bibtex-fleshout (type &optional optional)
-  "Fleshout the current heading, ensuring that all required fields are present.
+  "Fleshout current heading, ensuring all required fields are present.
 With optional argument OPTIONAL, also prompt for optional fields."
-  (org-flet ((val (key lst) (cdr (assoc key lst)))
-	 (keyword (name) (intern (concat ":" (downcase name))))
-         (name (keyword) (substring (symbol-name keyword) 1)))
+  (let ((val (lambda (key lst) (cdr (assoc key lst))))
+	(keyword (lambda (name) (intern (concat ":" (downcase name)))))
+	(name (lambda (keyword) (substring (symbol-name keyword) 1))))
     (dolist (field (append
 		    (if org-bibtex-treat-headline-as-title
-			(remove :title (val :required (val type org-bibtex-types)))
-		      (val :required (val type org-bibtex-types)))
-		    (when optional (val :optional (val type org-bibtex-types)))))
+			(remove :title (funcall val :required (funcall val type org-bibtex-types)))
+		      (funcall val :required (funcall val type org-bibtex-types)))
+		    (when optional (funcall val :optional (funcall val type org-bibtex-types)))))
       (when (consp field) ; or'd pair of fields e.g., (:editor :author)
-        (let ((present (first (remove nil
-                                (mapcar
-                                 (lambda (f) (when (org-bibtex-get (name f)) f))
-                                 field)))))
-          (setf field (or present (keyword (org-icompleting-read
-					    "Field: " (mapcar #'name field)))))))
-      (let ((name (name field)))
+        (let ((present (first (remove
+			       nil
+			       (mapcar
+				(lambda (f) (when (org-bibtex-get (funcall name f)) f))
+				field)))))
+          (setf field (or present (funcall keyword
+					   (org-icompleting-read
+					    "Field: " (mapcar name field)))))))
+      (let ((name (funcall name field)))
         (unless (org-bibtex-get name)
           (let ((prop (org-bibtex-ask field)))
             (when prop (org-bibtex-put name prop)))))))
@@ -601,22 +603,23 @@ With a prefix arg, query for optional fields."
   "Read a bibtex entry and save to `org-bibtex-entries'.
 This uses `bibtex-parse-entry'."
   (interactive)
-  (org-flet ((keyword (str) (intern (concat ":" (downcase str))))
-         (clean-space (str) (replace-regexp-in-string
-                             "[[:space:]\n\r]+" " " str))
-         (strip-delim (str)	     ; strip enclosing "..." and {...}
-		      (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
-			(when (and (= (aref str 0) (car pair))
-				   (= (aref str (1- (length str))) (cdr pair)))
-			  (setf str (substring str 1 (1- (length str)))))) str))
+  (let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
+	(clean-space (lambda (str) (replace-regexp-in-string
+				    "[[:space:]\n\r]+" " " str)))
+	(strip-delim
+	 (lambda (str)	     ; strip enclosing "..." and {...}
+	   (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
+	     (when (and (= (aref str 0) (car pair))
+			(= (aref str (1- (length str))) (cdr pair)))
+	       (setf str (substring str 1 (1- (length str)))))) str)))
     (push (mapcar
            (lambda (pair)
-             (cons (let ((field (keyword (car pair))))
+             (cons (let ((field (funcall keyword (car pair))))
                      (case field
                        (:=type= :type)
                        (:=key= :key)
                        (otherwise field)))
-                   (clean-space (strip-delim (cdr pair)))))
+                   (funcall clean-space (funcall strip-delim (cdr pair)))))
            (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
           org-bibtex-entries)))
 
@@ -625,30 +628,32 @@ This uses `bibtex-parse-entry'."
   (interactive)
   (when (= (length org-bibtex-entries) 0)
     (error "No entries in `org-bibtex-entries'."))
-  (let ((entry (pop org-bibtex-entries))
-	(org-special-properties nil)) ; avoids errors with `org-entry-put'
-    (org-flet ((val (field) (cdr (assoc field entry)))
-	   (togtag (tag) (org-toggle-tag tag 'on)))
-      (org-insert-heading)
-      (insert (val :title))
-      (org-bibtex-put "TITLE" (val :title))
-      (org-bibtex-put org-bibtex-type-property-name (downcase (val :type)))
-      (dolist (pair entry)
-        (case (car pair)
-          (:title    nil)
-          (:type     nil)
-          (:key      (org-bibtex-put org-bibtex-key-property (cdr pair)))
-	  (:keywords (if org-bibtex-tags-are-keywords
-			  (mapc
-			   (lambda (kw)
-			     (togtag
-			      (replace-regexp-in-string
-			       "[^[:alnum:]_@#%]" ""
-			       (replace-regexp-in-string "[ \t]+" "_" kw))))
-			   (split-string (cdr pair) ", *"))
-		       (org-bibtex-put (car pair) (cdr pair))))
-          (otherwise (org-bibtex-put (car pair)  (cdr pair)))))
-      (mapc #'togtag org-bibtex-tags))))
+  (let* ((entry (pop org-bibtex-entries))
+	 (org-special-properties nil) ; avoids errors with `org-entry-put'
+	 (val (lambda (field) (cdr (assoc field entry))))
+	 (togtag (lambda (tag) (org-toggle-tag tag 'on))))
+    (org-insert-heading)
+    (insert (funcall val :title))
+    (org-bibtex-put "TITLE" (funcall val :title))
+    (org-bibtex-put org-bibtex-type-property-name
+		    (downcase (funcall val :type)))
+    (dolist (pair entry)
+      (case (car pair)
+	(:title    nil)
+	(:type     nil)
+	(:key      (org-bibtex-put org-bibtex-key-property (cdr pair)))
+	(:keywords (if org-bibtex-tags-are-keywords
+		       (mapc
+			(lambda (kw)
+			  (funcall
+			   togtag
+			   (replace-regexp-in-string
+			    "[^[:alnum:]_@#%]" ""
+			    (replace-regexp-in-string "[ \t]+" "_" kw))))
+			(split-string (cdr pair) ", *"))
+		     (org-bibtex-put (car pair) (cdr pair))))
+	(otherwise (org-bibtex-put (car pair)  (cdr pair)))))
+    (mapc togtag org-bibtex-tags)))
 
 (defun org-bibtex-yank ()
   "If kill ring holds a bibtex entry yank it as an Org-mode headline."

+ 1 - 1
lisp/org-clock.el

@@ -1597,7 +1597,7 @@ UPDOWN tells whether to change 'up or 'down."
   (save-excursion ; Do not replace this with `with-current-buffer'.
     (org-no-warnings (set-buffer (org-clocking-buffer)))
     (goto-char org-clock-marker)
-    (if (looking-back (concat "^[ \t]*" org-clock-string ".*"))
+    (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*"))
 	(progn (delete-region (1- (point-at-bol)) (point-at-eol))
 	       (org-remove-empty-drawer-at "LOGBOOK" (point)))
       (message "Clock gone, cancel the timer anyway")

+ 221 - 225
lisp/org-mouse.el

@@ -269,10 +269,8 @@ after the current heading."
 
 For the acceptable UNITS, see `org-timestamp-change'."
   (interactive)
-  (org-flet ((org-read-date (&rest rest) (current-time)))
-     (org-time-stamp nil))
-  (when shift
-    (org-timestamp-change shift units)))
+  (org-time-stamp nil)
+  (when shift (org-timestamp-change shift units)))
 
 (defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
   "A helper function.
@@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly."
 
 (defun org-mouse-set-priority (priority)
   "Set the priority of the current headline to PRIORITY."
-  (org-flet ((read-char-exclusive () priority))
-    (org-priority)))
+  (org-priority priority))
 
 (defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
   "Regular expression matching the priority indicator.
@@ -532,8 +529,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
      ,@(org-mouse-keyword-menu
 	(mapcar 'car org-agenda-custom-commands)
 	#'(lambda (key)
-	   (eval `(org-flet ((read-char-exclusive () (string-to-char ,key)))
-		      (org-agenda nil))))
+	   (eval `(org-agenda nil (string-to-char ,key))))
 	nil
 	#'(lambda (key)
 	   (let ((entry (assoc key org-agenda-custom-commands)))
@@ -623,234 +619,234 @@ This means, between the beginning of line and the point."
   (insert-for-yank (concat " [[" (current-kill 0) "]] ")))
 
 (defun org-mouse-context-menu (&optional event)
-  (let ((stamp-prefixes (list org-deadline-string org-scheduled-string))
-	(contextlist (org-context)))
-    (org-flet ((get-context (context) (org-mouse-get-context contextlist context)))
-  (cond
-   ((org-mouse-mark-active)
-    (let ((region-string (buffer-substring (region-beginning) (region-end))))
+  (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string))
+	 (contextlist (org-context))
+	 (get-context (lambda (context) (org-mouse-get-context contextlist context))))
+    (cond
+     ((org-mouse-mark-active)
+      (let ((region-string (buffer-substring (region-beginning) (region-end))))
+	(popup-menu
+	 `(nil
+	   ["Sparse Tree" (org-occur ',region-string)]
+	   ["Find in Buffer" (occur ',region-string)]
+	   ["Grep in Current Dir"
+	    (grep (format "grep -rnH -e '%s' *" ',region-string))]
+	   ["Grep in Parent Dir"
+	    (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
+	   "--"
+	   ["Convert to Link"
+	    (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
+		   (save-excursion (goto-char (region-end)) (insert "]]")))]
+	   ["Insert Link Here" (org-mouse-yank-link ',event)]))))
+     ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
       (popup-menu
        `(nil
-	 ["Sparse Tree" (org-occur ',region-string)]
-	 ["Find in Buffer" (occur ',region-string)]
-	 ["Grep in Current Dir"
-	  (grep (format "grep -rnH -e '%s' *" ',region-string))]
-	 ["Grep in Parent Dir"
-	  (grep (format "grep -rnH -e '%s' ../*" ',region-string))]
-	 "--"
-	 ["Convert to Link"
-	  (progn (save-excursion (goto-char (region-beginning)) (insert "[["))
-		 (save-excursion (goto-char (region-end)) (insert "]]")))]
-	 ["Insert Link Here" (org-mouse-yank-link ',event)]))))
-   ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
-    (popup-menu
-     `(nil
-       ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
-				      'org-mode-restart))))
-   ((or (eolp)
-	(and (looking-at "\\(  \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\(  \\|\t\\)+$")
-	     (org-looking-back "  \\|\t")))
-    (org-mouse-popup-global-menu))
-   ((get-context :checkbox)
-    (popup-menu
-     '(nil
-       ["Toggle" org-toggle-checkbox t]
-       ["Remove" org-mouse-remove-match-and-spaces t]
-       ""
-       ["All Clear" (org-mouse-for-each-item
-		     (lambda ()
-		       (when (save-excursion (org-at-item-checkbox-p))
-			 (replace-match "[ ]"))))]
-       ["All Set" (org-mouse-for-each-item
+	 ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
+					'org-mode-restart))))
+     ((or (eolp)
+	  (and (looking-at "\\(  \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\(  \\|\t\\)+$")
+	       (org-looking-back "  \\|\t")))
+      (org-mouse-popup-global-menu))
+     ((funcall get-context :checkbox)
+      (popup-menu
+       '(nil
+	 ["Toggle" org-toggle-checkbox t]
+	 ["Remove" org-mouse-remove-match-and-spaces t]
+	 ""
+	 ["All Clear" (org-mouse-for-each-item
+		       (lambda ()
+			 (when (save-excursion (org-at-item-checkbox-p))
+			   (replace-match "[ ]"))))]
+	 ["All Set" (org-mouse-for-each-item
 		     (lambda ()
 		       (when (save-excursion (org-at-item-checkbox-p))
 			 (replace-match "[X]"))))]
-       ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
-       ["All Remove" (org-mouse-for-each-item
-		     (lambda ()
-		       (when (save-excursion (org-at-item-checkbox-p))
-			 (org-mouse-remove-match-and-spaces))))]
-       )))
-   ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
-	 (member (match-string 0) org-todo-keywords-1))
-    (popup-menu
-     `(nil
-       ,@(org-mouse-todo-menu (match-string 0))
-       "--"
-       ["Check TODOs" org-show-todo-tree t]
-       ["List all TODO keywords" org-todo-list t]
-       [,(format "List only %s" (match-string 0))
-	(org-todo-list (match-string 0)) t]
-       )))
-   ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
-	 (member (match-string 0) stamp-prefixes))
-    (popup-menu
-     `(nil
-       ,@(org-mouse-keyword-replace-menu stamp-prefixes)
-       "--"
-       ["Check Deadlines" org-check-deadlines t]
-       )))
-   ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
-    (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
-			 (org-mouse-priority-list) 1 "Priority %s" t))))
-   ((get-context :link)
-    (popup-menu
-     '(nil
-       ["Open" org-open-at-point t]
-       ["Open in Emacs" (org-open-at-point t) t]
-       "--"
-       ["Copy link" (org-kill-new (match-string 0))]
-       ["Cut link"
-	(progn
-	  (kill-region (match-beginning 0) (match-end 0))
-	  (just-one-space))]
-       "--"
-       ["Grep for TODOs"
-	(grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
-;       ["Paste file link" ((insert "file:") (yank))]
-       )))
-   ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
-    (popup-menu
-     `(nil
-       [,(format "Display '%s'" (match-string 1))
-	(org-tags-view nil ,(match-string 1))]
-       [,(format "Sparse Tree '%s'" (match-string 1))
-	(org-tags-sparse-tree nil ,(match-string 1))]
-       "--"
-       ,@(org-mouse-tag-menu))))
-   ((org-at-timestamp-p)
-    (popup-menu
-     '(nil
-       ["Show Day" org-open-at-point t]
-       ["Change Timestamp" org-time-stamp t]
-       ["Delete Timestamp" (org-mouse-delete-timestamp) t]
-       ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
-       "--"
-       ["Set for Today" org-mouse-timestamp-today]
-       ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
-       ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
-       ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
-       ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
-       "--"
-       ["+ 1 Day" (org-timestamp-change 1 'day)]
-       ["+ 1 Week" (org-timestamp-change 7 'day)]
-       ["+ 1 Month" (org-timestamp-change 1 'month)]
-       "--"
-       ["- 1 Day" (org-timestamp-change -1 'day)]
-       ["- 1 Week" (org-timestamp-change -7 'day)]
-       ["- 1 Month" (org-timestamp-change -1 'month)])))
-   ((get-context :table-special)
-    (let ((mdata (match-data)))
-      (incf (car mdata) 2)
-      (store-match-data mdata))
-    (message "match: %S" (match-string 0))
-    (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
-			 '(" " "!" "^" "_" "$" "#" "*" "'") 0
-			 (lambda (mark)
-			   (case (string-to-char mark)
-			     (?  "( ) Nothing Special")
-			     (?! "(!) Column Names")
-			     (?^ "(^) Field Names Above")
-			     (?_ "(^) Field Names Below")
-			     (?$ "($) Formula Parameters")
-			     (?# "(#) Recalculation: Auto")
-			     (?* "(*) Recalculation: Manual")
-			     (?' "(') Recalculation: None"))) t))))
-   ((assq :table contextlist)
-    (popup-menu
-     '(nil
-       ["Align Table" org-ctrl-c-ctrl-c]
-       ["Blank Field" org-table-blank-field]
-       ["Edit Field" org-table-edit-field]
-	"--"
-	("Column"
-	 ["Move Column Left" org-metaleft]
-	 ["Move Column Right" org-metaright]
-	 ["Delete Column" org-shiftmetaleft]
-	 ["Insert Column" org-shiftmetaright]
+	 ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t]
+	 ["All Remove" (org-mouse-for-each-item
+			(lambda ()
+			  (when (save-excursion (org-at-item-checkbox-p))
+			    (org-mouse-remove-match-and-spaces))))]
+	 )))
+     ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_")
+	   (member (match-string 0) org-todo-keywords-1))
+      (popup-menu
+       `(nil
+	 ,@(org-mouse-todo-menu (match-string 0))
 	 "--"
-	 ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
-	("Row"
-	 ["Move Row Up" org-metaup]
-	 ["Move Row Down" org-metadown]
-	 ["Delete Row" org-shiftmetaup]
-	 ["Insert Row" org-shiftmetadown]
-	 ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
+	 ["Check TODOs" org-show-todo-tree t]
+	 ["List all TODO keywords" org-todo-list t]
+	 [,(format "List only %s" (match-string 0))
+	  (org-todo-list (match-string 0)) t]
+	 )))
+     ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z")
+	   (member (match-string 0) stamp-prefixes))
+      (popup-menu
+       `(nil
+	 ,@(org-mouse-keyword-replace-menu stamp-prefixes)
 	 "--"
-	 ["Insert Hline" org-table-insert-hline])
-	("Rectangle"
-	 ["Copy Rectangle" org-copy-special]
-	 ["Cut Rectangle" org-cut-special]
-	 ["Paste Rectangle" org-paste-special]
-	 ["Fill Rectangle" org-table-wrap-region])
-	"--"
-	["Set Column Formula" org-table-eval-formula]
-	["Set Field Formula" (org-table-eval-formula '(4))]
-	["Edit Formulas" org-table-edit-formulas]
-	"--"
-	["Recalculate Line" org-table-recalculate]
-	["Recalculate All" (org-table-recalculate '(4))]
-	["Iterate All" (org-table-recalculate '(16))]
-	"--"
-	["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
-	["Sum Column/Rectangle" org-table-sum
-	 :active (or (org-at-table-p) (org-region-active-p))]
-	["Field Info" org-table-field-info]
-	["Debug Formulas"
-	 (setq org-table-formula-debug (not org-table-formula-debug))
-	 :style toggle :selected org-table-formula-debug]
-	)))
-   ((and (assq :headline contextlist) (not (eolp)))
-    (let ((priority (org-mouse-get-priority t)))
+	 ["Check Deadlines" org-check-deadlines t]
+	 )))
+     ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority
+      (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+			   (org-mouse-priority-list) 1 "Priority %s" t))))
+     ((funcall get-context :link)
       (popup-menu
-       `("Headline Menu"
-	 ("Tags and Priorities"
-	  ,@(org-mouse-keyword-menu
-	     (org-mouse-priority-list)
-	     #'(lambda (keyword)
-		(org-mouse-set-priority (string-to-char keyword)))
-	     priority "Priority %s")
-	  "--"
-	  ,@(org-mouse-tag-menu))
-	 ("TODO Status"
-	  ,@(org-mouse-todo-menu (org-get-todo-state)))
-	 ["Show Tags"
-	  (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
-	  :visible (not org-mouse-direct)]
-	 ["Show Priority"
-	  (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
-	  :visible (not org-mouse-direct)]
-	 ,@(if org-mouse-direct '("--") nil)
-	 ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
-	 ["Set Deadline"
-	  (progn (org-mouse-end-headline) (insert " ") (org-deadline))
-	  :active (not (save-excursion
-			 (org-mouse-re-search-line org-deadline-regexp)))]
-	 ["Schedule Task"
-	  (progn (org-mouse-end-headline) (insert " ") (org-schedule))
-	  :active (not (save-excursion
-			 (org-mouse-re-search-line org-scheduled-regexp)))]
-	 ["Insert Timestamp"
-	  (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
-;	 ["Timestamp (inactive)" org-time-stamp-inactive t]
+       '(nil
+	 ["Open" org-open-at-point t]
+	 ["Open in Emacs" (org-open-at-point t) t]
+	 "--"
+	 ["Copy link" (org-kill-new (match-string 0))]
+	 ["Cut link"
+	  (progn
+	    (kill-region (match-beginning 0) (match-end 0))
+	    (just-one-space))]
 	 "--"
-	 ["Archive Subtree" org-archive-subtree]
-	 ["Cut Subtree"  org-cut-special]
-	 ["Copy Subtree"  org-copy-special]
-	 ["Paste Subtree"  org-paste-special :visible org-mouse-direct]
-	 ("Sort Children"
-	  ["Alphabetically" (org-sort-entries nil ?a)]
-	  ["Numerically" (org-sort-entries nil ?n)]
-	  ["By Time/Date" (org-sort-entries nil ?t)]
+	 ["Grep for TODOs"
+	  (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))]
+					;       ["Paste file link" ((insert "file:") (yank))]
+	 )))
+     ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags
+      (popup-menu
+       `(nil
+	 [,(format "Display '%s'" (match-string 1))
+	  (org-tags-view nil ,(match-string 1))]
+	 [,(format "Sparse Tree '%s'" (match-string 1))
+	  (org-tags-sparse-tree nil ,(match-string 1))]
+	 "--"
+	 ,@(org-mouse-tag-menu))))
+     ((org-at-timestamp-p)
+      (popup-menu
+       '(nil
+	 ["Show Day" org-open-at-point t]
+	 ["Change Timestamp" org-time-stamp t]
+	 ["Delete Timestamp" (org-mouse-delete-timestamp) t]
+	 ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)]
+	 "--"
+	 ["Set for Today" org-mouse-timestamp-today]
+	 ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)]
+	 ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)]
+	 ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)]
+	 ["Set in a Month" (org-mouse-timestamp-today 1 'month)]
+	 "--"
+	 ["+ 1 Day" (org-timestamp-change 1 'day)]
+	 ["+ 1 Week" (org-timestamp-change 7 'day)]
+	 ["+ 1 Month" (org-timestamp-change 1 'month)]
+	 "--"
+	 ["- 1 Day" (org-timestamp-change -1 'day)]
+	 ["- 1 Week" (org-timestamp-change -7 'day)]
+	 ["- 1 Month" (org-timestamp-change -1 'month)])))
+     ((funcall get-context :table-special)
+      (let ((mdata (match-data)))
+	(incf (car mdata) 2)
+	(store-match-data mdata))
+      (message "match: %S" (match-string 0))
+      (popup-menu `(nil ,@(org-mouse-keyword-replace-menu
+			   '(" " "!" "^" "_" "$" "#" "*" "'") 0
+			   (lambda (mark)
+			     (case (string-to-char mark)
+			       (?  "( ) Nothing Special")
+			       (?! "(!) Column Names")
+			       (?^ "(^) Field Names Above")
+			       (?_ "(^) Field Names Below")
+			       (?$ "($) Formula Parameters")
+			       (?# "(#) Recalculation: Auto")
+			       (?* "(*) Recalculation: Manual")
+			       (?' "(') Recalculation: None"))) t))))
+     ((assq :table contextlist)
+      (popup-menu
+       '(nil
+	 ["Align Table" org-ctrl-c-ctrl-c]
+	 ["Blank Field" org-table-blank-field]
+	 ["Edit Field" org-table-edit-field]
+	 "--"
+	 ("Column"
+	  ["Move Column Left" org-metaleft]
+	  ["Move Column Right" org-metaright]
+	  ["Delete Column" org-shiftmetaleft]
+	  ["Insert Column" org-shiftmetaright]
+	  "--"
+	  ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle])
+	 ("Row"
+	  ["Move Row Up" org-metaup]
+	  ["Move Row Down" org-metadown]
+	  ["Delete Row" org-shiftmetaup]
+	  ["Insert Row" org-shiftmetadown]
+	  ["Sort lines in region" org-table-sort-lines (org-at-table-p)]
 	  "--"
-	  ["Reverse Alphabetically" (org-sort-entries nil ?A)]
-	  ["Reverse Numerically" (org-sort-entries nil ?N)]
-	  ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+	  ["Insert Hline" org-table-insert-hline])
+	 ("Rectangle"
+	  ["Copy Rectangle" org-copy-special]
+	  ["Cut Rectangle" org-cut-special]
+	  ["Paste Rectangle" org-paste-special]
+	  ["Fill Rectangle" org-table-wrap-region])
 	 "--"
-	 ["Move Trees" org-mouse-move-tree :active nil]
-	 ))))
-   (t
-    (org-mouse-popup-global-menu))))))
+	 ["Set Column Formula" org-table-eval-formula]
+	 ["Set Field Formula" (org-table-eval-formula '(4))]
+	 ["Edit Formulas" org-table-edit-formulas]
+	 "--"
+	 ["Recalculate Line" org-table-recalculate]
+	 ["Recalculate All" (org-table-recalculate '(4))]
+	 ["Iterate All" (org-table-recalculate '(16))]
+	 "--"
+	 ["Toggle Recalculate Mark" org-table-rotate-recalc-marks]
+	 ["Sum Column/Rectangle" org-table-sum
+	  :active (or (org-at-table-p) (org-region-active-p))]
+	 ["Field Info" org-table-field-info]
+	 ["Debug Formulas"
+	  (setq org-table-formula-debug (not org-table-formula-debug))
+	  :style toggle :selected org-table-formula-debug]
+	 )))
+     ((and (assq :headline contextlist) (not (eolp)))
+      (let ((priority (org-mouse-get-priority t)))
+	(popup-menu
+	 `("Headline Menu"
+	   ("Tags and Priorities"
+	    ,@(org-mouse-keyword-menu
+	       (org-mouse-priority-list)
+	       #'(lambda (keyword)
+		   (org-mouse-set-priority (string-to-char keyword)))
+	       priority "Priority %s")
+	    "--"
+	    ,@(org-mouse-tag-menu))
+	   ("TODO Status"
+	    ,@(org-mouse-todo-menu (org-get-todo-state)))
+	   ["Show Tags"
+	    (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags))
+	    :visible (not org-mouse-direct)]
+	   ["Show Priority"
+	    (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority))
+	    :visible (not org-mouse-direct)]
+	   ,@(if org-mouse-direct '("--") nil)
+	   ["New Heading" org-mouse-insert-heading :visible org-mouse-direct]
+	   ["Set Deadline"
+	    (progn (org-mouse-end-headline) (insert " ") (org-deadline))
+	    :active (not (save-excursion
+			   (org-mouse-re-search-line org-deadline-regexp)))]
+	   ["Schedule Task"
+	    (progn (org-mouse-end-headline) (insert " ") (org-schedule))
+	    :active (not (save-excursion
+			   (org-mouse-re-search-line org-scheduled-regexp)))]
+	   ["Insert Timestamp"
+	    (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t]
+					;	 ["Timestamp (inactive)" org-time-stamp-inactive t]
+	   "--"
+	   ["Archive Subtree" org-archive-subtree]
+	   ["Cut Subtree"  org-cut-special]
+	   ["Copy Subtree"  org-copy-special]
+	   ["Paste Subtree"  org-paste-special :visible org-mouse-direct]
+	   ("Sort Children"
+	    ["Alphabetically" (org-sort-entries nil ?a)]
+	    ["Numerically" (org-sort-entries nil ?n)]
+	    ["By Time/Date" (org-sort-entries nil ?t)]
+	    "--"
+	    ["Reverse Alphabetically" (org-sort-entries nil ?A)]
+	    ["Reverse Numerically" (org-sort-entries nil ?N)]
+	    ["Reverse By Time/Date" (org-sort-entries nil ?T)])
+	   "--"
+	   ["Move Trees" org-mouse-move-tree :active nil]
+	   ))))
+     (t
+      (org-mouse-popup-global-menu)))))
 
 (defun org-mouse-mark-active ()
   (and mark-active transient-mark-mode))

+ 3 - 2
lisp/org-pcomplete.el

@@ -31,6 +31,7 @@
   (require 'cl))
 
 (require 'org-macs)
+(require 'org-compat)
 (require 'pcomplete)
 
 (declare-function org-split-string "org" (string &optional separators))
@@ -93,8 +94,8 @@ The return value is a string naming the thing at point."
 	     (skip-chars-backward "[ \t\n]")
 	     ;; org-drawer-regexp matches a whole line but while
 	     ;; looking-back, we just ignore trailing whitespaces
-	     (or (looking-back (substring org-drawer-regexp 0 -1))
-		 (looking-back org-property-re))))
+	     (or (org-looking-back (substring org-drawer-regexp 0 -1))
+		 (org-looking-back org-property-re))))
       (cons "prop" nil))
      ((and (equal (char-before beg1) ?:)
 	   (not (equal (char-after (point-at-bol)) ?*)))

+ 38 - 37
lisp/org-plot.el

@@ -209,40 +209,41 @@ manner suitable for prepending to a user-specified script."
 		     ('2d "plot")
 		     ('3d "splot")
 		     ('grid "splot")))
-	 (script "reset") plot-lines)
-    (org-flet ((add-to-script (line) (setf script (format "%s\n%s" script line))))
-      (when file ;; output file
-	(add-to-script (format "set term %s" (file-name-extension file)))
-	(add-to-script (format "set output '%s'" file)))
-      (case type ;; type
-	('2d ())
-	('3d (if map (add-to-script "set map")))
-	('grid (if map
-		   (add-to-script "set pm3d map")
-		 (add-to-script "set pm3d"))))
-      (when title (add-to-script (format "set title '%s'" title))) ;; title
-      (when lines (mapc (lambda (el) (add-to-script el)) lines)) ;; line
-      (when sets ;; set
-	(mapc (lambda (el) (add-to-script (format "set %s" el))) sets))
-      (when x-labels ;; x labels (xtics)
-	(add-to-script
-	 (format "set xtics (%s)"
-		 (mapconcat (lambda (pair)
-			      (format "\"%s\" %d" (cdr pair) (car pair)))
-			    x-labels ", "))))
-      (when y-labels ;; y labels (ytics)
-	(add-to-script
-	 (format "set ytics (%s)"
-		 (mapconcat (lambda (pair)
-			      (format "\"%s\" %d" (cdr pair) (car pair)))
-			    y-labels ", "))))
-      (when time-ind ;; timestamp index
-	(add-to-script "set xdata time")
-	(add-to-script (concat "set timefmt \""
-			       (or timefmt ;; timefmt passed to gnuplot
-				   "%Y-%m-%d-%H:%M:%S") "\"")))
-      (unless preface
-        (case type ;; plot command
+	 (script "reset")
+					; ats = add-to-script
+	 (ats (lambda (line) (setf script (format "%s\n%s" script line)))) 
+	 plot-lines)
+    (when file ;; output file
+      (funcall ats (format "set term %s" (file-name-extension file)))
+      (funcall ats (format "set output '%s'" file)))
+    (case type ;; type
+      ('2d ())
+      ('3d (if map (funcall ats "set map")))
+      ('grid (if map (funcall ats "set pm3d map")
+	       (funcall ats "set pm3d"))))
+    (when title (funcall ats (format "set title '%s'" title))) ;; title
+    (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line
+    (when sets ;; set
+      (mapc (lambda (el) (funcall ats (format "set %s" el))) sets))
+    (when x-labels ;; x labels (xtics)
+      (funcall ats
+	       (format "set xtics (%s)"
+		       (mapconcat (lambda (pair)
+				    (format "\"%s\" %d" (cdr pair) (car pair)))
+				  x-labels ", "))))
+    (when y-labels ;; y labels (ytics)
+      (funcall ats
+	       (format "set ytics (%s)"
+		       (mapconcat (lambda (pair)
+				    (format "\"%s\" %d" (cdr pair) (car pair)))
+				  y-labels ", "))))
+    (when time-ind ;; timestamp index
+      (funcall ats "set xdata time")
+      (funcall ats (concat "set timefmt \""
+			   (or timefmt ;; timefmt passed to gnuplot
+			       "%Y-%m-%d-%H:%M:%S") "\"")))
+    (unless preface
+      (case type ;; plot command
 	('2d (dotimes (col num-cols)
 	       (unless (and (equal type '2d)
 			    (or (and ind (equal (+ 1 col) ind))
@@ -264,9 +265,9 @@ manner suitable for prepending to a user-specified script."
 	('grid
 	 (setq plot-lines (list (format "'%s' with %s title ''"
 					data-file with)))))
-        (add-to-script
-         (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n    "))))
-      script)))
+      (funcall ats
+	       (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n    "))))
+    script))
 
 ;;-----------------------------------------------------------------------------
 ;; facade functions

+ 16 - 24
lisp/org-publish.el

@@ -1045,13 +1045,12 @@ the project."
 (defun org-publish-write-cache-file (&optional free-cache)
   "Write `org-publish-cache' to file.
 If FREE-CACHE, empty the cache."
-  (unless org-publish-cache
-    (error "%s" "`org-publish-write-cache-file' called, but no cache present"))
+  (or org-publish-cache
+      (error "`org-publish-write-cache-file' called, but no cache present"))
 
   (let ((cache-file (org-publish-cache-get ":cache-file:")))
-    (unless cache-file
-      (error
-       "%s" "Cannot find cache-file name in `org-publish-write-cache-file'"))
+    (or cache-file
+	(error "Cannot find cache-file name in `org-publish-write-cache-file'"))
     (with-temp-file cache-file
       (let ((print-level nil)
 	    (print-length nil))
@@ -1068,9 +1067,8 @@ If FREE-CACHE, empty the cache."
 (defun org-publish-initialize-cache (project-name)
   "Initialize the projects cache if not initialized yet and return it."
 
-  (unless project-name
-    (error "%s%s" "Cannot initialize `org-publish-cache' without projects name"
-	   " in `org-publish-initialize-cache'"))
+  (or project-name
+      (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
 
   (unless (file-exists-p org-publish-timestamp-directory)
     (make-directory org-publish-timestamp-directory t))
@@ -1110,8 +1108,8 @@ If FREE-CACHE, empty the cache."
 Return `t', if the file needs publishing.  The function also
 checks if any included files have been more recently published,
 so that the file including them will be republished as well."
-  (unless org-publish-cache
-    (error "%s" "`org-publish-cache-file-needs-publishing' called, but no cache present"))
+  (or org-publish-cache
+      (error "`org-publish-cache-file-needs-publishing' called, but no cache present"))
   (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
 	 (pstamp (org-publish-cache-get key))
 	 (visiting (find-buffer-visiting filename))
@@ -1174,28 +1172,22 @@ If the entry will be created, unless NO-CREATE is not nil."
   "Return the value stored in `org-publish-cache' for key KEY.
 Returns nil, if no value or nil is found, or the cache does not
 exist."
-  (unless org-publish-cache
-    (error "%s" "`org-publish-cache-get' called, but no cache present"))
+  (or org-publish-cache
+      (error "`org-publish-cache-get' called, but no cache present"))
   (gethash key org-publish-cache))
 
 (defun org-publish-cache-set (key value)
   "Store KEY VALUE pair in `org-publish-cache'.
 Returns value on success, else nil."
-  (unless org-publish-cache
-    (error "%s" "`org-publish-cache-set' called, but no cache present"))
+  (or org-publish-cache
+      (error "`org-publish-cache-set' called, but no cache present"))
   (puthash key value org-publish-cache))
 
-(defun org-publish-cache-ctime-of-src (filename)
+(defun org-publish-cache-ctime-of-src (f)
   "Get the FILENAME ctime as an integer."
-  (let* ((symlink-maybe (or (file-symlink-p filename) filename))
-	 (src-attr (file-attributes (if (file-name-absolute-p symlink-maybe)
-					symlink-maybe
-				      (expand-file-name
-				       symlink-maybe
-				       (file-name-directory filename))))))
-    (+
-     (lsh (car (nth 5 src-attr)) 16)
-     (cadr (nth 5 src-attr)))))
+  (let ((attr (file-attributes (expand-file-name (or (file-symlink-p f) f)))))
+    (+ (lsh (car (nth 5 attr)) 16)
+       (cadr (nth 5 attr)))))
 
 (provide 'org-publish)
 

+ 2 - 2
lisp/org.el

@@ -12910,7 +12910,7 @@ from the `before-change-functions' in the current buffer."
   (org-priority 'down))
 
 (defun org-priority (&optional action)
-  "Change the priority of an item by ARG.
+  "Change the priority of an item.
 ACTION can be `set', `up', `down', or a character."
   (interactive)
   (unless org-enable-priority-commands
@@ -16463,7 +16463,7 @@ in the timestamp determines what will be changed."
 	    (message "No clock to adjust")
 	  (cond ((save-excursion ; fix previous clock?
 		   (re-search-backward org-ts-regexp0 nil t)
-		   (looking-back (concat org-clock-string " \\[")))
+		   (org-looking-back (concat org-clock-string " \\[")))
 		 (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
 		((save-excursion ; fix next clock?
 		   (re-search-backward org-ts-regexp0 nil t)