summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2013-03-19 13:05:36 +0100
committerBastien Guerry <bzg@altern.org>2013-03-19 19:39:12 +0100
commitecb9e5811d662abe76e41b21ec4e77259f55748f (patch)
treebec0cf5827eb2ca1c1d6f1ea289390f13f69e2ae
parent00e8ef22f20f17befb0e0ad67f3a0a7715bb4372 (diff)
downloadorg-mode-ecb9e5811d662abe76e41b21ec4e77259f55748f.tar.gz
org.el (org-store-link): Store each line of the active as a separate link
* org.el (org-store-link): When there is an active region, store each line as a separate link. (org-insert-all-links): Use a default description when links do not have one already. * org-agenda.el (org-agenda-redo): Fix typo in code.
-rw-r--r--lisp/org-agenda.el7
-rw-r--r--lisp/org.el389
2 files changed, 204 insertions, 192 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 418c636..ecfc01e 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3794,7 +3794,7 @@ generating a new one."
(defun org-agenda-dim-blocked-tasks (&optional invisible)
"Dim currently blocked TODO's in the agenda display."
(interactive "P")
- (when (org-called-interactively-p 'any)
+ (when (org-called-interactively-p 'interactive)
(message "Dim or hide blocked tasks..."))
(mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
(delete-overlay o)))
@@ -3825,7 +3825,8 @@ generating a new one."
(overlay-put ov 'invisible t)
(overlay-put ov 'face 'org-agenda-dimmed-todo-face))
(overlay-put ov 'org-type 'org-blocked-todo))))))
- (message "Dim or hide blocked tasks...done"))
+ (when (org-called-interactively-p 'interactive)
+ (message "Dim or hide blocked tasks...done")))
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
@@ -7195,7 +7196,7 @@ in the agenda."
(cat-filter org-agenda-category-filter)
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(re-filter org-agenda-regexp-filter)
- (re-preset (get 'org-agenda-category-filter :preset-filter))
+ (re-preset (get 'org-agenda-regexp-filter :preset-filter))
(org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
diff --git a/lisp/org.el b/lisp/org.el
index 5f37f48..0e2efdc 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -9220,7 +9220,7 @@ type. For a simple example of an export function, see `org-bbdb.el'."
(defvar org-id-link-to-org-use-id) ; Defined in org-id.el
;;;###autoload
-(defun org-store-link (arg)
+(defun org-store-link (arg &optional ignore-region)
"\\<org-mode-map>Store an org-link to the current location.
This link is added to `org-stored-links' and can later be inserted
into an org-buffer with \\[org-insert-link].
@@ -9230,202 +9230,213 @@ For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
For file links, arg negates `org-context-in-file-links'.
A double prefix arg force skipping storing functions that are not
-part of Org's core."
+part of Org's core.
+
+When the region is active and IGNORE-REGION is nil, store each line
+in the region as a separate link."
(interactive "P")
(org-load-modules-maybe)
(setq org-store-link-plist nil) ; reset
- (org-with-limited-levels
- (let (link cpltxt desc description search txt custom-id agenda-link sfuns sfunsn)
- (cond
- ((and (not (equal arg '(16)))
- (setq sfuns
- (delq
- nil (mapcar (lambda (f) (let (fs) (if (funcall f) (push f fs))))
- org-store-link-functions))
- sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
- (or (and (cdr sfuns)
- (funcall (intern
- (completing-read "Which function for creating the link? "
- sfunsn t (car sfunsn)))))
- (funcall (caar sfuns)))
- (setq link (plist-get org-store-link-plist :link)
- desc (or (plist-get org-store-link-plist :description) link))))
- ((org-src-edit-buffer-p)
- (let (label gc)
- (while (or (not label)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward
- (regexp-quote (format org-coderef-label-format label))
- nil t))))
- (when label (message "Label exists already") (sit-for 2))
- (setq label (read-string "Code line label: " label)))
- (end-of-line 1)
- (setq link (format org-coderef-label-format label))
- (setq gc (- 79 (length link)))
- (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
- (insert link)
- (setq link (concat "(" label ")") desc nil)))
-
- ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
- ;; We are in the agenda, link to referenced location
- (let ((m (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-marker))))
- (when m
- (org-with-point-at m
- (setq agenda-link
- (if (org-called-interactively-p 'any)
- (call-interactively 'org-store-link)
- (org-store-link nil)))))))
-
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
- (org-store-link-props :type "calendar" :date cd)))
-
- ((eq major-mode 'help-mode)
- (setq link (concat "help:" (save-excursion
- (goto-char (point-min))
- (looking-at "^[^ ]+")
- (match-string 0))))
- (org-store-link-props :type "help"))
-
- ((eq major-mode 'w3-mode)
- (setq cpltxt (if (and (buffer-name)
- (not (string-match "Untitled" (buffer-name))))
- (buffer-name)
- (url-view-url t))
- link (url-view-url t))
- (org-store-link-props :type "w3" :url (url-view-url t)))
-
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or description link)))
-
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
- (org-store-link-props :type "image" :file buffer-file-name))
-
- ((eq major-mode 'dired-mode)
- ;; link to the file in the current line
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
-
- ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
- (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (if (and (org-region-active-p) (not ignore-region))
+ (save-excursion
+ (let ((beg (region-beginning)) (end (region-end)))
+ (goto-char beg)
+ (while (< (point-at-eol) end)
+ (funcall 'org-store-link arg t)
+ (move-beginning-of-line 2))))
+ (org-with-limited-levels
+ (let (link cpltxt desc description search txt custom-id agenda-link sfuns sfunsn)
(cond
- ((org-in-regexp "<<\\(.*?\\)>>")
- (setq cpltxt
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::" (match-string 1))
- link cpltxt))
- ((and (featurep 'org-id)
- (or (eq org-id-link-to-org-use-id t)
- (and (org-called-interactively-p 'any)
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (not custom-id))))
- (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
- ;; We can make a link using the ID.
- (setq link (condition-case nil
- (prog1 (org-id-store-link)
- (setq desc (plist-get org-store-link-plist :description)))
- (error
- ;; probably before first headline, link to file only
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
- ;; Just link to current headline
+ ((and (not (equal arg '(16)))
+ (setq sfuns
+ (delq
+ nil (mapcar (lambda (f) (let (fs) (if (funcall f) (push f fs))))
+ org-store-link-functions))
+ sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
+ (or (and (cdr sfuns)
+ (funcall (intern
+ (completing-read "Which function for creating the link? "
+ sfunsn t (car sfunsn)))))
+ (funcall (caar sfuns)))
+ (setq link (plist-get org-store-link-plist :link)
+ desc (or (plist-get org-store-link-plist :description) link))))
+ ((org-src-edit-buffer-p)
+ (let (label gc)
+ (while (or (not label)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward
+ (regexp-quote (format org-coderef-label-format label))
+ nil t))))
+ (when label (message "Label exists already") (sit-for 2))
+ (setq label (read-string "Code line label: " label)))
+ (end-of-line 1)
+ (setq link (format org-coderef-label-format label))
+ (setq gc (- 79 (length link)))
+ (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
+ (insert link)
+ (setq link (concat "(" label ")") desc nil)))
+
+ ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ ;; We are in the agenda, link to referenced location
+ (let ((m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker))))
+ (when m
+ (org-with-point-at m
+ (setq agenda-link
+ (if (org-called-interactively-p 'any)
+ (call-interactively 'org-store-link)
+ (org-store-link nil)))))))
+
+ ((eq major-mode 'calendar-mode)
+ (let ((cd (calendar-cursor-to-date)))
+ (setq link
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time
+ (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
+ nil nil nil))))
+ (org-store-link-props :type "calendar" :date cd)))
+
+ ((eq major-mode 'help-mode)
+ (setq link (concat "help:" (save-excursion
+ (goto-char (point-min))
+ (looking-at "^[^ ]+")
+ (match-string 0))))
+ (org-store-link-props :type "help"))
+
+ ((eq major-mode 'w3-mode)
+ (setq cpltxt (if (and (buffer-name)
+ (not (string-match "Untitled" (buffer-name))))
+ (buffer-name)
+ (url-view-url t))
+ link (url-view-url t))
+ (org-store-link-props :type "w3" :url (url-view-url t)))
+
+ ((setq search (run-hook-with-args-until-success
+ 'org-create-file-search-functions))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (setq cpltxt (or description link)))
+
+ ((eq major-mode 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link cpltxt)
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ((eq major-mode 'dired-mode)
+ ;; link to the file in the current line
+ (let ((file (dired-get-filename nil t)))
+ (setq file (if file
+ (abbreviate-file-name
+ (expand-file-name (dired-get-filename nil t)))
+ ;; otherwise, no file so use current directory.
+ default-directory))
+ (setq cpltxt (concat "file:" file)
+ link cpltxt)))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (setq custom-id (org-entry-get nil "CUSTOM_ID"))
+ (cond
+ ((org-in-regexp "<<\\(.*?\\)>>")
+ (setq cpltxt
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))
+ "::" (match-string 1))
+ link cpltxt))
+ ((and (featurep 'org-id)
+ (or (eq org-id-link-to-org-use-id t)
+ (and (org-called-interactively-p 'any)
+ (or (eq org-id-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-id-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not custom-id))))
+ (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
+ ;; We can make a link using the ID.
+ (setq link (condition-case nil
+ (prog1 (org-id-store-link)
+ (setq desc (plist-get org-store-link-plist :description)))
+ (error
+ ;; probably before first headline, link to file only
+ (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer))))))))
+ (t
+ ;; Just link to current headline
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context search string
+ (when (org-xor org-context-in-file-links arg)
+ (let* ((ee (org-element-at-point))
+ (et (org-element-type ee))
+ (ev (plist-get (cadr ee) :value)))
+ (setq txt (cond
+ ((org-at-heading-p) nil)
+ ((eq et 'keyword) ev)
+ ((org-region-active-p)
+ (buffer-substring (region-beginning) (region-end)))))
+ (when (or (null txt) (string-match "\\S-" txt))
+ (setq cpltxt
+ (concat cpltxt "::"
+ (condition-case nil
+ (org-make-org-heading-search-string txt)
+ (error "")))
+ desc (or (and (eq et 'keyword) ev)
+ (nth 4 (ignore-errors (org-heading-components)))
+ "NONE")))))
+ (if (string-match "::\\'" cpltxt)
+ (setq cpltxt (substring cpltxt 0 -2)))
+ (setq link cpltxt))))
+
+ ((buffer-file-name (buffer-base-buffer))
+ ;; Just link to this file here.
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string
+ ;; Add a context string
(when (org-xor org-context-in-file-links arg)
- (let* ((ee (org-element-at-point))
- (et (org-element-type ee))
- (ev (plist-get (cadr ee) :value)))
- (setq txt (cond
- ((org-at-heading-p) nil)
- ((eq et 'keyword) ev)
- ((org-region-active-p)
- (buffer-substring (region-beginning) (region-end)))))
- (when (or (null txt) (string-match "\\S-" txt))
- (setq cpltxt
- (concat cpltxt "::"
- (condition-case nil
- (org-make-org-heading-search-string txt)
- (error "")))
- desc (or (and (eq et 'keyword) ev)
- (nth 4 (ignore-errors (org-heading-components)))
- "NONE")))))
- (if (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
- (setq link cpltxt))))
-
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string
- (when (org-xor org-context-in-file-links arg)
- (setq txt (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))
- (buffer-substring (point-at-bol) (point-at-eol))))
- ;; Only use search option if there is some text.
- (when (string-match "\\S-" txt)
- (setq cpltxt
- (concat cpltxt "::" (org-make-org-heading-search-string txt))
- desc "NONE")))
- (setq link cpltxt))
-
- ((org-called-interactively-p 'interactive)
- (user-error "No method for storing a link from this buffer"))
-
- (t (setq link nil)))
-
- (if (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
- (cond ((equal desc "NONE") (setq desc nil))
- ((string-match org-bracket-link-regexp desc)
- (setq desc (replace-regexp-in-string
- org-bracket-link-regexp
- (concat "\\3" (if (equal (length (match-string 0 desc))
- (length desc)) "*" "")) desc))))
-
- (if (and (or (org-called-interactively-p 'any) executing-kbd-macro) link)
- (progn
- (setq org-stored-links
- (cons (list link desc) org-stored-links))
- (message "Stored: %s" (or desc link))
- (when custom-id
- (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
- "::#" custom-id))
+ (setq txt (if (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))
+ (buffer-substring (point-at-bol) (point-at-eol))))
+ ;; Only use search option if there is some text.
+ (when (string-match "\\S-" txt)
+ (setq cpltxt
+ (concat cpltxt "::" (org-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link cpltxt))
+
+ ((org-called-interactively-p 'interactive)
+ (user-error "No method for storing a link from this buffer"))
+
+ (t (setq link nil)))
+
+ (if (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (cond ((equal desc "NONE") (setq desc nil))
+ ((string-match org-bracket-link-regexp desc)
+ (setq desc (replace-regexp-in-string
+ org-bracket-link-regexp
+ (concat "\\3" (if (equal (length (match-string 0 desc))
+ (length desc)) "*" "")) desc))))
+
+ (if (and (or (org-called-interactively-p 'any)
+ executing-kbd-macro ignore-region) link)
+ (progn
(setq org-stored-links
- (cons (list link desc) org-stored-links))))
- (or agenda-link (and link (org-make-link-string link desc)))))))
+ (cons (list link desc) org-stored-links))
+ (message "Stored: %s" (or desc link))
+ (when custom-id
+ (setq link (concat "file:" (abbreviate-file-name (buffer-file-name))
+ "::#" custom-id))
+ (setq org-stored-links
+ (cons (list link desc) org-stored-links))))
+ (or agenda-link (and link (org-make-link-string link desc))))))))
(defun org-store-link-props (&rest plist)
"Store link properties, extract names and addresses."
@@ -9661,7 +9672,7 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(let ((links (copy-sequence org-stored-links)) l)
(while (setq l (if keep (pop links) (pop org-stored-links)))
(insert "- ")
- (org-insert-link nil (car l) (cadr l))
+ (org-insert-link nil (car l) (or (cadr l) "<no description>"))
(insert "\n"))))
(defun org-link-fontify-links-to-this-file ()