org-src: Allow to edit inline footnote references

* lisp/org-src.el (org-src--edit-element): Do not rely on :value to
  extract contents.  Small refactoring.
(org-src--contents-area): Renamed from
  `org-src--element-contents-area'.  Throw an error on unknown
  elements.
(org-src--on-datum-p): Rename from `org-src--on-element-p'.  Handle
objects.
(org-edit-export-block, org-edit-src-code,
org-edit-fixed-width-region, org-edit-table.el): Apply renaming.
(org-edit-src-save, org-edit-src-exit): Handle inline text.
(org-edit-src-exit): Allow empty or blank code.  Handle inline text.
(org-src--edit-element): Rename an argument
(org-edit-footnote-reference): Allow to edit inline definitions.

* etc/ORG-NEWS: Document new feature.
This commit is contained in:
Nicolas Goaziou 2015-05-02 08:37:37 +02:00
parent f8d1d373fc
commit 9e52d2ed01
2 changed files with 106 additions and 81 deletions

View File

@ -367,7 +367,7 @@ Org can typeset a subtitle in some export backends. See the manual
for details. for details.
*** Edit remotely a footnote definition *** Edit remotely a footnote definition
Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference
allows to edit its definition, as long as it is not inline, in allows to edit its definition, as long as it is not anonymous, in
a dedicated buffer. It works even if buffer is currently narrowed. a dedicated buffer. It works even if buffer is currently narrowed.
** Miscellaneous ** Miscellaneous
*** Strip all meta data from ITEM special property *** Strip all meta data from ITEM special property

View File

