d-key-nav.el

    

;;; d-key-nav.el --- Keyboard navigation code

;; Copyright (C) 2006-2011 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <http://davin.50webs.com>
;; Keywords: keyboard navigation
;; Version: 1.0

;;; Commentary:

;; This file is not part of GNU Emacs.

;; This code provides some useful keyboard navigation functions.

;;; Limitation of Warranty

;; This program 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 3 of the License, or (at
;; your option) any later version.
;;
;; This program 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 detail.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs, see the file COPYING.  If not, see:
;;
;; <http://www.gnu.org/licenses/gpl-3.0.txt>.


;;; Install Instructions:
;; See the following URL for the latest info and a tarball:
;;
;; <http://davin.50webs.com/research/2010/mopa2e2.html#d-key-nav>
;;
;; Then untar the tarball to a folder pointed to by the Emacs variable
;; load-path and add the following line to your ~/.emacs file.
;;
;; (require 'd-key-nav)

;;; Known Bugs:

;; None so far!

;;; Code:

(when prefs-davins-keybindings-online-p
  (global-set-key [delete] 'd-delete-key)
  )

(defun d-delete-key ()
  (interactive)
  (save-match-data
    (condition-case nil
        (cond
         ((eobp)
          (beep))
         ((looking-at "[ \t]*$")
          (progn
            ;;(d-foo)
            (delete-region (point) (save-excursion (end-of-line)
                                                   (if (= (point) (point-max))
                                                       (progn
                                                         (beep)
                                                         (point))
                                                     (1+ (point)))))))
         (t
          (delete-char 1)))
      ((error nil)
       (beep)))))

(when prefs-davins-keybindings-online-p
  (global-set-key [backspace] 'd-backspace-key)
  )

(defun d-backspace-key ()
  (interactive)
  (save-match-data
    (cond
     ((bobp)
      (beep)
      ;;(message "Beginning of buffer")
      )
     ((= (current-column) 0)
      (progn
        (backward-delete-char 1)
        (delete-region (point)
                       (save-excursion
                         (skip-chars-backward " \t")
                         (point)))))
     (t
      (backward-delete-char 1)))))

 ;; defun navigation (defun meaning open brace in column zero)

(defun d-beginning-of-defun ()
  (interactive)
  (save-match-data
    (push-mark (point) 'no-msg)
    (beginning-of-defun)))

(defun d-end-of-defun ()
  (interactive)
  (save-match-data
    (push-mark (point) 'no-msg)
    (end-of-defun)))

(if (or emacs-dialect-xemacs-p
        prefs-davins-keybindings-online-p)
    (progn
      (global-set-key [(control meta up)]
                      (function
                       (lambda () (interactive)
                         (d-scroll-up (- (window-height) 2)))))
      (global-set-key [(control meta down)]
                      (function
                       (lambda () (interactive)
                         (d-scroll-down (- (window-height) 2)))))
      )
  (global-set-key [(meta up)] 'backward-page)
  (global-set-key [(meta down)] 'forward-page)
  ;;(global-set-key [(control up)] 'd-beginning-of-defun)
  ;;(global-set-key [(control down)] 'd-end-of-defun)
  )

;;;
;;; NOTE: Why this?
;;;
;;(global-set-key [(control meta backspace)] 'nil)
;;(global-set-key [(control meta delete)]    'nil)

 ;; extremely cool paragraph-filling!!!
;; patch to ensure closing comment appears in the correct place...
;;
(defadvice fill-paragraph (after d-key-nav activate)
  (save-match-data
    (save-excursion
      (beginning-of-line)
      (if (and (or (eq major-mode 'java-mode)
                   (eq major-mode 'c++-mode)
                   (eq major-mode 'c-mode))
               (memq 'font-lock-comment-face (text-properties-at (point)))
               (not (save-excursion
                      (beginning-of-line)
                      (looking-at ".*//"))))
          (if (not (save-excursion
                     (search-forward "*/")
                     (beginning-of-line)
                     (looking-at "\\s-*\\*/")))
              (save-excursion
                (search-forward "*/")
                (forward-char -2)
                (insert "\n")
                (execute-kbd-macro "\t")
                ;;          (execute-kbd-macro "/")
                ;;          (insert "CAT")
                ))
        ))))

;; d-set-regexps, d-hungry-delete, d-hungry-backspace

(defun d-set-regexps ()
  (setq knav--letter-regexp "[^ \t\n]");;"[0-9A-Za-z]")
  (setq knav--spacer-regexp "[ \t._-]")
  (setq knav--nonspacer-regexp "[^ \t._-]")
  (setq knav--nonspacer-spacer-regexp (concat knav--nonspacer-regexp knav--spacer-regexp))
  (setq knav--spacer-nonspacer-regexp (concat knav--spacer-regexp knav--nonspacer-regexp))
  (setq knav--white-regexp "[ \t]")
  (setq knav--alphanumeric-regexp "[a-zA-Z0-9]")
  (setq knav--init-regexp "[^a-zA-Z0-9\n \t]") ;; all but ALPHA and WHITE and LF
  )

(when prefs-davins-keybindings-online-p
  (global-set-key [(control delete)] 'd-hungry-delete)
  (global-set-key [(meta    delete)] 'd-hungry-delete)
  (global-set-key [(shift   delete)] 'd-hungry-delete)

(defvar d-delete-backspace-list nil
    "Used to store dabbrevs of deleted or backspaced text"
    )

(defun d-hungry-delete ()
    (interactive)
    (save-match-data
          (setq d-set-mse-hyphen t)
          (modify-syntax-entry ?- "-")
          (d-set-regexps)
          (let ((min               (point))
                (reverse-was-clear nil))
            (setq reverse-was-clear (or (bolp) (delta-looking-at knav--spacer-regexp -1)))

(if (and (not reverse-was-clear) (looking-at knav--spacer-nonspacer-regexp))
                (forward-char 1))

(cond
             ((looking-at knav--init-regexp)
              (while (looking-at knav--init-regexp)
                (forward-char 1)))

((looking-at knav--alphanumeric-regexp)
              (while (looking-at knav--alphanumeric-regexp)
                (forward-char 1))
              ;; HACK!
              (if (and reverse-was-clear
                       (looking-at knav--spacer-nonspacer-regexp))
                  (forward-char 1)))

;;   ((and (string-match knav--letter-regexp (knav--get-char-prior-as-string))
             ;;         (looking-at "[ \t][a-zA-Z]"))
             ;;    (forward-char 1)
             ;;    (while (looking-at "[a-zA-Z]")
             ;;      (forward-char 1))
             ;;      )
             ;;   ((looking-at nonjoiner-regexp)
             ;;    (while (looking-at nonjoiner-regexp)
             ;;      (forward-char 1))
             ;;    (while (looking-at "[ \t/_-]")
             ;;      (forward-char 1)))
             ((looking-at knav--white-regexp)
              (while (looking-at knav--white-regexp)
                (forward-char 1))
              (if (looking-at "\n")
                  (forward-char 1))
              )
             ((not (eq (point) (point-max)))
              (forward-char 1))
             )
            (let ((s (buffer-substring-no-properties min (point)))
                  (x nil)
                  (n nil))
              (when (not (member s d-delete-backspace-list))
                (setq d-delete-backspace-list (cons s d-delete-backspace-list))
                (setq n (nthcdr 10 d-delete-backspace-list))
                (if n (setcar n nil))))
            (delete-region min (point)))
          (when d-set-mse-hyphen
                (modify-syntax-entry ?- "w"))
          ))
  )

(defun knav--get-char-prior-as-string ()
  (if (eq (point) (point-min))
      ""
    (make-string 1 (char-after (1- (point))))))

(defun knav--was-looking-at (regexp)
  (save-match-data
    (if (eq (point) (point-min))
        nil
      (string-match regexp (knav--get-char-prior-as-string)))))

(defun delta-looking-at (regexp delta)
  (save-match-data
    (let ((new-point (+ (point) delta)))
      (if (and (< new-point (point-max)) (> new-point (point-min)))
          (save-excursion
            (goto-char new-point)
            (looking-at regexp))))))

(when prefs-davins-keybindings-online-p
  (global-set-key [(control backspace)] 'd-hungry-backspace)
  (global-set-key [(meta backspace)]    'd-hungry-backspace)
  (global-set-key [(shift backspace)]   'd-hungry-backspace)

(defun d-hungry-backspace ()
    (interactive)
    (save-match-data
          (setq d-set-mse-hyphen t)
          (modify-syntax-entry ?- "-")
          (d-set-regexps)
          (let ((max               (point))
                (reverse-was-clear nil))
            (setq reverse-was-clear (or (eolp) (looking-at knav--spacer-regexp)))

;; HACK!
            (if (knav--was-looking-at "/")
                (forward-char -1))

(if (and (not reverse-was-clear)
                     (delta-looking-at knav--nonspacer-spacer-regexp -2))
                (forward-char -1))

(cond
             ((knav--was-looking-at knav--init-regexp)
              (while (knav--was-looking-at knav--init-regexp)
                (forward-char -1))
              )
             ((knav--was-looking-at knav--alphanumeric-regexp)
              (while (knav--was-looking-at knav--alphanumeric-regexp)
                (forward-char -1))
              ;; HACK!
              (if (and reverse-was-clear
                       (delta-looking-at knav--nonspacer-spacer-regexp -2))
                  (forward-char -1))

)
             ;;   ((knav--was-looking-at nonjoiner-regexp)
             ;;    (while (knav--was-looking-at nonjoiner-regexp)
             ;;      (forward-char -1))
             ;;    (while (knav--was-looking-at "[ \t/_-]")
             ;;      (forward-char -1)))
             ((knav--was-looking-at knav--white-regexp)
              (while (knav--was-looking-at knav--white-regexp)
                (forward-char -1)))
             ((knav--was-looking-at "\n")
              (forward-char -1)
              (while (knav--was-looking-at knav--white-regexp)
                (forward-char -1)))
             ((not (eq (point) (point-min)))
              (forward-char -1))
             )
            (let ((s (buffer-substring-no-properties (point) max))
                  (x nil)
                  (n nil))
              (when (not (member s d-delete-backspace-list))
                (setq d-delete-backspace-list (cons s d-delete-backspace-list))
                (setq n (nthcdr 10 d-delete-backspace-list))
                (if n (setcar n nil))))
            (delete-region (point) max))
          (if d-set-mse-hyphen
              (modify-syntax-entry ?- "w")
              )))

)

(when prefs-davins-keybindings-online-p
  (global-set-key [(control left)]  'd-backward-sexp)
  (global-set-key [(meta left)]     'd-backward-sexp)
  (global-set-key [(shift left)]    'd-backward-sexp)

(defun d-backward-sexp ()
    (interactive)
    (save-match-data
      (if (> (point) (point-min))
          (if (and (eq (char-after (1- (point))) ?\ )
                   (eq (char-after (- (point) 2)) ?\ ))
              (skip-chars-backward " ")
            (condition-case err
                (forward-sexp -1)
              (error (beep)))
            ))))

(when prefs-davins-keybindings-online-p
    (global-set-key [(control right)] 'd-forward-sexp)
    (global-set-key [(meta right)]    'd-forward-sexp)
    (global-set-key [(shift right)]   'd-forward-sexp)
    )

(defun d-forward-sexp ()
    (interactive)
    (save-match-data
      (if (looking-at "[ \t]*$")
          (progn
            (setq p (point))
            (skip-chars-forward " \t\r\n")
            ;;(kill-region p (point))
            )
        (if (< (point) (point-max))
            (if (and (eq (char-after (point)) ?\ )
                     (eq (char-after (1+ (point))) ?\ ))
                (skip-chars-forward " ")
              (condition-case err
                  (forward-sexp 1)
                (error (beep)))
              )))))
  )

;;;
;;; easy-scrolling...
;;;

(defun d-smooth-up ()
  (interactive)
  (d-deposit-mark-if-small-movement)
  (if (boundp 'rsi-keystroke-count)
      (setq rsi-keystroke-count (1- rsi-keystroke-count)))
  (if (eq (frame-height (car (frame-list))) 43)
      (d-scroll-up 2)
    (d-scroll-up 1))
  )

(defun d-smooth-down ()
  (interactive)
  (d-deposit-mark-if-small-movement)
  (if (boundp 'rsi-keystroke-count)
      (setq rsi-keystroke-count (1- rsi-keystroke-count)))
  (if (eq (frame-height (car (frame-list))) 43)
      (d-scroll-down 2)
    (d-scroll-down 1))
  )

(when prefs-davins-keybindings-online-p
  (global-set-key "\C-xns"
                  (function
                   (lambda () (interactive)
                     (let (p q)
                       (setq p (point))
                       (forward-sexp 1)
                       (setq q (point))
                       (backward-sexp 1)
                       (narrow-to-region p q))))))

(provide 'd-key-nav)