;;; d-keys.el --- Defines some keys to perform commonly used commands

;; Copyright (C) 1998-2016 Davin Pearson

;; Author/Maintainer: Davin Max Pearson <davin.pearson@gmail.com>
;; Version: 1.0
;; Package-Requires: ()
;; Keywords: Keys

;;; Commentary:

;; This file is not part of GNU Emacs.

(safe-require 'd-time)

;;(message "*** about to do: keys.el init file")

;; NASTY! Eliminate cross dependency using a list here:
(setq large-movement-list '(d-smooth-up
                            d-smooth-down
                            d-forward-c-defun
                            d-backward-c-defun
                            d-forward-page
                            d-backward-page
                            beginning-of-buffer
                            end-of-buffer
                            exchange-point-and-mark))

(defun d-deposit-mark-if-small-movement ()
  (if (not (memq last-command large-movement-list))
      (push-mark (point) 'no-msg)))

(defun d-is-good-buffer (buf)
  (save-match-data
    (and
     (not (string= "*About GNU Emacs*"      (buffer-name buf)))
     (not (string= "*Class Browser*"        (buffer-name buf)))
     (not (string= "*Async Shell Command*"  (buffer-name buf)))
     (not (string= "*Apropos*"              (buffer-name buf)))
     ;;(not (string= "*Backtrace*"            (buffer-name buf)))
     (not (string= "*Buffer List*"          (buffer-name buf)))
     (not (string= "*Calendar*"             (buffer-name buf)))
     (not (string= "*Choices*"              (buffer-name buf)))
     (not (string= "*Completions*"          (buffer-name buf)))
     (not (string-match "^\\*Customize"     (buffer-name buf)))
     (not (string= "*Directory*"            (buffer-name buf)))
     (not (string= "*Dired log*"            (buffer-name buf)))
     (not (string= "*Disabled Command*"     (buffer-name buf)))
     (not (string-match "^\\*eshell\\*"     (buffer-name buf)))
     (not (string= "*Faces*"                (buffer-name buf)))
     (not (string-match "^\\*Finder"        (buffer-name buf)))
     (not (string= "*GNU Emacs*"            (buffer-name buf)))
     (not (string= "*Help*"                 (buffer-name buf)))
     (not (string= "*info*"                 (buffer-name buf)))
     ;;(not (string= "*Occur*"              (buffer-name buf)))
     (not (string-match "^\\*Open Recent"   (buffer-name buf)))
     (not (string= "*Shell Command Output*" (buffer-name buf)))
     (not (string= "*Warning*"              (buffer-name buf)))
     )))

(defun d-one-window ()
  (interactive)
  (save-match-data
    (if (eq 1 (count-windows))
        (cond
         ((string= (buffer-name) "*Article*")
          (let ((list (mapcar 'buffer-name (buffer-list))))
            (while list
              (if (string-match "\\*Summary" (car list))
                  (switch-to-buffer (car list)))
              (setq list (cdr list)))))
         ((string= (buffer-name) "*compilation*")
          (bury-buffer))
         (t (widen))))
    (while (not (d-is-good-buffer (current-buffer)))
      (bury-buffer)
      (other-window 1))
    (delete-other-windows)
    (recenter (/ (window-height) 2))
    ))

(defun d-shift-f2 ()
  (interactive)

  ;;(if (get-buffer "*Buffer List*")          (kill-buffer "*Buffer List*"))
  ;;(if (get-buffer "*Shell Command Output*") (kill-buffer "*Shell Command Output*"))

  (cond

   ((and (buffer-file-name)
         (or (string= (buffer-file-name) (expand-file-name "d:/allegro-403/docs/txt/allegro.txt"))
             (string-match "/TAGS" (buffer-file-name))))
    (bury-buffer))

   ((buffer-file-name)
    (save-buffer)
    (kill-buffer nil))

   ;;   ((and (eq major-mode 'dired-mode)
   ;;         (not (string= (safe-expand-file-name dired-directory) (safe-expand-file-name "~/")))
   ;;         (not (string= (safe-expand-file-name dired-directory) (safe-expand-file-name "~/dlisp"))))
   ;;    (kill-buffer nil))

   ((eq major-mode 'dired-mode)
    (kill-buffer nil))

   ((d-is-good-buffer (current-buffer))
    (bury-buffer))

   ((not (d-is-good-buffer (current-buffer)))
    (kill-buffer nil))

   )

  )

;;(progn
;;  (bury-buffer)
;;  (set-buffer (car (buffer-list)))
;;  (buffer-name))
;;

;;(message "*** done: d-functions")
;;(check-c-c-binding)

;;;
;;; MY FAVOURITE KEYBINDINGS:
;;;

;;(if emacs-dialect--xemacs-p
;;    (global-set-key "\C-d" 'dired))

;;(global-set-key "\C-b" 'switch-to-old-buffer)

;;(global-set-key "\C-e" 'do-shell-line)
(global-set-key "\C-e" 'call-last-kbd-macro)
;;(global-set-key [kp-enter] 'call-last-kbd-macro)

(global-set-key "\C-v" 'scroll-up)
(global-set-key "\M-v" 'scroll-down)

(global-unset-key "\M-z")

(global-set-key "\C-x\C-k" 'kill-compilation)
(global-set-key "\C-xk" 'kill-buffer)

(global-set-key "\M-i" 'indent-relative)
(global-set-key "\M-s" 'center-line)
(global-set-key "\C-xy" 'insert-register)
(global-set-key "\C-o" 'split-line)
(global-set-key "\C-xp" 'picture-mode)
(global-set-key "\C-x\C-p" 'picture-mode)
(global-unset-key "\C-p")
(global-unset-key [mouse-2])
(global-set-key "\C-n" 'd-narrow)
(global-set-key [(s ? )] (function (lambda () (interactive) (push-mark))))
(global-set-key [(s ?x)] 'execute-extended-command)

;; (global-set-key "\C-\M-backspace" 'backward-kill-sexp)
(global-set-key [(control meta backspace)] 'backward-kill-sexp)
;; (global-set-key [(control meta delete)] 'kill-sexp)
;; (first 124)(sex adfdf)(frog 123)
;;(global-set-key "\M-u" (function (interactive) (call-interactively 'find-tag  t)
;;(global-set-key "\M-/" (function (call-interactively "\C-u\M-.")))
;;(global-set-key "\M-/" (function (execute-kbd-macro "\C-u\M-.")))

;;(call-interactively "\C-u\M-.")

;;(global-set-key [(meta ?/)] (function (execute-kbd-macro "\C-u\M-.")))

(global-set-key [(shift insert)] 'electric-buffer-list)
(global-set-key [(control insert)] 'electric-buffer-list)

(defun switch-to-old-buffer (buffer)
  (interactive (list (read-buffer "Switch to old buffer: " (other-buffer) t)))
  (switch-to-buffer buffer))

(defun d-narrow ()
  (interactive)
  (assert (looking-at "[ \t]*[[({]"))
  (assert "})]")
  (let (p-low p-high)
    (setq p-low (point))
    (forward-sexp 1)
    (setq p-high (point))
    (narrow-to-region p-low p-high)
    (goto-char (point-min))))

;; patches problem with searching...
(define-key isearch-mode-map [backspace] 'isearch-delete-char)

;;
;; GIVES COMPLETION FOR EVAL:
(define-key read-expression-map [?\t] 'd-complete-lisp)
;;(define-key read-expression-map [?\t] 'd-complete-file)

(global-set-key [(shift f2)] 'd-shift-f2)
(global-set-key [(meta f2)]  'd-shift-f2)

(global-set-key [f3] 'd-super-f3)
;;(d-beeps "set f3")

(defun d-super-f3 ()
  (interactive)
  (save-some-buffers 'NO-QUESTIONS)
  (d-f3)
  (d-f3)
  (d-dired--control-o)
  )

(defun d-f3-a ()
  (interactive)
  (let ((ptr (buffer-list)))
    (while ptr
      (when (buffer-live-p (car ptr))
        (set-buffer (car ptr))
        (if (buffer-file-name)
            (if (and (not (string-match "/TAGS" (buffer-file-name)))
                     (not (string= (buffer-file-name) "/media/www/C80GB/allegro-403/docs/txt/allegro.txt")))
                (kill-buffer (car ptr)))))
      (setq ptr (cdr ptr))) ;; END WHILE!
    ))

(defun d-f3-b ()
  "kills dired buffers"
  (let ((ptr (buffer-list)))
    (while ptr
      (if (and (buffer-live-p (car ptr))
               (save-excursion
                 (set-buffer (car ptr))
                 (and (eq major-mode 'dired-mode)
                      (not (string-match "/bamboo_system_files/"  default-directory))
                      (not (string-match "/Driver Pack Solution/" default-directory))
                      (not (string-match "/wordpress/"            default-directory))
                      )))
          (kill-buffer (car ptr)))
      (setq ptr (cdr ptr)))))

(defun d-f3-c ()
  "Also kills dired buffers"
  (let ((ptr (buffer-list)))
    (while ptr ;;(setq ptr (list (get-buffer " SPEEDBAR")))
      (cond
       ((and (buffer-live-p (car ptr))
             (buffer-name (car ptr))
             (= (aref (buffer-name (car ptr)) 0) ?*)
             (not (d-is-good-buffer (car ptr))))
        (kill-buffer (car ptr)))
       ((and (buffer-live-p (car ptr))
             (save-excursion
               (set-buffer (car ptr))
               (and (not (buffer-file-name))
                    (buffer-name)
                    (eq major-mode 'dired-mode)
                    (not (string-match "/bamboo_system_files/"  default-directory))
                    (not (string-match "/Driver Pack Solution/" default-directory))
                    (not (string-match "/wordpress/"            default-directory))
                    )))
        (kill-buffer (car ptr)))
       ((and (buffer-live-p (car ptr))
             (save-excursion
               (set-buffer (car ptr))
               (and (not (buffer-file-name))
                    (buffer-name)
                    (/= (aref (buffer-name) 0) ?\ )
                    (/= (aref (buffer-name) 0) ?*)
                    (not (string= "bamboo_system_files"  (buffer-name)))
                    (not (string= "Driver Pack Solution" (buffer-name)))
                    (not (string= "wordpress"            (buffer-name)))
                    )))
        (kill-buffer (car ptr))))
      (setq ptr (cdr ptr)))))

(defun d-f3 ()
  (interactive)
  (delete-other-windows)
  ;;(save-some-buffers 'NO-QUESTIONS)
  (if (get-buffer "*info*")        (kill-buffer "*info*"))
  (if (get-buffer "*Buffer List*") (kill-buffer "*Buffer List*"))
  (let ((d))
    (setq d (if (get-buffer "*compilation*") (save-excursion (set-buffer "*compilation*") default-directory)))
    ;;(setq d (if (get-buffer "c++-projects")        (save-excursion (set-buffer "c++-projects")        default-directory)))
    (d-f3-a)
    (d-f3-b)
    (d-f3-c)
    (if d
        (dired d)
      (dired "~/")
      )))

(defun d-save-and-bury ()
  (interactive)
  (if (buffer-file-name)
      (save-buffer))
  (bury-buffer))

(defun save-and-bury-and-remove-window ()
  (interactive)

  (if (buffer-file-name)
      (save-buffer))

  ;;  (if (or (not (eq (buffer-file-name) nil))
  ;;          (not (d-is-phoney-buffer))
  ;;          (not (eq major-mode 'dired-mode)))
  ;;      (save-buffer))
  ;;
  (bury-buffer)
  ;;  (if (> (count-windows) 1)
  ;;      (delete-window))
  )

(global-set-key [(shift f3)] 'd-save-and-bury)
(global-set-key [(meta f3)] 'd-widen)

(defun d-widen ()
  (interactive)
  (widen)
  (recenter))

(global-set-key [(shift f4)] 'd-save-and-bury)
(global-set-key [(meta f4)] 'd-save-and-bury)
(global-set-key [f4] 'd-f4)

(defun d-f4 ()
  (interactive)

  ;;(save-some-buffers 'NO-QUESTIONS)

  (if (get-buffer "*Calendar*")
      (kill-buffer "*Calendar*"))

  (if (d-currently-editing-file "~/.diary")
      (save-excursion
        (set-buffer (d-currently-editing-file "~/.diary"))
        (save-buffer)
        (kill-buffer nil)))

  ;;(widen)

  (cond
   ((not (eq 1 (count-windows)))
    (delete-other-windows)
    ;;(widen)
    (recenter (/ (window-height) 2)))
   ((string= (buffer-name) "*info*")
    ;; (and nil (/ 0 0))
    ;;(widen)
    )
   )
  )

;;(global-set-key "\M-^"
;;                (function
;;                 (lambda () (interactive)
;;                   (execute-kbd-macro "\C-xnn")
;;                   (goto-char 1))))

(global-unset-key "\M-^")
(global-set-key "\C-xnd" (function
                          (lambda () (interactive)
                            (mark-defun)
                            (call-interactively 'narrow-to-region))))



(global-set-key  "\M-!" (function
                         (lambda () (interactive)
                           ;;(rsi-stop-timer)
                           (call-interactively 'shell-command)
                           ;;(rsi-start-timer)
                           (if (condition-case err
                                   ;;
                                   ;; catch: "no such buffer" errors
                                   (save-excursion
                                     (set-buffer "*Shell Command Output*")
                                     (d-check-for-sod-off-emacs))
                                 (error ))
                               (d-one-window))
                           ;;
                           ;; what is the difference between these two???
                           ;;
                           ;; (recenter)
                           (redraw-display)))
                 )

(global-set-key [kp-enter] 'kp-enter)

(global-set-key [f8] 'undo)

;;(global-set-key [f10] 'd-complete-visible)
;;(global-set-key [(f11)] 'd-complete-list)

(if prefs-advanced-user-p
    (progn
      (global-set-key [(shift   f11)] 'd-complete-file)
      ;;(global-set-key [(shift   f11)] 'd-complete-line)
      (global-set-key [(control f12)] 'd-complete-lisp)
      (global-set-key [(meta    f12)] 'd-complete-lisp)
      (global-set-key [(shift   f12)] 'd-complete-lisp)
      ))

(defun d-occur ()
  (interactive)
  (let ((case-fold-search nil))
    (call-interactively 'occur)))

(defun d-query-replace (from-string to-string &optional arg)
  (interactive (query-replace-read-args "Query replace" nil))
  ;;(interactive)
  ;;(kill-local-variable 'case-fold-search)
  ;;(setq-default case-fold-search nil)
  (let ((case-fold-search nil))
    (query-replace from-string to-string arg)))

(defun d-query-replace-regexp (regexp to-string &optional arg)
  (interactive (query-replace-read-args "Query replace regexp" t))
  ;;(kill-local-variable 'case-fold-search)
  ;;(setq-default case-fold-search nil)
  (let ((case-fold-search nil))
    (query-replace-regexp regexp to-string arg)))

;;(global-set-key "\M-*" 'd-query-replace-regexp)
;;(global-set-key "\M-%" 'd-query-replace)
(global-set-key "\M-*" 'query-replace-regexp)
(global-set-key "\M-%" 'query-replace)


;;(global-set-key "\M-\\" 'd-hungry-delete)


;;;
;;; TEX-INFO STUFF:
;;;
(setq auto-mode-alist
      (append '(("\\.txh$"  . texinfo-mode))
              auto-mode-alist))
(defun d-texinfo-stuff ()
  "My own Texinfo mode customizations."
  (set (make-local-variable 'dabbrev-case-fold-search) nil)
  (set (make-local-variable 'dabbrev-case-replace) nil))
(add-hook 'texinfo-mode-hook 'd-texinfo-stuff)
(add-hook 'texinfo-mode-hook 'turn-on-font-lock)
(add-hook 'change-log-mode-hook 'turn-on-font-lock)

(defun d-info-mode-hook ()
  (define-key Info-mode-map [f1] 'Info-exit))
(add-hook 'Info-mode-hook 'd-info-mode-hook)

;;;
;;; ARCHIVE-MODE STUFF:
;;;
(defun d-archive-mode-hook ()
  (local-set-key "\C-d" 'd-find-file)
  (local-set-key "\C-f" 'd-find-file)
  (define-key archive-mode-map "\C-d" 'd-find-file)
  )
(add-hook 'archive-mode-hook 'd-archive-mode-hook)
;;(add-hook 'archive-mode-hook 'd-foo)

;;
;;; Automatically makes the matching paren stand out in color.
(condition-case err
    (show-paren-mode t)
  (error
   (message "Cannot show parens %s" (cdr err))))

;;; This enables archive browsing and editing.
;;(setq auto-mode-alist
;;      (cons '("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
;;            auto-mode-alist))

(add-to-list 'auto-mode-alist '("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode))

;;(add-hook 'find-file-hook 'd-archive-hook)
(defun d-archive-hook ()
  (when (string-match "\\.zip$" (buffer-name))
    ;;(string-match "\\.tar$" (buffer-name))
    ;;(string-match "\\.gz$"  (buffer-name)))
    ;;(d-foo)
    (archive-mode 1)
    ))

(autoload 'archive-mode "arc-mode" "Major mode for editing archives." t)
(defadvice archive-extract (after stub activate)
  (read-only-mode 1)
  )

;;;
;;;  TEXT MODE STUFF:
;;;

;;(defun d-text-delete-word ()
;;  (interactive)
;;  (d-kill-word)
;;  (save-excursion
;;    (fill-region (point)
;;                 (progn
;;                   (if (eq 0 (current-column))
;;                       (point)
;;                     (forward-paragraph)
;;                     (point))))))
;;
;;(defun d-text-backspace-word ()
;;  (interactive)
;;  (d-backward-kill-word)
;;  (save-excursion
;;    (fill-region (point)
;;                 (progn
;;                   (if (eq 0 (current-column))
;;                       (point)
;;                     (forward-paragraph)
;;                     (point))))))
;;

(define-key text-mode-map [(shift prior)] 'backward-paragraph)
(define-key text-mode-map [(shift next)]  'forward-paragraph)
;;(define-key text-mode-map [(control backspace)] 'd-text-backspace-word)
;;(define-key text-mode-map [(control delete)] 'd-text-delete-word)
;;(define-key text-mode-map [(meta backspace)] 'd-text-backspace-word)
;;(define-key text-mode-map [(meta delete)] 'd-text-delete-word)
(define-key text-mode-map [return] 'd-indent-new-comment-line)

(eval-after-load "doctor" '(define-key doctor-mode-map [return] 'doctor-ret-or-read))

;;(define-key text-mode-map "\C-m"
;;  (function
;;   (lambda () (interactive)
;;     (if (> (current-column) fill-column)
;;         (progn
;;           (execute-kbd-macro " "))
;;       (insert "\n")))))

;;
(global-set-key "\C-o" 'd-control-o)

(defun d-control-o ()
  (interactive)
  (let ((x (current-column)))
    (call-interactively 'split-line)
    ;;(d-foo)
    (when (= 0 x)
      ;;(d-foo)
      (move-to-column 0))
    ;;(d-foo)
    ))

;;(add-hook 'text-mode-hook 'turn-on-auto-fill)
;;(add-hook 'text-mode-hook 'turn-on-font-lock)

(modify-syntax-entry ?_ "w" text-mode-syntax-table)
(modify-syntax-entry ?- "w" text-mode-syntax-table)
(modify-syntax-entry ?\" "w" text-mode-syntax-table)

;;(message "*** done: text-mode stuff")


;;(check-c-c-binding)

;;
(add-hook 'makefile-mode-hook 'turn-on-font-lock)

(defun d-makefile-mode-hook ()
  (interactive)
  (local-set-key [f12]    'do-shell-line)
  (local-set-key [return] 'd-indent-new-comment-line)
  (local-set-key [left]   'backward-char)
  (local-set-key [right]  'forward-char)
  (local-set-key [up]     'previous-line)
  (local-set-key [down]   'next-line)
  (local-set-key "\t"     'self-insert-command)
  (local-set-key "\t"     'd-shift-tab)
  (setq tab-width 10)
  )

(add-hook 'makefile-mode-hook 'd-makefile-mode-hook)

;;(check-c-c-binding)

(add-hook 'gud-mode-hook 'd-gud-mode-hook)

(defun d-gud-mode-hook ()
  (interactive)
  ;;(d-foo)
  (local-set-key "\C-d" 'd-find-file)
  (local-set-key "\C-f" 'd-find-file)
  (font-lock-mode 1)
  )


;;
;; PICTURE MODE CUSTOMIZATION:
;;
(defun d-picture-mode--backspace ()
  (interactive)
  (if (eq 0 (current-column))
      (d-beep)
    (forward-char -1)
    (delete-char 1)
    (insert " ")
    (forward-char -1)
    )
  )

(defun d-picture-mode--delete ()
  (interactive)
  (if (eolp)
      (d-beep)
    (delete-char 1)
    (insert " "))
  )

(defun d-picture-mode--right ()
  (interactive)
  (if (looking-at "$")
      (insert " ")
    (forward-char 1))
  )

(defun d-picture-mode-hook ()
  (progn
    (define-key picture-mode-map [left]              'backward-char)
    (define-key picture-mode-map [right]             'd-picture-mode--right)
    (define-key picture-mode-map [backspace]         'd-picture-mode--backspace)
    (define-key picture-mode-map [delete]            'd-picture-mode--delete)
    (define-key picture-mode-map [(shift backspace)] 'd-picture-mode--backspace)
    (define-key picture-mode-map [(shift delete)]    'd-picture-mode--delete)
    )
  )
(add-hook 'picture-mode-hook 'd-picture-mode-hook)

;;(check-c-c-binding)

;;;
;;; ASM AND HEXL SETUP:
;;;
(eval-after-load
    "asm-mode"
  '(progn
     (define-key asm-mode-map "\C-m" 'd-indent-new-comment-line)
     (define-key asm-mode-map "\C-j" 'd-indent-new-comment-line)
     ))

(eval-after-load
    "hexl"
  '(progn
     (define-key hexl-mode-map "\C-f" 'd-find-file)
     (define-key hexl-mode-map "\C-d" 'd-find-file)
     (define-key hexl-mode-map "\C-b" 'd-kill-buffer)
     ;; (define-key hexl-mode-map "\C-b" 'electric-buffer-list)
     ;; (define-key hexl-mode-map [prior] 'd-smooth-up)
     ;; (define-key hexl-mode-map [next] 'd-smooth-down)
     )
  )

;;(if (not emacs-dialect--xemacs-p) (safe-require 'complete))

(eval-after-load
    "gnus"
  '(progn
     (define-key gnus-summary-mode-map "\C-d" 'd-find-file)
     (define-key gnus-summary-mode-map "\C-f" 'd-find-file)
     ))

(eval-after-load
    "tar-mode"
  '(progn
     (define-key tar-mode-map "\C-d" 'd-find-file)
     (define-key tar-mode-map "\C-f" 'd-find-file)
     ))

(defun d-sh-mode-hook ()
  (interactive)
  (if prefs-advanced-user-p (local-set-key "`" 'dabbrev-expand))
  (local-set-key [f12] 'do-shell-line)
  )
(add-hook 'sh-mode-hook 'd-sh-mode-hook)

(autoload 'd-pretty-printer "p-print"
  "pretty prints all files in current dir to file \"printout\""
  t)

(defun strip-dos-crap ()
  "Removes ^M's from current buffer."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "\xd" nil t)
      (replace-match "" nil nil))
    ))

(defun d-indent-new-comment-line ()
  (interactive)
  ;;(debug "Wouldn't it be nice")
  (cond
   ((eq (current-column) 0)
    (insert "\n"))

   ((or (eq major-mode 'c++-mode) (eq major-mode 'java-mode) (eq major-mode 'jtw-mode))
    (cond
     ((save-excursion
        (beginning-of-line)
        (looking-at "^[ \t]*///"))

      (insert "\n/// ")
      (c-indent-command))
     ((save-excursion
        (beginning-of-line)
        (looking-at "^[ \t]*//"))

      (insert "\n// ")
      (c-indent-command))
     ((save-excursion
        (beginning-of-line)
        (looking-at "[ \t]*/\\*\\*"))

      (insert "\n *")
      (c-indent-command))
     ((save-excursion
        (beginning-of-line)
        (looking-at "[ \t]*/\\*"))

      (insert "\n * ")
      (c-indent-command))
     ((save-excursion
        (beginning-of-line)
        (looking-at "[ \t]*\\*"))

      (insert "\n * ")
      (c-indent-command))

     (t
      (indent-new-comment-line))
     )

    (execute-kbd-macro "\t")
    (skip-chars-forward "*")
    (forward-char 1)
    ;;(skip-chars-forward " \t")
    )

   ((and (or (eq major-mode 'makefile-mode) (eq major-mode 'text-mode))
         (save-excursion
           (beginning-of-line)
           (looking-at "^###")))

    (insert "\n### "))

   ((and (eq major-mode 'text-mode)
         (save-excursion
           (beginning-of-line)
           (looking-at "^===")))

    (insert "\n=== "))

   ((and (eq major-mode 'text-mode)
         (save-excursion
           (beginning-of-line)
           (looking-at "^///")))

    (insert "\n/// "))

   ((and (eq major-mode 'emacs-lisp-mode)
         (save-excursion
           (beginning-of-line)
           (looking-at "^[ \t]*;;;")))
    (let (p)
      (beginning-of-line)
      (setq p (point))
      (skip-chars-forward " \t")
      (delete-region p (point))
      (end-of-line)
      ;;(d-beeps ";;;")
      (insert "\n;;; ")))

   ((and (eq major-mode 'emacs-lisp-mode)
         (save-excursion
           (beginning-of-line)
           (looking-at "^[ \t]*;;")))
    ;;(d-beeps ";;")
    (insert "\n;; ")
    (lisp-indent-line))

   ((and (eq major-mode 'emacs-lisp-mode))

    (insert "\n")
    (lisp-indent-line))

   ((and (eq major-mode 'latex-mode)
         (save-excursion
           (beginning-of-line)
           (looking-at "^[ \t]*%%%")))
    (insert "\n%%% "))

   ;;   ((and (eq major-mode 'html-mode)
   ;;         (save-excursion
   ;;           (beginning-of-line)
   ;;           (looking-at "^[ \t]*m4_dnl")))
   ;;    (d-html--tab-key)
   ;;    (insert "m4_dnl"))
   ((eq major-mode 'html-mode)
    (insert "\n"))

   (t
    ;;(debug "foo")
    (indent-new-comment-line))))

(autoload 'log-mode "log" nil t nil)

;;(define-key minibuffer-local-map [(meta up)] 'previous-history-element)

(defadvice capitalize-word (around capitalise-bugfix activate)
  "Make `capitalise-word' capitalise A_b_c as A_B_C."
  (let (p1 p2)
    (setq p1 (point))
    ad-do-it
    (setq p2 (point))
    (capitalise-word-bugfix-region p1 p2)
    )
  )

(defun capitalise-word-bugfix-region (p1 p2)
  (goto-char p1)
  (while (< (point) p2)
    (let ((ch     (char-after (point)))
          (strobe nil))
      (if (= ch ?_)
          (progn
            (setq strobe t)
            (forward-char 1)
            (setq ch (char-after (point))))
        (setq strobe nil))
      (if (and strobe (<= ch ?z) (>= ch ?a))
          (progn
            (delete-char 1)
            (insert-char (- ch 32) 1))
        (forward-char 1)))))

;; Gives filename completion in the minibuffer
;; with the tab key.
;;
;;(defadvice indent-for-tab-command (around d-minibuffer-fix activate)
;;  (if (active-minibuffer-window)
;;      (d-complete-file nil)
;;    ad-do-it)
;;  )

;; abc
(d-quote
 ;;(defun indent-for-tab-command ()
 (interactive)
 (cond
  ((eq major-mode 'text-mode)
   (re-search-forward "[\r\n]" nil t)
   (backward-char 1)
   (re-search-backward "[^ ]" nil t)
   (forward-char 1))
  ((eq major-mode 'dired-mode)
   ))
 ;;)
 )

;;(message "*** done: keys.el init file")

(defun allegro-load ()
  (interactive)
  (progn
    (find-file "c:/allegro-403/docs/txt/allegro.txt")
    (read-only-mode 1))
  )

(provide 'd-keys)
;;; d-keys.el ends here