@ -266,34 +266,35 @@ which see. BEG and END are buffer positions."
(org-move-to-column (max (+ (current-column) (cdr coord)) 0)) (org-move-to-column (max (+ (current-column) (cdr coord)) 0))
(point))))) (point)))))
(defun org-src--element-contents-area (element) (defun org-src--contents-area (datum)
"Return contents boundaries of ELEMENT. "Return contents boundaries of DATUM.
Return value is a pair (BEG . END) where BEG and END are buffer DATUM is an element or object. Return a pair (BEG . END) where
positions." BEG and END are buffer positions."
(let ((type (org-element-type element))) (let ((type (org-element-type datum)))
(cond (cond
((eq type 'footnote-definition) ((eq type 'footnote-definition)
(let ((beg (org-with-wide-buffer (let ((beg (org-with-wide-buffer
(goto-char (org-element-property :post-affiliated element)) (goto-char (org-element-property :post-affiliated datum))
(search-forward "]")))) (search-forward "]"))))
(cons beg (or (org-element-property :contents-end element) beg)))) (cons beg (or (org-element-property :contents-end datum) beg))))
((org-element-property :contents-begin element) ((org-element-property :contents-begin datum)
(cons (org-element-property :contents-begin element) (cons (org-element-property :contents-begin datum)
(org-element-property :contents-end element))) (org-element-property :contents-end datum)))
((memq type '(example-block export-block src-block)) ((memq type '(example-block export-block src-block))
(cons (org-with-wide-buffer (cons (org-with-wide-buffer
(goto-char (org-element-property :post-affiliated element)) (goto-char (org-element-property :post-affiliated datum))
(line-beginning-position 2)) (line-beginning-position 2))
(org-with-wide-buffer (org-with-wide-buffer
(goto-char (org-element-property :end element)) (goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
(line-beginning-position 1)))) (line-beginning-position 1))))
(t ((memq type '(fixed-width table))
(cons (org-element-property :post-affiliated element) (cons (org-element-property :post-affiliated datum)
(org-with-wide-buffer (org-with-wide-buffer
(goto-char (org-element-property :end element)) (goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
(line-beginning-position 2))))))) (line-beginning-position 2))))
(t (error "Unsupported element or object: %s" type)))))
(defun org-src--make-source-overlay (beg end edit-buffer) (defun org-src--make-source-overlay (beg end edit-buffer)
"Create overlay between BEG and END positions and return it. "Create overlay between BEG and END positions and return it.
@ -323,14 +324,18 @@ END."
"Remove overlay from current source buffer." "Remove overlay from current source buffer."
(when (overlayp org-src--overlay) (delete-overlay org-src--overlay))) (when (overlayp org-src--overlay) (delete-overlay org-src--overlay)))
(defun org-src--on-element-p (element) (defun org-src--on-datum-p (datum)
"Non-nil when point is on ELEMENT." "Non-nil when point is on DATUM.
(and (>= (point) (org-element-property :begin element)) DATUM is an element or an object. Consider blank lines or white
spaces after it as being outside."
(and (>= (point) (org-element-property :begin datum))
(<= (point) (<= (point)
(org-with-wide-buffer (org-with-wide-buffer
(goto-char (org-element-property :end element)) (goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n") (skip-chars-backward " \r\t\n")
(line-end-position))))) (if (memq (org-element-type datum) org-element-all-elements)
(line-end-position)
(point))))))
(defun org-src--contents-for-write-back () (defun org-src--contents-for-write-back ()
"Return buffer contents in a format appropriate for write back. "Return buffer contents in a format appropriate for write back.
@ -352,28 +357,30 @@ Assume point is in the corresponding edit buffer."
(buffer-string)))) (buffer-string))))
(defun org-src--edit-element (defun org-src--edit-element
(element name &optional major write-back contents remote) (datum name &optional major write-back contents remote)
"Edit ELEMENT contents in a dedicated buffer NAME. "Edit DATUM contents in a dedicated buffer NAME.
MAJOR is the major mode used in the edit buffer. A nil value is MAJOR is the major mode used in the edit buffer. A nil value is
equivalent to `fundamental-mode'. equivalent to `fundamental-mode'.
When WRITE-BACK is non-nil, assume contents will replace original When WRITE-BACK is non-nil, assume contents will replace original
region. If it is a function, applied in the edit buffer, from region. Moreover, if it is a function, apply it in the edit
point min, before returning the contents. buffer, from point min, before returning the contents.
When CONTENTS is non-nil, display them in the edit buffer. When CONTENTS is non-nil, display them in the edit buffer.
Otherwise, assume they are located in property `:value'. Otherwise, show DATUM contents as specified by
`org-src--contents-area'.
When REMOTE is non-nil, do not try to preserve point or mark when When REMOTE is non-nil, do not try to preserve point or mark when
moving from the edit area to the source. moving from the edit area to the source.
Leave point in edit buffer." Leave point in edit buffer."
(setq org-src--saved-temp-window-config (current-window-configuration)) (setq org-src--saved-temp-window-config (current-window-configuration))
(let* ((area (org-src--element-contents-area element)) (let* ((area (org-src--contents-area datum))
(beg (copy-marker (car area))) (beg (copy-marker (car area)))
(end (copy-marker (cdr area) t)) (end (copy-marker (cdr area) t))
(old-edit-buffer (org-src--edit-buffer beg end))) (old-edit-buffer (org-src--edit-buffer beg end))
(contents (or contents (buffer-substring-no-properties beg end))))
(if (and old-edit-buffer (if (and old-edit-buffer
(or (not org-src-ask-before-returning-to-edit-buffer) (or (not org-src-ask-before-returning-to-edit-buffer)
(y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))) (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")))
@ -384,13 +391,13 @@ Leave point in edit buffer."
(with-current-buffer old-edit-buffer (org-src--remove-overlay)) (with-current-buffer old-edit-buffer (org-src--remove-overlay))
(kill-buffer old-edit-buffer)) (kill-buffer old-edit-buffer))
(let* ((org-mode-p (derived-mode-p 'org-mode)) (let* ((org-mode-p (derived-mode-p 'org-mode))
(type (org-element-type element)) (type (org-element-type datum))
(ind (org-with-wide-buffer (ind (org-with-wide-buffer
(goto-char (org-element-property :begin element)) (goto-char (org-element-property :begin datum))
(org-get-indentation))) (org-get-indentation)))
(preserve-ind (preserve-ind
(and (memq type '(example-block src-block)) (and (memq type '(example-block src-block))
(or (org-element-property :preserve-indent element) (or (org-element-property :preserve-indent datum)
org-src-preserve-indentation))) org-src-preserve-indentation)))
;; Store relative positions of mark (if any) and point ;; Store relative positions of mark (if any) and point
;; within the edited area. ;; within the edited area.
@ -408,7 +415,7 @@ Leave point in edit buffer."
;; Switch to edit buffer. ;; Switch to edit buffer.
(org-src-switch-to-buffer buffer 'edit) (org-src-switch-to-buffer buffer 'edit)
;; Insert contents. ;; Insert contents.
(insert (or contents (org-element-property :value element))) (insert contents)
(remove-text-properties (point-min) (point-max) (remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil)) '(display nil invisible nil intangible nil))
(unless preserve-ind (org-do-remove-indentation)) (unless preserve-ind (org-do-remove-indentation))
@ -435,17 +442,21 @@ Leave point in edit buffer."
(org-src-mode) (org-src-mode)
;; Move mark and point in edit buffer to the corresponding ;; Move mark and point in edit buffer to the corresponding
;; location. ;; location.
(if remote
(progn
;; Put point at first non read-only character after
;; leading blank.
(goto-char
(or (text-property-any (point-min) (point-max) 'read-only nil)
(point-max)))
(skip-chars-forward " \r\t\n"))
;; Set mark and point.
(when mark-coordinates (when mark-coordinates
(org-src--goto-coordinates mark-coordinates (point-min) (point-max)) (org-src--goto-coordinates mark-coordinates (point-min) (point-max))
(push-mark (point) 'no-message t) (push-mark (point) 'no-message t)
(setq deactivate-mark nil)) (setq deactivate-mark nil))
(if (not remote)
(org-src--goto-coordinates (org-src--goto-coordinates
point-coordinates (point-min) (point-max)) point-coordinates (point-min) (point-max)))))))
(goto-char (or (text-property-any
(point-min) (point-max) 'read-only nil)
(point-max)))
(skip-chars-forward " \r\t\n"))))))
@ -679,39 +690,52 @@ If BUFFER is non-nil, test it instead."
(defun org-edit-footnote-reference () (defun org-edit-footnote-reference ()
"Edit definition of footnote reference at point." "Edit definition of footnote reference at point."
(interactive) (interactive)
(let ((context (org-element-context))) (let* ((context (org-element-context))
(label (org-element-property :label context)))
(unless (and (eq (org-element-type context) 'footnote-reference) (unless (and (eq (org-element-type context) 'footnote-reference)
(< (point) (org-src--on-datum-p context))
(org-with-wide-buffer
(goto-char (org-element-property :end context))
(skip-chars-backward " \t")
(point))))
(user-error "Not on a footnote reference")) (user-error "Not on a footnote reference"))
(let* ((label (org-element-property :label context)) (unless label (user-error "Cannot edit remotely anonymous footnotes"))
(definition (let* ((definition (org-with-wide-buffer
(org-with-wide-buffer
(org-footnote-goto-definition label) (org-footnote-goto-definition label)
(beginning-of-line) (org-element-context)))
(org-element-at-point)))) (inline (eq (org-element-type definition) 'footnote-reference))
(unless (eq (org-element-type definition) 'footnote-definition) (contents
(user-error "Cannot edit remotely inline footnotes")) (let ((c (org-with-wide-buffer
(org-trim (buffer-substring-no-properties
(org-element-property :begin definition)
(org-element-property :end definition))))))
(add-text-properties
0
(progn (string-match (if inline "\\`\\[fn:.*?:" "\\`.*?\\]") c)
(match-end 0))
'(read-only "Cannot edit footnote label" front-sticky t
rear-nonsticky t)
c)
(when inline
(let ((l (length c)))
(add-text-properties
(1- l) l
'(read-only "Cannot edit past footnote reference"
front-sticky nil rear-nonsticky nil)
c)))
c)))
(org-src--edit-element (org-src--edit-element
definition (format "*Edit footnote [%s]*" label) definition
(format "*Edit footnote [%s]*" label)
#'org-mode #'org-mode
(lambda () (delete-region (point) (search-forward "]"))) `(lambda ()
(concat (if ,(not inline) (delete-region (point) (search-forward "]"))
(org-propertize (format "[%s]" label) (delete-region (point) (search-forward ":" nil t 2))
'read-only "Cannot edit footnote label" (delete-region (1- (point-max)) (point-max))
'front-sticky t (when (re-search-forward "\n[ \t]*\n" nil t)
'rear-nonsticky t) (user-error "Inline definitions cannot contain blank lines"))
(and (org-element-property :contents-begin definition) ;; If footnote reference belongs to a table, make sure to
(org-with-wide-buffer ;; remove any newline characters in order to preserve
(buffer-substring-no-properties ;; table's structure.
(progn (when ,(org-element-lineage definition '(table-cell))
(goto-char (org-element-property :contents-begin definition)) (while (search-forward "\n" nil t) (delete-char -1)))))
(skip-chars-backward " \r\t\n") contents
(point))
(org-element-property :contents-end definition)))))
'remote)) 'remote))
;; Report success. ;; Report success.
t)) t))
@ -729,7 +753,7 @@ Throw an error when not at such a table."
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
(unless (and (eq (org-element-type element) 'table) (unless (and (eq (org-element-type element) 'table)
(eq (org-element-property :type element) 'table.el) (eq (org-element-property :type element) 'table.el)
(org-src--on-element-p element)) (org-src--on-datum-p element))
(user-error "Not in a table.el table")) (user-error "Not in a table.el table"))
(org-src--edit-element (org-src--edit-element
element element
@ -752,7 +776,7 @@ Throw an error when not at an export block."
(interactive) (interactive)
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
(unless (and (eq (org-element-type element) 'export-block) (unless (and (eq (org-element-type element) 'export-block)
(org-src--on-element-p element)) (org-src--on-datum-p element))
(user-error "Not in an export block")) (user-error "Not in an export block"))
(let* ((type (downcase (org-element-property :type element))) (let* ((type (downcase (org-element-property :type element)))
(mode (org-src--get-lang-mode type))) (mode (org-src--get-lang-mode type)))
@ -783,7 +807,7 @@ name of the sub-editing buffer."
(let* ((element (org-element-at-point)) (let* ((element (org-element-at-point))
(type (org-element-type element))) (type (org-element-type element)))
(unless (and (memq type '(example-block src-block)) (unless (and (memq type '(example-block src-block))
(org-src--on-element-p element)) (org-src--on-datum-p element))
(user-error "Not in a source or example block")) (user-error "Not in a source or example block"))
(let* ((lang (let* ((lang
(if (eq type 'src-block) (org-element-property :language element) (if (eq type 'src-block) (org-element-property :language element)
@ -835,7 +859,7 @@ the area in the Org mode buffer."
(interactive) (interactive)
(let ((element (org-element-at-point))) (let ((element (org-element-at-point)))
(unless (and (eq (org-element-type element) 'fixed-width) (unless (and (eq (org-element-type element) 'fixed-width)
(org-src--on-element-p element)) (org-src--on-datum-p element))
(user-error "Not in a fixed-width area")) (user-error "Not in a fixed-width area"))
(org-src--edit-element (org-src--edit-element
element element
@ -875,8 +899,9 @@ Throw an error if there is no such buffer."
;; insert new contents. ;; insert new contents.
(delete-overlay overlay) (delete-overlay overlay)
(delete-region beg end) (delete-region beg end)
(when (org-string-nw-p edited-code) (insert edited-code)) (let ((expecting-bol (bolp)))
(unless (bolp) (insert "\n")) (insert edited-code)
(when (and expecting-bol (not (bolp))) (insert "\n")))
(save-buffer) (save-buffer)
(move-overlay overlay beg (point))))) (move-overlay overlay beg (point)))))
@ -902,9 +927,9 @@ Throw an error if there is no such buffer."
(undo-boundary) (undo-boundary)
(goto-char beg) (goto-char beg)
(delete-region beg end) (delete-region beg end)
(when (org-string-nw-p code) (let ((expecting-bol (bolp)))
(insert code) (insert code)
(unless (bolp) (insert "\n"))))) (when (and expecting-bol (not (bolp))) (insert "\n")))))
;; If we are to return to source buffer, put point at an ;; If we are to return to source buffer, put point at an
;; appropriate location. In particular, if block is hidden, move ;; appropriate location. In particular, if block is hidden, move
;; to the beginning of the block opening line. ;; to the beginning of the block opening line.