0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-08-25 04:32:52 +00:00

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

This commit is contained in:
Carsten Dominik 2011-03-25 08:55:29 +01:00
commit 001346cbe7
7 changed files with 110 additions and 74 deletions

View file

@ -250,7 +250,7 @@ inhibit insertion of results into the buffer."
(when (and org-export-babel-evaluate (when (and org-export-babel-evaluate
(not (and hash (not (and hash
(equal hash (org-babel-exp-in-export-file (nth 0 info) (equal hash (org-babel-exp-in-export-file (nth 0 info)
(org-babel-result-hash)))))) (org-babel-result-hash info))))))
(let ((lang (nth 0 info)) (let ((lang (nth 0 info))
(body (nth 1 info))) (body (nth 1 info)))
;; skip code blocks which we can't evaluate ;; skip code blocks which we can't evaluate

View file

@ -1652,7 +1652,10 @@ fontified, and then returned."
(defun org-clock-report (&optional arg) (defun org-clock-report (&optional arg)
"Create a table containing a report about clocked time. "Create a table containing a report about clocked time.
If the cursor is inside an existing clocktable block, then the table If the cursor is inside an existing clocktable block, then the table
will be updated. If not, a new clocktable will be inserted. will be updated. If not, a new clocktable will be inserted. The scope
of the new clock will be subtree when called from within a subtree, and
file elsewhere.
When called with a prefix argument, move to the first clock table in the When called with a prefix argument, move to the first clock table in the
buffer and update it." buffer and update it."
(interactive "P") (interactive "P")
@ -1662,8 +1665,12 @@ buffer and update it."
(org-show-entry)) (org-show-entry))
(if (org-in-clocktable-p) (if (org-in-clocktable-p)
(goto-char (org-in-clocktable-p)) (goto-char (org-in-clocktable-p))
(org-create-dblock (append (list :name "clocktable") (let ((props (if (ignore-errors
org-clock-clocktable-default-properties))) (save-excursion (org-back-to-heading)))
(list :name "clocktable" :scope 'subtree)
(list :name "clocktable"))))
(org-create-dblock
(org-combine-plists org-clock-clocktable-default-properties props))))
(org-update-dblock)) (org-update-dblock))
(defun org-in-clocktable-p () (defun org-in-clocktable-p ()

View file

@ -1150,6 +1150,7 @@ PUB-DIR is set, use this as the publishing directory."
(language (plist-get opt-plist :language)) (language (plist-get opt-plist :language))
(keywords (plist-get opt-plist :keywords)) (keywords (plist-get opt-plist :keywords))
(description (plist-get opt-plist :description)) (description (plist-get opt-plist :description))
(num (plist-get opt-plist :section-numbers))
(lang-words nil) (lang-words nil)
(head-count 0) cnt (head-count 0) cnt
(start 0) (start 0)
@ -1355,7 +1356,7 @@ lang=\"%s\" xml:lang=\"%s\">
(if (string-match quote-re0 txt) (if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt))) (setq txt (replace-match "" t t txt)))
(setq snumber (org-section-number level)) (setq snumber (org-section-number level))
(if org-export-with-section-numbers (if (and num (integerp num) (>= num level))
(setq txt (concat snumber " " txt))) (setq txt (concat snumber " " txt)))
(if (<= level (max umax umax-toc)) (if (<= level (max umax umax-toc))
(setq head-count (+ head-count 1))) (setq head-count (+ head-count 1)))
@ -1591,7 +1592,7 @@ lang=\"%s\" xml:lang=\"%s\">
(setq first-heading-pos (or first-heading-pos (point))) (setq first-heading-pos (or first-heading-pos (point)))
(org-html-level-start level txt umax (org-html-level-start level txt umax
(and org-export-with-toc (<= level umax)) (and org-export-with-toc (<= level umax))
head-count) head-count opt-plist)
;; QUOTES ;; QUOTES
(when (string-match quote-re line) (when (string-match quote-re line)
@ -1684,15 +1685,18 @@ lang=\"%s\" xml:lang=\"%s\">
(org-html-level-start 1 nil umax (org-html-level-start 1 nil umax
(and org-export-with-toc (<= level umax)) (and org-export-with-toc (<= level umax))
head-count) head-count opt-plist)
;; the </div> to close the last text-... div. ;; the </div> to close the last text-... div.
(when (and (> umax 0) first-heading-pos) (insert "</div>\n")) (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t) (while (re-search-forward
(push (match-string 0) footnotes) "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)"
(replace-match "" t t))) nil t)
(push (match-string 1) footnotes)
(replace-match "\\4" t nil)
(goto-char (match-beginning 0))))
(when footnotes (when footnotes
(insert (format org-export-html-footnotes-section (insert (format org-export-html-footnotes-section
(nth 4 lang-words) (nth 4 lang-words)
@ -2330,7 +2334,7 @@ If there are links in the string, don't modify these."
(insert (if (equal type "d") "</dd>\n" "</li>\n"))) (insert (if (equal type "d") "</dd>\n" "</li>\n")))
(defvar body-only) ; dynamically scoped into this. (defvar body-only) ; dynamically scoped into this.
(defun org-html-level-start (level title umax with-toc head-count) (defun org-html-level-start (level title umax with-toc head-count &optional opt-plist)
"Insert a new level in HTML export. "Insert a new level in HTML export.
When TITLE is nil, just close all open levels." When TITLE is nil, just close all open levels."
(org-close-par-maybe) (org-close-par-maybe)
@ -2341,6 +2345,7 @@ When TITLE is nil, just close all open levels."
(preferred (and target (preferred (and target
(cdr (assoc target org-export-preferred-target-alist)))) (cdr (assoc target org-export-preferred-target-alist))))
(l org-level-max) (l org-level-max)
(num (plist-get opt-plist :section-numbers))
snumber snu href suffix) snumber snu href suffix)
(setq extra-targets (remove (or preferred target) extra-targets)) (setq extra-targets (remove (or preferred target) extra-targets))
(setq extra-targets (setq extra-targets
@ -2395,10 +2400,20 @@ When TITLE is nil, just close all open levels."
(setq snumber (org-section-number level) (setq snumber (org-section-number level)
snu (replace-regexp-in-string "\\." "_" snumber)) snu (replace-regexp-in-string "\\." "_" snumber))
(setq level (+ level org-export-html-toplevel-hlevel -1)) (setq level (+ level org-export-html-toplevel-hlevel -1))
(if (and org-export-with-section-numbers (not body-only)) (if (and num (not body-only))
(setq title (concat (setq title (concat
(format "<span class=\"section-number-%d\">%s</span>" (format "<span class=\"section-number-%d\">%s</span>"
level snumber) level
(if (and (integerp num)
;; fix up num to take into
;; account the top-level
;; heading value
(>= (+ num
org-export-html-toplevel-hlevel
-1)
level))
snumber
""))
" " title))) " " title)))
(unless (= head-count 1) (insert "\n</div>\n")) (unless (= head-count 1) (insert "\n</div>\n"))
(setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist)))

View file

@ -258,7 +258,7 @@ For example \orgTITLE for #+TITLE."
:type 'boolean) :type 'boolean)
(defcustom org-export-latex-date-format (defcustom org-export-latex-date-format
"%d %B %Y" "\\today"
"Format string for \\date{...}." "Format string for \\date{...}."
:group 'org-export-latex :group 'org-export-latex
:type 'string) :type 'string)
@ -1151,7 +1151,9 @@ and its content."
(defun org-export-latex-subcontent (subcontent num) (defun org-export-latex-subcontent (subcontent num)
"Export each cell of SUBCONTENT to LaTeX. "Export each cell of SUBCONTENT to LaTeX.
If NUM, export sections as numerical sections." If NUM is non-nil export numbered sections, otherwise use unnumbered
sections. If NUM is an integer, export the highest NUM levels as
numbered sections and lower levels as unnumbered sections."
(let* ((heading (cdr (assoc 'heading subcontent))) (let* ((heading (cdr (assoc 'heading subcontent)))
(level (- (cdr (assoc 'level subcontent)) (level (- (cdr (assoc 'level subcontent))
org-export-latex-add-level)) org-export-latex-add-level))
@ -1187,6 +1189,9 @@ If NUM, export sections as numerical sections."
;; Normal conversion ;; Normal conversion
((<= level depth) ((<= level depth)
(let* ((sec (nth (1- level) sectioning)) (let* ((sec (nth (1- level) sectioning))
(num (if (integerp num)
(>= num level)
num))
start end) start end)
(if (consp (cdr sec)) (if (consp (cdr sec))
(setq start (nth (if num 0 2) sec) (setq start (nth (if num 0 2) sec)
@ -2340,7 +2345,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER."
;; Protect LaTeX commands like \command[...]{...} or \command{...} ;; Protect LaTeX commands like \command[...]{...} or \command{...}
(goto-char (point-min)) (goto-char (point-min))
(let ((re (concat (let ((re (concat
"\\\\\\([a-zA-Z]+\\)" "\\\\\\([a-zA-Z]+\\*?\\)"
"\\(?:<[^<>\n]*>\\)*" "\\(?:<[^<>\n]*>\\)*"
"\\(?:\\[[^][\n]*?\\]\\)*" "\\(?:\\[[^][\n]*?\\]\\)*"
"\\(?:<[^<>\n]*>\\)*" "\\(?:<[^<>\n]*>\\)*"

View file

@ -81,14 +81,15 @@
(require 'org-macs) (require 'org-macs)
(require 'org-compat) (require 'org-compat)
(defvar org-blank-before-new-entry)
(defvar org-complex-heading-regexp)
(defvar org-description-max-indent)
(defvar org-drawer-regexp)
(defvar org-drawers)
(defvar org-M-RET-may-split-line) (defvar org-M-RET-may-split-line)
(defvar org-blank-before-new-entry)
(defvar org-clock-string)
(defvar org-closed-string)
(defvar org-deadline-string)
(defvar org-description-max-indent)
(defvar org-drawers)
(defvar org-odd-levels-only) (defvar org-odd-levels-only)
(defvar org-outline-regexp) (defvar org-scheduled-string)
(defvar org-ts-regexp) (defvar org-ts-regexp)
(defvar org-ts-regexp-both) (defvar org-ts-regexp-both)
@ -468,10 +469,10 @@ This checks `org-list-ending-method'."
(looking-at org-list-end-re)) (looking-at org-list-end-re))
(throw 'exit nil)) (throw 'exit nil))
;; Skip blocks, drawers, inline-tasks, blank lines ;; Skip blocks, drawers, inline-tasks, blank lines
((looking-at "^[ \t]*#\\+end_") ((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" nil t)) (re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((looking-at "^[ \t]*:END:") ((and (looking-at "^[ \t]*:END:")
(re-search-backward drawers-re nil t) (re-search-backward drawers-re lim-up t))
(beginning-of-line)) (beginning-of-line))
((and inlinetask-re (looking-at inlinetask-re)) ((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning) (org-inlinetask-goto-beginning)
@ -689,10 +690,10 @@ Assume point is at an item."
(memq (assq (car beg-cell) itm-lst) itm-lst)))) (memq (assq (car beg-cell) itm-lst) itm-lst))))
;; Skip blocks, drawers, inline tasks, blank lines ;; Skip blocks, drawers, inline tasks, blank lines
;; along the way. ;; along the way.
((looking-at "^[ \t]*#\\+end_") ((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" nil t)) (re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((looking-at "^[ \t]*:END:") ((and (looking-at "^[ \t]*:END:")
(re-search-backward drawers-re nil t) (re-search-backward drawers-re lim-up t))
(beginning-of-line)) (beginning-of-line))
((and inlinetask-re (looking-at inlinetask-re)) ((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning) (org-inlinetask-goto-beginning)
@ -756,11 +757,11 @@ Assume point is at an item."
(throw 'exit (push (cons 0 (point)) end-lst-2))) (throw 'exit (push (cons 0 (point)) end-lst-2)))
;; Skip blocks, drawers, inline tasks and blank lines ;; Skip blocks, drawers, inline tasks and blank lines
;; along the way ;; along the way
((looking-at "^[ \t]*#\\+begin_") ((and (looking-at "^[ \t]*#\\+begin_")
(re-search-forward "^[ \t]*#\\+end_") (re-search-forward "^[ \t]*#\\+end_" lim-down t))
(forward-line 1)) (forward-line 1))
((looking-at drawers-re) ((and (looking-at drawers-re)
(re-search-forward "^[ \t]*:END:" nil t) (re-search-forward "^[ \t]*:END:" lim-down t))
(forward-line 1)) (forward-line 1))
((and inlinetask-re (looking-at inlinetask-re)) ((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-end)) (org-inlinetask-goto-end))
@ -2073,6 +2074,14 @@ in subtree, ignoring drawers."
block-item block-item
lim-up lim-up
lim-down lim-down
(drawer-re (concat "^[ \t]*:\\("
(mapconcat 'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string
"\\|" org-deadline-string
"\\|" org-closed-string
"\\|" org-clock-string "\\)"
" *[[<]\\([^]>]+\\)[]>]"))
(orderedp (org-entry-get nil "ORDERED")) (orderedp (org-entry-get nil "ORDERED"))
(bounds (bounds
;; In a region, start at first item in region ;; In a region, start at first item in region
@ -2085,11 +2094,14 @@ in subtree, ignoring drawers."
(error "No item in region")) (error "No item in region"))
(setq lim-down (copy-marker limit)))) (setq lim-down (copy-marker limit))))
((org-on-heading-p) ((org-on-heading-p)
;; On an heading, start at first item after drawers ;; On an heading, start at first item after drawers and
;; time-stamps (scheduled, etc.)
(let ((limit (save-excursion (outline-next-heading) (point)))) (let ((limit (save-excursion (outline-next-heading) (point))))
(forward-line 1) (forward-line 1)
(when (looking-at org-drawer-regexp) (while (or (looking-at drawer-re) (looking-at keyword-re))
(re-search-forward "^[ \t]*:END:" limit nil)) (if (looking-at keyword-re)
(forward-line 1)
(re-search-forward "^[ \t]*:END:" limit nil)))
(if (org-list-search-forward (org-item-beginning-re) limit t) (if (org-list-search-forward (org-item-beginning-re) limit t)
(setq lim-up (point-at-bol)) (setq lim-up (point-at-bol))
(error "No item in subtree")) (error "No item in subtree"))

View file

@ -192,6 +192,7 @@ We use a macro so that the test can happen at compilation time."
;; remember which buffer to undo ;; remember which buffer to undo
(push (list _cmd _cline _buf1 _c1 _buf2 _c2) (push (list _cmd _cline _buf1 _c1 _buf2 _c2)
org-agenda-undo-list))))) org-agenda-undo-list)))))
(put 'org-with-remote-undo 'lisp-indent-function 1)
(defmacro org-no-read-only (&rest body) (defmacro org-no-read-only (&rest body)
"Inhibit read-only for BODY." "Inhibit read-only for BODY."

View file

@ -164,7 +164,6 @@ for `org-protocol-the-protocol' and sub-procols defined in
"Default protocols to use. "Default protocols to use.
See `org-protocol-protocol-alist' for a description of this variable.") See `org-protocol-protocol-alist' for a description of this variable.")
(defconst org-protocol-the-protocol "org-protocol" (defconst org-protocol-the-protocol "org-protocol"
"This is the protocol to detect if org-protocol.el is loaded. "This is the protocol to detect if org-protocol.el is loaded.
`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold `org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold
@ -172,11 +171,10 @@ the sub-protocols that trigger the required action. You will have to define
just one protocol handler OS-wide (MS-Windows) or per application (Linux). just one protocol handler OS-wide (MS-Windows) or per application (Linux).
That protocol handler should call emacsclient.") That protocol handler should call emacsclient.")
;;; User variables: ;;; User variables:
(defcustom org-protocol-reverse-list-of-files t (defcustom org-protocol-reverse-list-of-files t
"* Non-nil means re-reverse the list of filenames passed on the command line. "Non-nil means re-reverse the list of filenames passed on the command line.
The filenames passed on the command line are passed to the emacs-server in The filenames passed on the command line are passed to the emacs-server in
reverse order. Set to t (default) to re-reverse the list, i.e. use the reverse order. Set to t (default) to re-reverse the list, i.e. use the
sequence on the command line. If nil, the sequence of the filenames is sequence on the command line. If nil, the sequence of the filenames is
@ -184,9 +182,8 @@ unchanged."
:group 'org-protocol :group 'org-protocol
:type 'boolean) :type 'boolean)
(defcustom org-protocol-project-alist nil (defcustom org-protocol-project-alist nil
"* Map URLs to local filenames for `org-protocol-open-source' (open-source). "Map URLs to local filenames for `org-protocol-open-source' (open-source).
Each element of this list must be of the form: Each element of this list must be of the form:
@ -229,7 +226,6 @@ Consider using the interactive functions `org-protocol-create' and
:group 'org-protocol :group 'org-protocol
:type 'alist) :type 'alist)
(defcustom org-protocol-protocol-alist nil (defcustom org-protocol-protocol-alist nil
"* Register custom handlers for org-protocol. "* Register custom handlers for org-protocol.
@ -273,7 +269,9 @@ Here is an example:
:type '(alist)) :type '(alist))
(defcustom org-protocol-default-template-key nil (defcustom org-protocol-default-template-key nil
"The default org-remember-templates key to use." "The default template key to use.
This is usually a single character string but can also be a
string with two characters."
:group 'org-protocol :group 'org-protocol
:type 'string) :type 'string)
@ -287,14 +285,13 @@ Slashes are sanitized to double slashes here."
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
uri) uri)
(defun org-protocol-split-data (data &optional unhexify separator)
(defun org-protocol-split-data(data &optional unhexify separator) "Split what an org-protocol handler function gets as only argument.
"Split, what an org-protocol handler function gets as only argument. DATA is that one argument. DATA is split at each occurrence of
DATA is that one argument. DATA is split at each occurrence of SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
nil, assume \"/+\". The results of that splitting are returned nil, assume \"/+\". The results of that splitting are returned
as a list. If UNHEXIFY is non-nil, hex-decode each split part. If as a list. If UNHEXIFY is non-nil, hex-decode each split part.
UNHEXIFY is a function, use that function to decode each split If UNHEXIFY is a function, use that function to decode each split
part." part."
(let* ((sep (or separator "/+")) (let* ((sep (or separator "/+"))
(split-parts (split-string data sep))) (split-parts (split-string data sep)))
@ -306,9 +303,9 @@ part."
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
"Greedy handlers might receive a list like this from emacsclient: "Greedy handlers might receive a list like this from emacsclient:
'( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
where \"/dir/\" is the absolute path to emacsclients working directory. This where \"/dir/\" is the absolute path to emacsclients working directory. This
function transforms it into a flat list utilizing `org-protocol-flatten' and function transforms it into a flat list using `org-protocol-flatten' and
transforms the elements of that list as follows: transforms the elements of that list as follows:
If strip-path is non-nil, remove the \"/dir/\" prefix from all members of If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
@ -348,7 +345,6 @@ returned list."
ret) ret)
l))) l)))
(defun org-protocol-flatten (l) (defun org-protocol-flatten (l)
"Greedy handlers might receive a list like this from emacsclient: "Greedy handlers might receive a list like this from emacsclient:
'( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")
@ -359,6 +355,7 @@ This function transforms it into a flat list."
(append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
(list l)))) (list l))))
;;; Standard protocol handlers: ;;; Standard protocol handlers:
(defun org-protocol-store-link (fname) (defun org-protocol-store-link (fname)
@ -390,7 +387,7 @@ The sub-protocol used to reach this function is set in
uri)) uri))
nil) nil)
(defun org-protocol-remember (info) (defun org-protocol-remember (info)
"Process an org-protocol://remember:// style url. "Process an org-protocol://remember:// style url.
The location for a browser's bookmark has to look like this: The location for a browser's bookmark has to look like this:
@ -408,7 +405,7 @@ See the docs for `org-protocol-capture' for more information."
(message "Org-mode not loaded.")) (message "Org-mode not loaded."))
nil) nil)
(defun org-protocol-capture (info) (defun org-protocol-capture (info)
"Process an org-protocol://capture:// style url. "Process an org-protocol://capture:// style url.
The sub-protocol used to reach this function is set in The sub-protocol used to reach this function is set in
@ -439,12 +436,12 @@ Now template ?b will be used."
"Support `org-capture' and `org-remember' alike. "Support `org-capture' and `org-remember' alike.
CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'." CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(let* ((parts (org-protocol-split-data info t)) (let* ((parts (org-protocol-split-data info t))
(template (or (and (= 1 (length (car parts))) (pop parts)) (template (or (and (>= 2 (length (car parts))) (pop parts))
org-protocol-default-template-key)) org-protocol-default-template-key))
(url (org-protocol-sanitize-uri (car parts))) (url (org-protocol-sanitize-uri (car parts)))
(type (if (string-match "^\\([a-z]+\\):" url) (type (if (string-match "^\\([a-z]+\\):" url)
(match-string 1 url))) (match-string 1 url)))
(title(or (cadr parts) "")) (title (or (cadr parts) ""))
(region (or (caddr parts) "")) (region (or (caddr parts) ""))
(orglink (org-make-link-string (orglink (org-make-link-string
url (if (string-match "[^[:space:]]" title) title url))) url (if (string-match "[^[:space:]]" title) title url)))
@ -461,7 +458,6 @@ CAPTURE-FUNC is either the symbol `org-remember' or `org-capture'."
(raise-frame) (raise-frame)
(funcall capture-func nil template))) (funcall capture-func nil template)))
(defun org-protocol-open-source (fname) (defun org-protocol-open-source (fname)
"Process an org-protocol://open-source:// style url. "Process an org-protocol://open-source:// style url.
@ -472,7 +468,6 @@ The location for a browser's bookmark should look like this:
javascript:location.href='org-protocol://open-source://'+ \\ javascript:location.href='org-protocol://open-source://'+ \\
encodeURIComponent(location.href)" encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value ;; As we enter this function for a match on our protocol, the return value
;; defaults to nil. ;; defaults to nil.
(let ((result nil) (let ((result nil)
@ -541,12 +536,14 @@ function returns nil, the filename is removed from the list of filenames
passed from emacsclient to the server. passed from emacsclient to the server.
If the function returns a non nil value, that value is passed to the server If the function returns a non nil value, that value is passed to the server
as filename." as filename."
(let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) (let ((sub-protocols (append org-protocol-protocol-alist
org-protocol-protocol-alist-default)))
(catch 'fname (catch 'fname
(let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+")))
(when (string-match the-protocol fname) (when (string-match the-protocol fname)
(dolist (prolist sub-protocols) (dolist (prolist sub-protocols)
(let ((proto (concat the-protocol (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) (let ((proto (concat the-protocol
(regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
(when (string-match proto fname) (when (string-match proto fname)
(let* ((func (plist-get (cdr prolist) :function)) (let* ((func (plist-get (cdr prolist) :function))
(greedy (plist-get (cdr prolist) :greedy)) (greedy (plist-get (cdr prolist) :greedy))
@ -563,7 +560,6 @@ as filename."
;; (message "fname: %s" fname) ;; (message "fname: %s" fname)
fname))) fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate) (defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
"Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'."
(let ((flist (if org-protocol-reverse-list-of-files (let ((flist (if org-protocol-reverse-list-of-files
@ -572,16 +568,17 @@ as filename."
(client (ad-get-arg 1))) (client (ad-get-arg 1)))
(catch 'greedy (catch 'greedy
(dolist (var flist) (dolist (var flist)
(let ((fname (expand-file-name (car var)))) ;; `\' to `/' on windows. FIXME: could this be done any better? ;; `\' to `/' on windows. FIXME: could this be done any better?
(setq fname (org-protocol-check-filename-for-protocol fname (member var flist) client)) (let ((fname (expand-file-name (car var))))
(setq fname (org-protocol-check-filename-for-protocol
fname (member var flist) client))
(if (eq fname t) ;; greedy? We need the `t' return value. (if (eq fname t) ;; greedy? We need the `t' return value.
(progn (progn
(ad-set-arg 0 nil) (ad-set-arg 0 nil)
(throw 'greedy t)) (throw 'greedy t))
(if (stringp fname) ;; probably filename (if (stringp fname) ;; probably filename
(setcar var fname) (setcar var fname)
(ad-set-arg 0 (delq var (ad-get-arg 0)))))) (ad-set-arg 0 (delq var (ad-get-arg 0))))))))))
))))
;;; Org specific functions: ;;; Org specific functions:
@ -597,8 +594,7 @@ most of the work."
(message "Not in an org-project. Did mean %s?" (message "Not in an org-project. Did mean %s?"
(substitute-command-keys"\\[org-protocol-create]"))))) (substitute-command-keys"\\[org-protocol-create]")))))
(defun org-protocol-create (&optional project-plist)
(defun org-protocol-create(&optional project-plist)
"Create a new org-protocol project interactively. "Create a new org-protocol project interactively.
An org-protocol project is an entry in `org-protocol-project-alist' An org-protocol project is an entry in `org-protocol-project-alist'
which is used by `org-protocol-open-source'. which is used by `org-protocol-open-source'.
@ -606,15 +602,15 @@ Optionally use project-plist to initialize the defaults for this project. If
project-plist is the CDR of an element in `org-publish-project-alist', reuse project-plist is the CDR of an element in `org-publish-project-alist', reuse
:base-directory, :html-extension and :base-extension." :base-directory, :html-extension and :base-extension."
(interactive) (interactive)
(let ((working-dir (expand-file-name(or (plist-get project-plist :base-directory) default-directory))) (let ((working-dir (expand-file-name
(or (plist-get project-plist :base-directory)
default-directory)))
(base-url "http://orgmode.org/worg/") (base-url "http://orgmode.org/worg/")
(strip-suffix (or (plist-get project-plist :html-extension) ".html")) (strip-suffix (or (plist-get project-plist :html-extension) ".html"))
(working-suffix (if (plist-get project-plist :base-extension) (working-suffix (if (plist-get project-plist :base-extension)
(concat "." (plist-get project-plist :base-extension)) (concat "." (plist-get project-plist :base-extension))
".org")) ".org"))
(worglet-buffer nil) (worglet-buffer nil)
(insert-default-directory t) (insert-default-directory t)
(minibuffer-allow-text-properties nil)) (minibuffer-allow-text-properties nil))
@ -630,12 +626,12 @@ project-plist is the CDR of an element in `org-publish-project-alist', reuse
(setq strip-suffix (setq strip-suffix
(read-string (read-string
(concat "Extension to strip from published URLs ("strip-suffix"): ") (concat "Extension to strip from published URLs (" strip-suffix "): ")
strip-suffix nil strip-suffix t)) strip-suffix nil strip-suffix t))
(setq working-suffix (setq working-suffix
(read-string (read-string
(concat "Extension of editable files ("working-suffix"): ") (concat "Extension of editable files (" working-suffix "): ")
working-suffix nil working-suffix t)) working-suffix nil working-suffix t))
(when (yes-or-no-p "Save the new org-protocol-project to your init file? ") (when (yes-or-no-p "Save the new org-protocol-project to your init file? ")