dabbrev-hover.el v. 0.0

[D. Goel]

 dabbrev-hover.el --- Tooltip-show the next completion, as does openoffice



INTRODUCTION:
============
With dh-mode, when you type a long word, like \begin{equation}, you
see a possible completion hovering next to the word.  Press C-RET to
complete the completion.  This is similar to Openoffice's behavior.



Add something like the following to .emacs, according to your tastes.

(require 'dabbrev-hover)
(dh-mode-start-[globally])

(global-set-key (kbd "C-<return>") 'dh-complete)
(global-set-key (kbd "M-TAB") 'dh-complete)


The intended aim is that the hovering completion occur right after
the cursor, but that placement doesn't always succeed.


-----------------------------------------------------
The latest version can be had from
http://gnufans.net/~deego .
;;;---------------- CUT HERE -------------------------------

;;; dabbrev-hover.el --- Tooltip-show the next completion, as does openoffice
;; Time-stamp: <2004-05-17 16:10:20 deego>
;; Copyright (C) 2004 D. Goel
;; Emacs Lisp Archive entry
;; Filename: dabbrev-hover.el
;; Package: dabbrev-hover
;; Author: D. Goel <address@hidden>
;; Keywords:
;; Version:
;; URL: http://gnufans.net/~deego
;; For latest version:

(defconst dabbrev-hover-home-page
  "http://gnufans.net/~deego";)


 
;; This file is NOT (yet) part of GNU Emacs.
 
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
 
;; This is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
 

;; See also:


;; Quick start:
(defconst dabbrev-hover-quick-start
  " Type M-x dabbrev-hover-introduction. 


"
)

(defun dabbrev-hover-quick-start ()
  "Provides electric help from variable `dabbrev-hover-quick-start'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dabbrev-hover-quick-start) nil) "*doc*"))

;;; Introduction:
;; Stuff that gets posted to gnu.emacs.sources
;; as introduction
(defconst dabbrev-hover-introduction
  "With dh-mode, when you type a long word, like \\begin{equation}, you
see a possible completion hovering next to the word.  Press C-RET to
complete the completion.  This is similar to Openoffice's behavior.



Add something like the following to .emacs, according to your tastes.

\(require 'dabbrev-hover)
\(dh-mode-start-[globally])

\(global-set-key (kbd \"C-<return>\") 'dh-complete)
\(global-set-key (kbd \"M-TAB\") 'dh-complete)


The intended aim is that the hovering completion occur right after
the cursor, but that placement doesn't always succeed.

"
)

;;;###autoload
(defun dabbrev-hover-introduction ()
  "Provides electric help from variable `dabbrev-hover-introduction'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dabbrev-hover-introduction) nil) "*doc*"))

;;; Commentary:
(defconst dabbrev-hover-commentary
  "Help..."
)

(defun dabbrev-hover-commentary ()
  "Provides electric help from variable `dabbrev-hover-commentary'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dabbrev-hover-commentary) nil) "*doc*"))

;;; History:

;;; Bugs:
;; IS AN INITIAL RELEASE, NO IDEA IF IT BREAKS THE FUNCTIONALITY OF DABBREV.EL
;;; New features:
(defconst dabbrev-hover-new-features
  "Help..."
)

(defun dabbrev-hover-new-features ()
  "Provides electric help from variable `dabbrev-hover-new-features'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dabbrev-hover-new-features) nil) "*doc*"))

;;; TO DO:
(defconst dabbrev-hover-todo
  "Help..."
)

(defun dabbrev-hover-todo ()
  "Provides electric help from variable `dabbrev-hover-todo'."
  (interactive)
  (with-electric-help
   '(lambda () (insert dabbrev-hover-todo) nil) "*doc*"))

(defconst dabbrev-hover-version "0.0")
(defun dabbrev-hover-version (&optional arg)
   "Display dabbrev-hover's version string.
With prefix ARG, insert version string into current buffer at point."
  (interactive "P")
  (if arg
      (insert (message "dabbrev-hover version %s" dabbrev-hover-version))
    (message "dabbrev-hover version %s" dabbrev-hover-version)))

;;==========================================
;;; Requires:
(eval-when-compile (require 'cl))
(require 'dabbrev)

;;; Code:

(defgroup dabbrev-hover nil
  "The group dabbrev-hover."
  :group 'applications)
(defcustom dabbrev-hover-before-load-hook nil
  "Hook to run before loading dabbrev-hover."
  :group 'dabbrev-hover)
(defcustom dabbrev-hover-after-load-hook nil
  "Hook to run after loading dabbrev-hover."
  :group 'dabbrev-hover)
(run-hooks 'dabbrev-hover-before-load-hook)

(defcustom dabbrev-hover-verbosity 0
  "How verbose to be.
Once you are experienced with this lib, 0 is the recommended
value.  Values between -90 to +90 are \"sane\".  The
rest are for debugging."
  :type 'integer
  :group 'dabbrev-hover)
(defcustom dabbrev-hover-interactivity 0
  "How interactive to be.
Once you are experienced with this lib, 0 is the recommended
value.  Values between -90 and +90 are \"sane\".  The rest are for
debugging."
  :type 'integer
  :group 'dabbrev-hover)
(defcustom dabbrev-hover-y-or-n-p-function 'dabbrev-hover-y-or-n-p
  "Function to use for interactivity-dependent  `y-or-n-p'.
Format same as that of `dabbrev-hover-y-or-n-p'."
  :type 'function
  :group 'dabbrev-hover)
(defcustom dabbrev-hover-n-or-y-p-function 'dabbrev-hover-y-or-n-p
  "Function to use for interactivity-dependent `n-or-y-p'.
Format same as that of `dabbrev-hover-n-or-y-p'."
  :type 'function
  :group 'dabbrev-hover)
(defun dabbrev-hover-message (points &rest args)
  "Signal message, depending on POINTS anddabbrev-hover-verbosity.
ARGS are passed to `message'."
  (unless (minusp (+ points dabbrev-hover-verbosity))
    (apply #'message args)))
(defun dabbrev-hover-y-or-n-p (add prompt)
  "Query or assume t, based on `dabbrev-hover-interactivity'.
ADD is added to `dabbrev-hover-interactivity' to decide whether
to query using PROMPT, or just return t."
  (if (minusp (+ add dabbrev-hover-interactivity))
        t
      (funcall 'y-or-n-p prompt)))
(defun dabbrev-hover-n-or-y-p (add prompt)
  "Query or assume t, based on `dabbrev-hover-interactivity'.
ADD is added to `dabbrev-hover-interactivity' to decide whether
to query using PROMPT, or just return t."
  (if (minusp (+ add dabbrev-hover-interactivity))
      nil
    (funcall 'y-or-n-p prompt)))

;;; Real Code:




(defun dh-point-position ()
  "An ugly hack until such time as emacs provides us this                  
  functionality.  Should return (<buffername> x . y). "
  (require 'avoid)
  (mouse-avoidance-point-position))


(defun dh-point-pixel-position ()
  "An ugly hack until such time as emacs provides us this                  
  functionality.  Should return (<buffername> x . y). "
  (let* (
         (okp t)
         ptpos fram x y
         mp mpxy
         mpx
         mpy
         mpp
         mppxy
         mppx
         mppy
         pxratio
         pyratio)
    (setq ptpos (dh-point-position))
    (setq fram (first ptpos))
    (setq x (second ptpos))
    (setq y (cdr (last ptpos)))
    (setq mp (mouse-position))
    (setq mpxy (last mp))
    (setq mpx (car mpxy))
    (setq mpy (cdr mpxy))
    (setq mpp (mouse-pixel-position))
    (setq mppxy (last mpp))
    (setq mppx (car mppxy))
    (setq mppy (cdr mppxy))
    (setq okp (and (numberp x) (numberp y) (numberp mpx) (numberp mpy)
                   (numberp mppx) (integerp mppy)
                   (> mpx 0) (> mpy 0)))
    (cond
     (okp 
      (setq pxratio (/ (* 1.0 mppx) mpx))
      (setq pyratio (/ (* 1.0 mppy) mpy))
      (cons (selected-frame)
            (cons (round (* x pxratio)) (round (* y pyratio)))))
     (t (cons (selected-frame) (cons nil nil))))))




(defcustom dh-mode-string " DH" "")

(defvar dh-mode-map
  '(keymap))

(easy-mmode-define-minor-mode
 dh-mode
 "The mode to inherit minibuffer keybindings"
 nil
 dh-mode-string
 ;; 3 means C-c
 ;; 16 means C-p
 'dh-mode-map)



(defalias 'dabbrev-hover-mode-off 'dh-mode-off)

(defvar dabbrev-mode-on-hook)
(defvar dabbrev-mode-off-hook)

(add-hook 'dh-mode-on-hook
           'dh-start-timer)
(add-hook 'dh-mode-off-hook
           'dh-stop-timer)



(defvar dh-timer nil)

(defcustom dh-interval 0.2 "")
(defcustom dh-interval-initial 0.2 "")


(defun dh-start-timer ()
  (dh-stop-timer)
  (setq dh-timer 
        (run-with-timer (eval dh-interval-initial) (eval  dh-interval)
                        'dh-once)))

;;;###autoload
(defun dabbrev-hover-start ()
  (dh-start-timer)
  (dh-mode 1))
(defun dabbrev-hover-stop ()
  (dh-stop-timer)
  (dh-mode -1))


(defun dabbrev-hover-start-globally ()
  (dh-start-timer)
  (dh-mode 1)
  (setq-default dh-mode 1))

(defun dh-stop-timer ()
  (when (timerp dh-timer)
    (cancel-timer dh-timer)))


(defvar dh-last-point nil)
(defvar dh-last-completion  nil)

(defcustom dh-abbrev-at-point-function 'dh-abbrev-at-point "")
(defun dh-abbrev-at-point ()
  (save-match-data 
    (save-excursion
      (let ((pt (point))
            res answer)
        ;;(backward-char 1)
        (cond
         ((search-backward-regexp dh-abbrev-regexp 
                                  nil t)
          (buffer-substring-no-properties 
           (match-end 0) pt))
         (t (buffer-substring-no-properties (point-min) pt)))))))




(defcustom dh-abbrev-regexp "[\t\n ]" "")

(defcustom dh-user-conditions-p 
  nil
  "A list of functions.  Only when each of those functions return
  non-nil, do we supply a tooltip at any time. ")

        
(defun dh-once ()
  "Runs only when we are at a new point. "
  (interactive)
  ;;(message "running!")

  
  (cond
   (
    (and 
     (equal last-command 'self-insert-command)
     dh-mode
     (not (equal (point) dh-last-point))
     (funcall 'every 
              'identity
              (mapcar 'funcall dh-user-conditions-p))
     (member (following-char) 
             '(0  ;; end of file
               32 ;; space
               9 ;; tab
               10 ;; newline
               )))
    (setq dh-last-point (point))
    (dabbrev--reset-global-variables)
    (let* ((abbrev  (ignore-errors (funcall dh-abbrev-at-point-function)))
           (completion
            (and (stringp abbrev)
                 (> (length abbrev) 2)
                 (dh-dabbrev--find-expansion abbrev))))
      (when (stringp completion)
        (setq dh-last-completion completion)
        (dh-tooltip-show-at-point completion))))))




(defun dh-dabbrev--find-expansion (abbrev)
  (dabbrev--find-expansion
   abbrev 
   (or dabbrev--last-direction 0)
   (and (if (eq dabbrev-case-fold-search 'case-fold-search)
            case-fold-search
          dabbrev-case-fold-search)
        (or (not dabbrev-upcase-means-case-search)
            (string= abbrev (downcase abbrev))))
   ))


(defcustom dh-offset-px 
  265
  "Pixel offset for x")


(defcustom dh-offset-py 
  86
  "Pixel offset for y")

(defun dh-tooltip-show-at-point (str)
  (let* ((bxy (dh-point-pixel-position))
         (xy (last bxy))
         (x (car xy)) (y (cdr xy))
         (tooltip-frame-parameters
          (cond
           ((and (integerp x) (integerp y))
            (append
             (list (cons 'left (+ x dh-offset-px))
                   (cons 'top (+ y dh-offset-py)))
             (and window-system tooltip-frame-parameters)))
           (t (and window-system tooltip-frame-parameters)))))
    (cond
     ((and dh-tooltip-type 
           window-system)
      (tooltip-show str))
     (t (message "Completion: %s" str)))))




(defvar dh-tooltip-type t
  "When nil, we use the minibuffer. ")

(defvar dh-tooltip-last-msg nil)


              

(defun dh-complete ()
  (interactive)
  (let ((gop nil)
        (pt (point))
        (dlc dh-last-completion)
        (abbrev (funcall dh-abbrev-at-point-function)))
    (when
        (and
         (equal dh-last-point pt)
         (stringp dh-last-completion)
         (equal 0 (string-match (regexp-quote abbrev) dlc))
         (insert (substring dlc (length abbrev)))
         (run-hook-with-args 'dh-complete-after-insert-hook abbrev
                             dlc)))))

(defcustom dh-complete-after-insert-hook nil
  "The 2 arguments each of the functions gets here, are abbrev and
  the completion. ")



      

(provide 'dabbrev-hover)
(run-hooks 'dabbrev-hover-after-load-hook)



;;; dabbrev-hover.el ends here