diff --git a/followcursor-mode.el b/followcursor-mode.el index 19b026e..a0dcc6f 100644 --- a/followcursor-mode.el +++ b/followcursor-mode.el @@ -19,7 +19,7 @@ ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 ;; USA -;; Version: 0.01 +;; Version: 0.02 ;; Author: T.v.Dein ;; Keywords: files ;; URL: https://github.com/tlinden/followcursor @@ -36,6 +36,11 @@ ;; (followcursor-mode) +;; You will be asked for a `thing-at-point' to be used for +;; highlighting, the default being `lazyword', which is a mode +;; indepenent thing matching words including some punctuation. You +;; may, however, use any other symbol from the list. + ;; Move around in that buffer as you wish. Whenever `point' is on a ;; match, it will be highlighted in both buffers. @@ -44,6 +49,7 @@ ;;;; Deps (require 'hi-lock) +(require 'thingatpt) ;;;; Customizables @@ -54,15 +60,28 @@ (defcustom followcursor-highlight-there 'highlight-lines-matching-regexp ;; also: highlight-regexp - "Function used to highlight matching things in there other buffer.") + "Function used to highlight matching things in there other buffer." + :group 'followcursor) (defcustom followcursor-highlight-here 'highlight-regexp - "Function used to highlight matching things in there current buffer.") + "Function used to highlight matching things in there current buffer." + :group 'followcursor) -(defcustom followcursor-mark-thing 'followcursor-mark-symbol-lazy - "Custom mark function, must set region. -Use the default or someting like: -'(lambda() (thing-at-point 'word))") +(defcustom followcursor-mark-thing 'lazyword + "THING at point to highlight. + +The default thing, `lazyword', is defined by `followcursor-mode' for +convenience. + +For a list of THINGS, read the documentation of `thing-at-point'." + :group 'followcursor) + +(defcustom followcursor-available-things + '(word lazyword symbol list filename url email line) + "THINGs usable with `thing-at-point' to be prompted for. + +If you define your own THINGs, add them here." + :group 'followcursor) ;;;; Variables @@ -74,6 +93,14 @@ Use the default or someting like: (defvar followcursor-previous-thing nil "Buffer local variable storing last thing at point, if any")) +(make-variable-buffer-local + (defvar followcursor-font-lock-here nil + "font-lock-mode enabled before followcursor-mode?")) + +(make-variable-buffer-local + (defvar followcursor-font-lock-there nil + "font-lock-mode enabled before followcursor-mode?")) + ;;;; Internal Functions (defun followcursor--setup-ok () @@ -81,25 +108,86 @@ Use the default or someting like: Return t if there are currently 2 visible windows." (eq (count-windows) 2)) +(defun followcursor--get-thing-at-point (thing) + "Return THING thing-at-point. +Just a wrapper to omit string properties, if any." + (interactive) + (thing-at-point thing t)) + (defun followcursor--mark-and-highlight (mark-what hl-here hl-there) "Marks thing at point using form ''WHAT and highlights using form ''WHICH." (interactive) (when (followcursor--setup-ok) - (let ((thing (funcall mark-what))) + (let ((thing (followcursor--get-thing-at-point mark-what))) (if thing (unless (eq thing followcursor-previous-thing) ;; highlight here (hi-lock-mode 0) (funcall hl-here thing) + (font-lock-ensure (point-min) (point-max)) (other-window 1) ;; highlight there (hi-lock-mode 0) (funcall hl-there thing) + (font-lock-ensure (point-min) (point-max)) ;; go to here buffer (other-window 1) (setq followcursor-previous-thing thing)) (followcursor-remove-highlights))))) +(defun followcursor--enable-font-lock () + "Enable font-lock, if not yet enabled. +Store current state." + (unless font-lock-mode + (setq followcursor-font-lock-here t) + (font-lock-mode)) + (other-window 1) + (unless font-lock-mode + (setq followcursor-font-lock-there t) + (font-lock-mode)) + (other-window 1)) + +(defun followcursor--disable-font-lock () + "Disable font-lock if it were disabled previously." + (when followcursor-font-lock-here + (font-lock-mode nil) + (setq followcursor-font-lock-here nil)) + (other-window 1) + (when followcursor-font-lock-there + (font-lock-mode nil) + (setq followcursor-font-lock-there nil)) + (other-window 1)) + +;;;; Thing-at-Point wrapper[s] + +;; Thing[s] used as the default, so that we don' depend on current +;; mode's syntax table. However, IF the user want's to use current +;; mode, she can just select another thing on startup or configure +;; one. + +(defun lazyword-bounds-of-lazyword-at-point () + "Return the start and end points of a lazyword at the current point." + (let ((pattern "[:alnum:][:punct:]")) + (save-excursion + (skip-chars-backward pattern) + (if (looking-at (concat "[" pattern "]+")) + (cons (point) (match-end 0)) + nil)))) + +(put 'lazyword 'bounds-of-thing-at-point + 'lazyword-bounds-of-lazyword-at-point) + +(defun followcursor--ask-for-thing-type () + "Ask with completion for THING to be used for highlighting." + (interactive) + (let ((sym (completing-read + (concat "which thing to mark? [" + (symbol-name followcursor-mark-thing) "] ") + followcursor-available-things))) + (if (string= "" sym) + (symbol-name followcursor-mark-thing) + sym))) + ;;;; Public Functions (defun followcursor-remove-highlights () @@ -109,39 +197,22 @@ Return t if there are currently 2 visible windows." (hi-lock-mode 0) (other-window 1)) -(defun followcursor-mark-symbol-lazy () - "Mark symbol at point, be tolerant about what constitutes a symbol." - (interactive) - (let ((thing nil) - (beg nil) - (end nil)) - (when (not (looking-at "[ \t\n]")) - (save-excursion - (unless (looking-back "[ \t\n]") - (backward-word) - (while (looking-back "[-_\.]") - (backward-word))) - (setq beg (point)) - (forward-word) - (while (looking-at "[-_\.]") - (forward-word)) - (setq end (point))) - (unless (eq beg end) - (buffer-substring-no-properties beg end))))) - (defun followcursor-mode-enable () "Enable followcursor-mode." (interactive) (add-hook 'post-command-hook 'followcursor-mark-when-moved) (hi-lock-mode 0) - (setq followcursor--last-point (point)) + (setq followcursor--last-point (point) + followcursor-mark-thing (intern (followcursor--ask-for-thing-type))) + (followcursor--enable-font-lock) (followcursor-mark-when-moved)) (defun followcursor-mode-disable () "Disable followcursor-mode." (interactive) (remove-hook 'post-command-hook 'followcursor-mark-when-moved) - (followcursor-remove-highlights)) + (followcursor-remove-highlights) + (followcursor--disable-font-lock)) ;;;###autoload (defun followcursor-mark-when-moved ()