poporg.el: Preserve relative position, entering an edit buffer.

master
François Pinard 13 years ago
parent 39cbc40d67
commit adbebc047e
  1. 103
      poporg.el

@ -117,15 +117,16 @@ Point should be within a comment. The edition occurs in a separate buffer."
(setq start (point-min) (setq start (point-min)
end (point-max)) end (point-max))
(widen) (widen)
(goto-char start) (save-excursion
(skip-chars-backward " ") (goto-char start)
(setq start (point)) (skip-chars-backward " ")
;; Set PREFIX. (setq start (point))
(skip-chars-forward " ") ;; Set PREFIX.
(skip-chars-forward comment-start) (skip-chars-forward " ")
(skip-chars-forward " ") (skip-chars-forward comment-start)
(setq prefix (buffer-substring-no-properties start (point)) (skip-chars-forward " ")
prefix-regexp (regexp-quote prefix)) (setq prefix (buffer-substring-no-properties start (point))
prefix-regexp (regexp-quote prefix)))
;; Edit our extended comment. ;; Edit our extended comment.
(poporg-edit-region start end prefix))) (poporg-edit-region start end prefix)))
@ -166,25 +167,26 @@ Point should be within a string. The edition occurs in a separate buffer."
(forward-char 3) (forward-char 3)
(skip-chars-forward "\\\\\n") (skip-chars-forward "\\\\\n")
(setq start (point))))) (setq start (point)))))
;; Set END. (save-excursion
(if end ;; Set END.
(goto-char end) (if end
(goto-char (or (next-single-property-change location 'face) (goto-char end)
(point-max))) (goto-char (or (next-single-property-change location 'face)
(skip-chars-backward "\"'\\\n")) (point-max)))
(when (looking-at "\n") (skip-chars-backward "\"'\\\n"))
(forward-char)) (when (looking-at "\n")
(setq end (point)) (forward-char))
;; Set START. (setq end (point))
(if start ;; Set START.
(goto-char start) (if start
(goto-char (or (previous-single-property-change location 'face) (goto-char start)
(point-min))) (goto-char (or (previous-single-property-change location 'face)
(skip-chars-forward "\"'\\\\\n")) (point-min)))
(setq start (point)) (skip-chars-forward "\"'\\\\\n"))
;; Set PREFIX. (setq start (point))
(skip-chars-forward " ") ;; Set PREFIX.
(setq prefix (buffer-substring-no-properties start (point))) (skip-chars-forward " ")
(setq prefix (buffer-substring-no-properties start (point))))
;; Edit our string. ;; Edit our string.
(poporg-edit-region start end prefix))) (poporg-edit-region start end prefix)))
@ -231,7 +233,10 @@ A prefix common to all buffer lines, and to PREFIX as well, gets removed."
(let ((buffer (current-buffer)) (let ((buffer (current-buffer))
(edit-buffer (generate-new-buffer (concat "*" (buffer-name) "*"))) (edit-buffer (generate-new-buffer (concat "*" (buffer-name) "*")))
(overlay (make-overlay start end)) (overlay (make-overlay start end))
(string (buffer-substring start end))) (string (buffer-substring start end))
(location (cond ((< (point) start) 0)
((> (point) end) (- end start))
(t (- (point) start)))))
;; Dim and protect the original text. ;; Dim and protect the original text.
(overlay-put overlay 'face 'poporg-edited-face) (overlay-put overlay 'face 'poporg-edited-face)
(overlay-put overlay 'intangible t) (overlay-put overlay 'intangible t)
@ -239,28 +244,28 @@ A prefix common to all buffer lines, and to PREFIX as well, gets removed."
;; Initialize a popup edit buffer. ;; Initialize a popup edit buffer.
(pop-to-buffer edit-buffer) (pop-to-buffer edit-buffer)
(insert string) (insert string)
(goto-char (point-min)) (goto-char (+ (point-min) location))
(org-mode) (org-mode)
;; Reduce prefix as needed. (save-excursion
(goto-char (point-min)) ;; Reduce prefix as needed.
(while (not (eobp)) (goto-char (point-min))
(setq prefix (or (fill-common-string-prefix (while (not (eobp))
prefix (poporg-current-line)) (setq prefix (or (fill-common-string-prefix
"")) prefix (poporg-current-line))
(forward-line 1)) ""))
;; Remove common prefix. (forward-line 1))
(goto-char (point-min)) ;; Remove common prefix.
(while (not (eobp)) (goto-char (point-min))
(delete-char (length prefix)) (while (not (eobp))
(forward-line 1)) (delete-char (length prefix))
(set-buffer-modified-p nil) (forward-line 1))
;; Save data and possibly activate hooks. (set-buffer-modified-p nil)
(unless poporg-data ;; Save data and possibly activate hooks.
(push 'poporg-kill-buffer-query kill-buffer-query-functions) (unless poporg-data
(add-hook 'kill-buffer-hook 'poporg-kill-buffer-routine)) (push 'poporg-kill-buffer-query kill-buffer-query-functions)
(push (list edit-buffer overlay prefix) poporg-data) (add-hook 'kill-buffer-hook 'poporg-kill-buffer-routine))
(push (list edit-buffer overlay prefix) poporg-data))
;; All set up for edition. ;; All set up for edition.
(goto-char (point-min))
(run-hooks 'poporg-edit-hook)))) (run-hooks 'poporg-edit-hook))))
(defun poporg-edit-exit () (defun poporg-edit-exit ()

Loading…
Cancel
Save