ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use new macro `org-with-gensyms' 

* org-macs.el (org-preserve-lc, org-with-point-at)
(org-with-remote-undo, org-save-outline-visibility): Use new macro
`org-with-gensyms'.
This commit is contained in:
David Maus 2011-08-10 07:33:43 +02:00
parent 4fe8369dae
commit 79605a9007
1 changed files with 47 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
lisp/org-macs.el
View File

@ -110,12 +110,13 @@ Also, do not record undo information."
s)) s))
(defmacro org-preserve-lc (&rest body) (defmacro org-preserve-lc (&rest body)
`(let ((_line (org-current-line)) (org-with-gensyms (line col)
(_col (current-column))) `(let ((,line (org-current-line))
(unwind-protect (,col (current-column)))
(progn ,@body) (unwind-protect
(org-goto-line _line) (progn ,@body)
(org-move-to-column _col)))) (org-goto-line ,line)
(org-move-to-column ,col)))))
(defmacro org-without-partial-completion (&rest body) (defmacro org-without-partial-completion (&rest body)
`(if (and (boundp 'partial-completion-mode) `(if (and (boundp 'partial-completion-mode)
@ -142,12 +143,13 @@ We use a macro so that the test can happen at compilation time."
(defmacro org-with-point-at (pom &rest body) (defmacro org-with-point-at (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY." "Move to buffer and point of point-or-marker POM for the duration of BODY."
`(let ((pom ,pom)) (org-with-gensyms (mpom)
(save-excursion `(let ((,mpom ,pom))
(if (markerp pom) (set-buffer (marker-buffer pom)))
(save-excursion (save-excursion
(goto-char (or pom (point))) (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
,@body)))) (save-excursion
(goto-char (or ,mpom (point)))
,@body)))))
(put 'org-with-point-at 'lisp-indent-function 1) (put 'org-with-point-at 'lisp-indent-function 1)
(defmacro org-no-warnings (&rest body) (defmacro org-no-warnings (&rest body)
@ -180,26 +182,27 @@ We use a macro so that the test can happen at compilation time."
(defmacro org-with-remote-undo (_buffer &rest _body) (defmacro org-with-remote-undo (_buffer &rest _body)
"Execute BODY while recording undo information in two buffers." "Execute BODY while recording undo information in two buffers."
`(let ((_cline (org-current-line)) (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2)
(_cmd this-command) `(let ((,cline (org-current-line))
(_buf1 (current-buffer)) (,cmd this-command)
(_buf2 ,_buffer) (,buf1 (current-buffer))
(_undo1 buffer-undo-list) (,buf2 ,_buffer)
(_undo2 (with-current-buffer ,_buffer buffer-undo-list)) (,undo1 buffer-undo-list)
_c1 _c2) (,undo2 (with-current-buffer ,_buffer buffer-undo-list))
,@_body ,c1 ,c2)
(when org-agenda-allow-remote-undo ,@_body
(setq _c1 (org-verify-change-for-undo (when org-agenda-allow-remote-undo
_undo1 (with-current-buffer _buf1 buffer-undo-list)) (setq ,c1 (org-verify-change-for-undo
_c2 (org-verify-change-for-undo ,undo1 (with-current-buffer ,buf1 buffer-undo-list))
_undo2 (with-current-buffer _buf2 buffer-undo-list))) ,c2 (org-verify-change-for-undo
(when (or _c1 _c2) ,undo2 (with-current-buffer ,buf2 buffer-undo-list)))
;; make sure there are undo boundaries (when (or ,c1 ,c2)
(and _c1 (with-current-buffer _buf1 (undo-boundary))) ;; make sure there are undo boundaries
(and _c2 (with-current-buffer _buf2 (undo-boundary))) (and ,c1 (with-current-buffer ,buf1 (undo-boundary)))
;; remember which buffer to undo (and ,c2 (with-current-buffer ,buf2 (undo-boundary)))
(push (list _cmd _cline _buf1 _c1 _buf2 _c2) ;; remember which buffer to undo
org-agenda-undo-list))))) (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2)
org-agenda-undo-list))))))
(put 'org-with-remote-undo 'lisp-indent-function 1) (put 'org-with-remote-undo 'lisp-indent-function 1)
(defmacro org-no-read-only (&rest body) (defmacro org-no-read-only (&rest body)
@ -331,18 +334,19 @@ but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will during the operation, because otherwise all these markers will
point nowhere." point nowhere."
(declare (indent 1)) (declare (indent 1))
`(let ((data (org-outline-overlay-data ,use-markers)) (org-with-gensyms (data rtn)
rtn) `(let ((,data (org-outline-overlay-data ,use-markers))
(unwind-protect ,rtn)
(progn (unwind-protect
(setq rtn (progn ,@body)) (progn
(org-set-outline-overlay-data data)) (setq ,rtn (progn ,@body))
(when ,use-markers (org-set-outline-overlay-data ,data))
(mapc (lambda (c) (when ,use-markers
(and (markerp (car c)) (move-marker (car c) nil)) (mapc (lambda (c)
(and (markerp (cdr c)) (move-marker (cdr c) nil))) (and (markerp (car c)) (move-marker (car c) nil))
data))) (and (markerp (cdr c)) (move-marker (cdr c) nil)))
rtn)) ,data)))
,rtn)))
(defmacro org-with-wide-buffer (&rest body) (defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer." "Execute body while temporarily widening the buffer."