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

Move rx calls to local macro

This commit is contained in:
Kashish Sharma 2016-08-05 14:11:46 +05:30
parent 9a24c989c1
commit 21af74d552
1 changed files with 36 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

81
init.el
View File

@ -262,9 +262,10 @@
(t . "xdg-open %s")))
(setq org-todo-keywords '((sequence "TODO" "STARTED" "DONE")))
(defun cp-copy-line-or-link (prefix-arg)
"If current line only contains (excluding whitespace) an
org-format link, copy the address (not the description) of the
link. Otherwise, call `whole-line-or-region-kill-ring-save'."
"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'."
(interactive "P")
(let ((point-a (point)))
(cl-flet ((copy-to-closing-bracket
@ -273,52 +274,42 @@ link. Otherwise, call `whole-line-or-region-kill-ring-save'."
(re-search-forward "\\]")
(copy-region-as-kill point-b
(- (point) 1)))))
(if (not prefix-arg)
(cond
((looking-at
(rx (zero-or-more "*")
(zero-or-more blank)
(optional
(or "- " "+ " "* "
(and (one-or-more (char "0-9"))
(or ". " ") "))))
"["))
(search-forward "[")
(if (looking-at "\\[")
(forward-char))
(copy-to-closing-bracket)
(goto-char point-a))
(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
(rx (zero-or-more "*")
(zero-or-more blank)
(optional
(or "- " "+ " "* "
(and (one-or-more (char "0-9"))
(or ". " ") "))))
"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))
((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))
(t ;; (progn
;; (goto-char point-a)
;; (whole-line-or-region-kill-ring-save prefix-arg))
(whole-line-or-region-kill-ring-save prefix-arg)))
(t (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.
;; 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.
(whole-line-or-region-kill-ring-save prefix-arg)))))))
;; (progn
;; (goto-char point-a)
;; (whole-line-or-region-kill-ring-save prefix-arg))
(whole-line-or-region-kill-ring-save prefix-arg))))))
(require 'ace-jump-mode)