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)
 (defun org-babel-awk-var-to-awk (var &optional sep)
   "Return a printed value of VAR suitable for parsing with awk."
   "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
     (cond
      ((and (listp var) (listp (car var)))
      ((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)
      ((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)
 (defun org-babel-awk-table-or-string (results)
   "If the results look like a table, then convert them into an
   "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)
 (defun org-babel-sh-var-to-string (var &optional sep)
   "Convert an elisp value to a string."
   "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
     (cond
      ((and (listp var) (listp (car var)))
      ((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)
      ((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)
 (defun org-babel-sh-table-or-results (results)
   "Convert RESULTS to an appropriate elisp value.
   "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
 `org-babel-tangle' and then loads the resulting file using
 `load-file'."
 `load-file'."
   (interactive "fFile to load: ")
   (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
 ;;;###autoload
 (defun org-babel-tangle-file (file &optional target-file lang)
 (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)
   (run-hooks 'org-babel-pre-tangle-hook)
   ;; possibly restrict the buffer to the current code block
   ;; possibly restrict the buffer to the current code block
   (save-restriction
   (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 ()
 (defun org-babel-tangle-clean ()
   "Remove comments inserted by `org-babel-tangle'.
   "Remove comments inserted by `org-babel-tangle'.
@@ -298,6 +297,53 @@ references."
 
 
 (defvar org-stored-links)
 (defvar org-stored-links)
 (defvar org-bracket-link-regexp)
 (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)
 (defun org-babel-tangle-collect-blocks (&optional language)
   "Collect source blocks in the current Org-mode file.
   "Collect source blocks in the current Org-mode file.
 Return an association list of source-code block specifications of
 Return an association list of source-code block specifications of
@@ -390,51 +436,6 @@ code blocks by language."
 	   blocks))
 	   blocks))
     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)
 (defun org-babel-tangle-comment-links ( &optional info)
   "Return a list of begin and end link comments for the code block at point."
   "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))
   (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)
 	  (setq marker (org-agenda-new-marker beg)
 		category (org-get-category beg)
 		category (org-get-category beg)
 		org-category-pos (get-text-property beg 'org-category-position)
 		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))
 		todo-state (org-get-todo-state))
 
 
 	  (dolist (r (if (stringp result)
 	  (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 props 'org-marker marker)
 	    (org-add-props txt nil
 	    (org-add-props txt nil
 	      'org-category category 'date date 'todo-state todo-state
 	      '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")
 	      'type "sexp")
 	    (push txt ee)))))
 	    (push txt ee)))))
     (nreverse 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 ()
 (defun org-bibtex-headline ()
   "Return a bibtex entry of the given headline as a string."
   "Return a bibtex entry of the given headline as a string."
   (org-labels
   (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))
     (let ((notes (buffer-string))
           (id (org-bibtex-get org-bibtex-key-property))
           (id (org-bibtex-get org-bibtex-key-property))
           (type (org-bibtex-get org-bibtex-type-property-name))
           (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)
                        (lambda (pair)
 			 (format "  %s={%s}" (car pair) (cdr pair)))
 			 (format "  %s={%s}" (car pair) (cdr pair)))
                        (remove nil
                        (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"))))
                        ",\n"))))
           (with-temp-buffer
           (with-temp-buffer
             (insert entry)
             (insert entry)
@@ -405,24 +405,26 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords` is t."
                     (read-from-minibuffer "id: "))))
                     (read-from-minibuffer "id: "))))
 
 
 (defun org-bibtex-fleshout (type &optional optional)
 (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."
 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
     (dolist (field (append
 		    (if org-bibtex-treat-headline-as-title
 		    (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)
       (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)
         (unless (org-bibtex-get name)
           (let ((prop (org-bibtex-ask field)))
           (let ((prop (org-bibtex-ask field)))
             (when prop (org-bibtex-put name prop)))))))
             (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'.
   "Read a bibtex entry and save to `org-bibtex-entries'.
 This uses `bibtex-parse-entry'."
 This uses `bibtex-parse-entry'."
   (interactive)
   (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
     (push (mapcar
            (lambda (pair)
            (lambda (pair)
-             (cons (let ((field (keyword (car pair))))
+             (cons (let ((field (funcall keyword (car pair))))
                      (case field
                      (case field
                        (:=type= :type)
                        (:=type= :type)
                        (:=key= :key)
                        (:=key= :key)
                        (otherwise field)))
                        (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)))
            (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
           org-bibtex-entries)))
           org-bibtex-entries)))
 
 
@@ -625,30 +628,32 @@ This uses `bibtex-parse-entry'."
   (interactive)
   (interactive)
   (when (= (length org-bibtex-entries) 0)
   (when (= (length org-bibtex-entries) 0)
     (error "No entries in `org-bibtex-entries'."))
     (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 ()
 (defun org-bibtex-yank ()
   "If kill ring holds a bibtex entry yank it as an Org-mode headline."
   "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'.
   (save-excursion ; Do not replace this with `with-current-buffer'.
     (org-no-warnings (set-buffer (org-clocking-buffer)))
     (org-no-warnings (set-buffer (org-clocking-buffer)))
     (goto-char org-clock-marker)
     (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))
 	(progn (delete-region (1- (point-at-bol)) (point-at-eol))
 	       (org-remove-empty-drawer-at "LOGBOOK" (point)))
 	       (org-remove-empty-drawer-at "LOGBOOK" (point)))
       (message "Clock gone, cancel the timer anyway")
       (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'."
 For the acceptable UNITS, see `org-timestamp-change'."
   (interactive)
   (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)
 (defun org-mouse-keyword-menu (keywords function &optional selected itemformat)
   "A helper function.
   "A helper function.
@@ -375,8 +373,7 @@ nor a function, elements of KEYWORDS are used directly."
 
 
 (defun org-mouse-set-priority (priority)
 (defun org-mouse-set-priority (priority)
   "Set the priority of the current headline to 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]\\)\\]"
 (defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]"
   "Regular expression matching the priority indicator.
   "Regular expression matching the priority indicator.
@@ -532,8 +529,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
      ,@(org-mouse-keyword-menu
      ,@(org-mouse-keyword-menu
 	(mapcar 'car org-agenda-custom-commands)
 	(mapcar 'car org-agenda-custom-commands)
 	#'(lambda (key)
 	#'(lambda (key)
-	   (eval `(org-flet ((read-char-exclusive () (string-to-char ,key)))
-		      (org-agenda nil))))
+	   (eval `(org-agenda nil (string-to-char ,key))))
 	nil
 	nil
 	#'(lambda (key)
 	#'(lambda (key)
 	   (let ((entry (assoc key org-agenda-custom-commands)))
 	   (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) "]] ")))
   (insert-for-yank (concat " [[" (current-kill 0) "]] ")))
 
 
 (defun org-mouse-context-menu (&optional event)
 (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
       (popup-menu
        `(nil
        `(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 ()
 		     (lambda ()
 		       (when (save-excursion (org-at-item-checkbox-p))
 		       (when (save-excursion (org-at-item-checkbox-p))
 			 (replace-match "[X]"))))]
 			 (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
       (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 ()
 (defun org-mouse-mark-active ()
   (and mark-active transient-mark-mode))
   (and mark-active transient-mark-mode))

+ 3 - 2
lisp/org-pcomplete.el

@@ -31,6 +31,7 @@
   (require 'cl))
   (require 'cl))
 
 
 (require 'org-macs)
 (require 'org-macs)
+(require 'org-compat)
 (require 'pcomplete)
 (require 'pcomplete)
 
 
 (declare-function org-split-string "org" (string &optional separators))
 (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]")
 	     (skip-chars-backward "[ \t\n]")
 	     ;; org-drawer-regexp matches a whole line but while
 	     ;; org-drawer-regexp matches a whole line but while
 	     ;; looking-back, we just ignore trailing whitespaces
 	     ;; 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))
       (cons "prop" nil))
      ((and (equal (char-before beg1) ?:)
      ((and (equal (char-before beg1) ?:)
 	   (not (equal (char-after (point-at-bol)) ?*)))
 	   (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")
 		     ('2d "plot")
 		     ('3d "splot")
 		     ('3d "splot")
 		     ('grid "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)
 	('2d (dotimes (col num-cols)
 	       (unless (and (equal type '2d)
 	       (unless (and (equal type '2d)
 			    (or (and ind (equal (+ 1 col) ind))
 			    (or (and ind (equal (+ 1 col) ind))
@@ -264,9 +265,9 @@ manner suitable for prepending to a user-specified script."
 	('grid
 	('grid
 	 (setq plot-lines (list (format "'%s' with %s title ''"
 	 (setq plot-lines (list (format "'%s' with %s title ''"
 					data-file with)))))
 					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
 ;; facade functions

+ 16 - 24
lisp/org-publish.el

@@ -1045,13 +1045,12 @@ the project."
 (defun org-publish-write-cache-file (&optional free-cache)
 (defun org-publish-write-cache-file (&optional free-cache)
   "Write `org-publish-cache' to file.
   "Write `org-publish-cache' to file.
 If FREE-CACHE, empty the cache."
 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:")))
   (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
     (with-temp-file cache-file
       (let ((print-level nil)
       (let ((print-level nil)
 	    (print-length nil))
 	    (print-length nil))
@@ -1068,9 +1067,8 @@ If FREE-CACHE, empty the cache."
 (defun org-publish-initialize-cache (project-name)
 (defun org-publish-initialize-cache (project-name)
   "Initialize the projects cache if not initialized yet and return it."
   "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)
   (unless (file-exists-p org-publish-timestamp-directory)
     (make-directory org-publish-timestamp-directory t))
     (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
 Return `t', if the file needs publishing.  The function also
 checks if any included files have been more recently published,
 checks if any included files have been more recently published,
 so that the file including them will be republished as well."
 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))
   (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
 	 (pstamp (org-publish-cache-get key))
 	 (pstamp (org-publish-cache-get key))
 	 (visiting (find-buffer-visiting filename))
 	 (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.
   "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
 Returns nil, if no value or nil is found, or the cache does not
 exist."
 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))
   (gethash key org-publish-cache))
 
 
 (defun org-publish-cache-set (key value)
 (defun org-publish-cache-set (key value)
   "Store KEY VALUE pair in `org-publish-cache'.
   "Store KEY VALUE pair in `org-publish-cache'.
 Returns value on success, else nil."
 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))
   (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."
   "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)
 (provide 'org-publish)
 
 

+ 2 - 2
lisp/org.el

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