contrapunctus
/
dotemacs
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

cp-copy-line-or-link - improve w/ org-link-ahead-p

This commit is contained in:
Kashish Sharma 2016-09-29 21:36:06 +05:30
parent 607b6ac8e3
commit c2ec5995fd
1 changed files with 44 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

79
init.el
View File

@ -263,11 +263,28 @@
(setq org-file-apps '(("\\.txt" . emacs)
(t . "xdg-open %s")))
(setq org-todo-keywords '((sequence "TODO" "STARTED" "DONE")))
(defun org-link-ahead-p (&optional link-type)
"Returns t if point is before an org-mode link, ignoring
whitespace and org-mode header and list syntax, else nil.
If LINK-TYPE is 'implicit, checks for an implicit link (one not
inside single or double brackets); otherwise, checks for links in
the form [[address][description]] and [[address]]."
(looking-at
(rx-to-string
`(and (zero-or-more "*")
(zero-or-more blank)
(optional
(or "- " "+ " "* "
(and (one-or-more (char "0-9"))
(or ". " ") "))))
,(if (eq link-type 'implicit)
"http" "[")))))
(defun cp-copy-line-or-link (prefix-arg)
"Copy address of org link after point, ignoring whitespace,
link description (if any) and org header and list syntax. If not
before link or with a prefix arg, call
`whole-line-or-region-kill-ring-save'."
"Copy address of org-mode link after point, ignoring whitespace,
link description (if any) and org-mode header and list syntax. If
not before a link, or with a prefix arg, call
`whole-line-or-region-kill-ring-save' instead."
(interactive "P")
(let ((point-a (point)))
(cl-flet ((copy-to-closing-bracket
@ -276,43 +293,35 @@ before link or with a prefix arg, call
(re-search-forward "\\]")
(copy-region-as-kill point-b
(- (point) 1)))))
(cl-macrolet ((before-link
(ending)
(append '(rx (zero-or-more "*")
(zero-or-more blank)
(optional
(or "- " "+ " "* "
(and (one-or-more (char "0-9"))
(or ". " ") ")))))
(list ending))))
(if (not prefix-arg)
(cond
((looking-at (before-link "["))
(search-forward "[")
(if (looking-at "\\[")
(forward-char))
(copy-to-closing-bracket)
(goto-char point-a))
((looking-at (before-link "http"))
(search-forward "http")
(backward-word)
(let ((point-b (point)))
(re-search-forward (rx (or eol (and printing " "))))
(copy-region-as-kill point-b
(- (point) 1)))
(goto-char point-a))
(if (or (use-region-p) prefix-arg)
(whole-line-or-region-kill-ring-save prefix-arg)
(t (whole-line-or-region-kill-ring-save prefix-arg)))
(cond ((org-link-ahead-p)
(search-forward "[")
(if (looking-at "\\[")
(forward-char))
(copy-to-closing-bracket)
(goto-char point-a))
;; TODO - org-previous-link will land you at the start of
;; the DESCRIPTION of the previous link, if it has one,
;; but to the user it will look like they are at the start
;; of the link. Add a case to handle this.
((org-link-ahead-p 'implicit)
(search-forward "http")
(backward-word)
(let ((point-b (point)))
(re-search-forward (rx (or eol (and printing " "))))
(copy-region-as-kill point-b
(point)))
(goto-char point-a))
(whole-line-or-region-kill-ring-save prefix-arg)))))))
;; TODO - org-previous-link will land you at the start
;; of the DESCRIPTION of the previous link, if it has
;; one, but to the user it will look like they are at
;; the start of the link. Add a case to handle this.
;; Does not work if there is an org TODO marker in a
;; header.
(t (whole-line-or-region-kill-ring-save prefix-arg))))))))
(require 'ace-jump-mode)
;(define-key global-map (kbd "C-c SPC") 'ace-jump-mode)