;;; .emacs --- Emacs init file

;; Copyright (C) 1989-2004  Juri Linkov <juri@jurta.org>

;; Author: Juri Linkov <juri@jurta.org>

;; Keywords: init file, emacs lisp
;; URL: http://www.jurta.org/emacs/dotemacs.el
;; Version: 2004-09-29 GNU Emacs 21.3.50 (i686-pc-linux-gnu)

;; This file 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 file 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.

;;; Commentary:

;;                                               "Show me your .emacs
;;                                      and I'll tell you who you are."
;;                                                -- modified proverb

;;; Code:

;;; custom

(custom-set-variables
  ;; custom-set-variables was added by Custom.

  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 '(Man-notify-method (quote pushy))
 '(Man-overstrike-face (quote underline))
 '(apropos-do-all t)
 '(auto-compression-mode t nil (jka-compr))
 '(bbdb-use-pop-up nil)
 '(blink-matching-delay 0.1)
 '(browse-url-browser-function (quote w3m-browse-url))
 '(c-echo-syntactic-information-p t)
 '(calendar-date-display-form (quote ((format "%04s-%02d-%02d" year (string-to-int month) (string-to-int day)))))
 '(calendar-time-display-form (quote (24-hours ":" minutes (if time-zone " (") time-zone (if time-zone ")"))))
 '(calendar-week-start-day 1)
 '(column-number-mode t)
 '(comint-input-ignoredups t)
 '(comint-move-point-for-output t)
 '(comint-scroll-show-maximum-output t)
 '(compare-ignore-whitespace t)
 '(compare-windows-recenter (quote (15 15)))
 '(compilation-ask-about-save nil)
 '(compilation-context-lines nil)
 '(confirm-kill-emacs (quote y-or-n-p))
 '(cursor-in-non-selected-windows nil)
 '(custom-buffer-done-function (quote kill-buffer))
 '(debug-on-error t)
 '(delete-selection-mode t nil (delsel))
 '(desktop-enable t t (desktop))
 '(desktop-modes-not-to-save (quote (dired-mode)))
 '(diary-date-forms (quote ((year "-" month "-" day "[^0-9]") (dayname "\\W"))))
 '(diary-list-include-blanks t)
 '(diff-default-read-only nil)
 '(dired-dwim-target t)
 '(dired-keep-marker-rename 82)
 '(dired-listing-switches "-alG")
 '(dired-mode-hook (quote (dired-omit-mode dired-extra-startup)))
 '(dired-omit-files-p t t)
 '(dired-omit-size-limit 65535)
 '(dired-recursive-copies (quote always))
 '(dired-recursive-deletes (quote top))
 '(display-time-24hr-format t)
 '(display-time-default-load-average nil)
 '(ediff-split-window-function (quote split-window-horizontally))
 '(ediff-window-setup-function (quote ediff-setup-windows-plain))
 '(ee-ps-program-switches (quote ("aux" "--columns" "1024")))
 '(enable-recursive-minibuffers t)
 '(eshell-hist-ignoredups t)
 '(eshell-history-size nil)
 '(european-calendar-style t)
 '(eval-expression-print-length nil)
 '(eval-expression-print-level nil)
 '(ffap-machine-p-known (quote accept))
 '(find-file-visit-truename t)
 '(find-grep-options "-iq")
 '(find-ls-option (quote ("-exec ls -lGd {} \\;" . "-lGd")))
 '(global-font-lock-mode t nil (font-lock))
 '(global-mark-ring-max 1024)
 '(gnus-break-pages nil)
 '(gnus-permanently-visible-groups "^nn")
 '(gnus-summary-ignore-duplicates t)
 '(gnus-treat-display-smileys nil)
 '(grep-command "grep -inH -e ")
 '(history-delete-duplicates t)
 '(history-length t)
 '(htmlize-css-name-prefix "emacs-")
 '(icomplete-mode t nil (icomplete))
 '(indent-tabs-mode nil)
 '(inhibit-startup-message t)
 '(isearch-allow-scroll t)
 '(isearch-lazy-highlight-max-at-a-time nil)
 '(kill-ring-max 1024)
 '(kill-whole-line t)
 '(list-command-history-max nil)
 '(ls-lisp-dirs-first t)
 '(mark-diary-entries-in-calendar t)
 '(mark-ring-max 1024)
 '(message-log-max t)
 '(message-send-mail-function (quote smtpmail-send-it))
 '(mm-discouraged-alternatives (quote ("text/html")))
 '(mm-text-html-renderer (quote w3m))
 '(nnmail-crosspost-link-function (quote copy-file))
 '(nnmail-extra-headers (quote (To)))
 '(parens-require-spaces nil)
 '(read-quoted-char-radix 16)
 '(recentf-exclude (quote ("/[^/]+@")))
 '(require-final-newline t)
 '(save-place t nil (saveplace))
 '(scroll-conservatively 5)
 '(scroll-step 1)
 '(send-mail-function (quote smtpmail-send-it))
 '(smtpmail-debug-info t)
 '(smtpmail-queue-mail t)
 '(thumbs-per-line 65536)
 '(thumbs-relief 0)
 '(track-eol t)
 '(transient-mark-mode t)
 '(truncate-lines t)
 '(truncate-partial-width-windows nil)
 '(uniquify-buffer-name-style (quote post-forward-angle-brackets) nil (uniquify))
 '(view-diary-entries-initially t)
 '(view-read-only t)
 '(visible-bell t)
 '(w3m-default-display-inline-images t)
 '(w3m-display-inline-image t)
 '(w3m-home-page "http://www.jurta.org/")
 '(w3m-key-binding (quote info))
 '(w3m-view-this-url-new-session-in-background t)
 '(x-select-enable-clipboard t)
 '(yank-excluded-properties t))
(custom-set-faces
  ;; custom-set-faces was added by Custom.

  ;; If you edit it by hand, you could mess it up, so be careful.
  ;; Your init file should contain only one such instance.
  ;; If there is more than one, they won't work right.
 '(Buffer-menu-buffer-face ((t (:foreground "black"))))
 '(comint-highlight-input ((t (:underline t))))
 '(compare-windows-face ((((class color) (background light)) (:background "darkgray"))))
 '(compilation-info-face ((t (:foreground "ForestGreen"))))
 '(compilation-warning-face ((t (:foreground "DarkRed"))))
 '(completions-common-part ((t (:foreground "gray50"))))
 '(completions-first-difference ((t nil)))
 '(cperl-array-face ((t (:foreground "blue"))))
 '(cperl-hash-face ((t (:foreground "blue"))))
 '(cperl-nonoverridable-face ((((class color) (background light)) (:foreground "blue"))))
 '(cvs-handled-face ((((class color) (background light)) (:foreground "slate gray"))))
 '(cvs-header-face ((t (:foreground "SteelBlue"))))
 '(cvs-marked-face ((t (:foreground "DarkRed"))))
 '(cvs-need-action-face ((((class color) (background light)) (:foreground "darkgreen"))))
 '(diary-face ((((class color)) (:foreground "blue"))))
 '(diff-added-face ((t (:foreground "blue"))))
 '(diff-changed-face ((t (:foreground "blue"))))
 '(diff-removed-face ((t (:foreground "blue"))))
 '(dired-ignored ((t (:foreground "grey50"))))
 '(file-name-shadow ((t (:foreground "grey50"))))
 '(font-lock-builtin-face ((((class color) (background light)) (:foreground "Sienna"))))
 '(font-lock-string-face ((((class color) (background light)) (:foreground "ForestGreen"))))
 '(font-lock-type-face ((((class color) (background light)) (:foreground "SteelBlue"))))
 '(font-lock-variable-name-face ((((class color) (background light)) (:foreground "blue"))))
 '(font-lock-warning-face ((t (:foreground "Red"))))
 '(fringe ((((class color) (background light)) (:background "AntiqueWhite3"))))
 '(gnus-summary-cancelled-face ((((class color)) (:foreground "grey50"))))
 '(help-argument-name ((t (:foreground "SkyBlue4"))))
 '(holiday-face ((((class color)) (:background "tan"))))
 '(html-tag-face ((t (:foreground "blue"))))
 '(isearch ((((class color) (background light)) (:background "magenta4" :foreground "lightskyblue1"))))
 '(message-cited-text-face ((((class color) (background light)) (:foreground "forestgreen"))))
 '(mode-line-inactive ((t (:inherit mode-line :box (:line-width -1 :style pressed-button)))))
 '(region ((((class color) (background light)) (:background "DarkGrey"))))
 '(sh-heredoc-face ((((class color) (background light)) (:foreground "ForestGreen"))))
 '(show-paren-match-face ((((class color)) (:background "DarkGrey"))))
 '(w3m-arrived-anchor-face ((((class color) (background light)) (:foreground "DarkMagenta"))))
 '(w3m-current-anchor-face ((t (:foreground "red"))))
 '(widget-button-face ((t nil))))


;;; frame

;; To use maximum screen space my Emacs frame fully occupies the whole screen
;; and has no menus, no toolbars, no scrollbars, no title and no borders.
;; The result of such customization on 1024x768 display mode and 6x10 font
;; allows to achieve Emacs text screen resolution 168 columns x 75 lines.
;; Split-window-horizontally gives two buffers with 83 columns x 75 lines.
;; And follow-mode displays one buffer with 83 columns x 150 lines.

(cond
 ((eq window-system 'x)
  (create-fontset-from-ascii-font "-rfx-fixed-medium-r-normal--10-*-*-*-c-60-koi8-*")
  (create-fontset-from-ascii-font "-misc-fixed-medium-r-*--10-*-*-*-*-*-*-*")
  (setq default-frame-alist
        (append
         '((width . 168)
           (height . 77)
           ;; This is useful with the next code in the ~/.sawfish/rc,
           ;; because I can't find the way to unframe and maximize Emacs window from Emacs:

           ;; (require 'sawfish.wm.state.maximize)
           ;; (define (my-customize-emacs-window w)
           ;;   (when (string-match "emacs" (nth 2 (get-x-property w 'WM_CLASS)))
           ;;     (window-put w 'type 'unframed)
           ;;     (maximize-window w)))
           ;; (add-hook 'before-add-window-hook my-customize-emacs-window t)
           ;; (font . "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1")
           (font . "-*-*-medium-r-normal--10-*-*-*-c-60-fontset-koi8_r_10")
           ;;? (font . "-rfx-fixed-medium-r-normal--10-*-*-*-c-60-koi8-*")

           ;;? (font . "-rfx-fixed-medium-r-normal--10-*-*-*-c-60-*-*")
           ;; (font . "-misc-fixed-medium-r-normal--10-100-75-75-c-60-iso10646-1")
           ;; (font . "-*-*-medium-r-*--10-*-*-*-*-*-fontset-iso8859_1_10")
           ;; To win a lot of screen pixels:
           (vertical-scroll-bars . nil)
           (horizontal-scroll-bars . nil)
           (scroll-bar-width . 0)
           (internal-border-width . 0)
           (menu-bar-lines . 0)
           (tool-bar-lines . 0)
           (line-spacing . 0))
         default-frame-alist)))
 ((eq window-system 'w32)
  (setq default-frame-alist
        (append
         '((width . 105)
           (height . 65)
           (font . "-adobe-lucida console-medium-r-normal-sans-11-*-*-*-m-*-iso8859-1"))
         default-frame-alist))
  (or (fboundp 'w32-restore-frame)
      (defun w32-restore-frame ()
        "Restore a maximized or minimized frame"

        (interactive)
        (w32-send-sys-command 61728)))
  (or (fboundp 'w32-maximize-frame)
      (defun w32-maximize-frame ()
        "Maximize the current frame"
        (interactive)
        (w32-send-sys-command 61488)))
  ;; Maximize window on startup
  (add-hook 'window-setup-hook 'w32-maximize-frame)))

;;; mouse


(when (and (display-mouse-p) (require 'avoid nil t))
  ;; Move the mouse to the lower-right corner instead of default upper-right
  (defun mouse-avoidance-banish-destination ()
    (cons (+ 3 (frame-width)) (frame-height)))
  (setq mouse-avoidance-timer-delay 0.1)
  (mouse-avoidance-mode 'banish))


;; Show the text pointer in text areas
(setq void-text-area-pointer nil)

;;; colors

(defun my-colors-light (&optional frame)
  "Set colors suitable for working in light environments,
i.e. in daylight or under bright electric lamps."
  (interactive)
  (if frame
      (select-frame frame)
    (setq frame (selected-frame)))
  ;; Color with minimal eye fatigue in light environments

  ;; is "AntiqueWhite3" (RGB: 205 192 176),
  (set-background-color "AntiqueWhite3")
  (set-foreground-color "black")
  (when (facep 'region)
    (set-face-background 'region "DarkGrey" frame))
  (when (facep 'fringe)
    (set-face-background 'fringe (face-background 'default) frame)
    (set-face-foreground 'fringe (face-foreground 'default) frame)))

(define-key global-map [f6 ?c ?s] 'my-colors-light)

(defun my-colors-dark (&optional frame)
  "Set colors suitable for working in the darkness without electricity."

  (interactive)
  (if frame
      (select-frame frame)
    (setq frame (selected-frame)))
  (set-background-color "black")
  (set-foreground-color "DarkGrey")
  (when (facep 'region)
    (set-face-background 'region "DimGray" frame))
  (when (facep 'fringe)
    (set-face-background 'fringe (face-background 'default) frame)
    (set-face-foreground 'fringe (face-foreground 'default) frame)))

(define-key global-map [f6 ?c ?d] 'my-colors-dark)


;; Automatically switch to dark background after sunset
;; and to light background after sunrise.
;; (Note that `calendar-latitude' and `calendar-longitude'
;;  should be set before calling the `solar-sunrise-sunset')
(defun my-colors-set (&optional frame)
  (interactive)
  (require 'solar)
  (if (and calendar-latitude calendar-longitude calendar-time-zone)
      (let* ((l (solar-sunrise-sunset (calendar-current-date)))
             (sunrise-string (apply 'solar-time-string (car l)))
             (sunset-string (apply 'solar-time-string (car (cdr l))))
             (current-time-string (format-time-string "%H:%M")))
        (if (or (string-lessp current-time-string sunrise-string)
                (string-lessp sunset-string current-time-string))
            (my-colors-dark frame)
          (my-colors-light frame))
        (if (and (boundp 'my-sunset-timer)  (timerp my-sunset-timer))
            (cancel-timer my-sunset-timer))
        (if (and (boundp 'my-sunrise-timer) (timerp my-sunrise-timer))
            (cancel-timer my-sunrise-timer))
        (setq my-sunset-timer  (run-at-time sunset-string  (* 60 60 24) 'my-colors-dark))
        (setq my-sunrise-timer (run-at-time sunrise-string (* 60 60 24) 'my-colors-light)))))

(my-colors-set)
(add-to-list 'after-make-frame-functions 'my-colors-set)


;;; faces

(defun my-faces-set (&optional frame)
  (interactive)
  ;; Check if this function is called by `custom-define-hook' from
  ;; `custom-declare-face' where the variable `face' is bound locally.

  (if (boundp 'face)
      (mapc (lambda (face)
              (when (face-italic-p face frame)
                (if (equal (face-foreground face frame) "black")
                    (set-face-foreground face "gray50" frame)))
              ;; My font makes bold text unreadable,

              ;; so replace bold property with underline property
              (when (face-bold-p face frame)
                (set-face-bold-p face nil frame)
                ;; (set-face-inverse-video-p face t frame)
                (set-face-underline-p face t frame))
              ;; Fonts with different height decrease the amount of lines
              ;; visible on screen, so remove the height properties
              (when (numberp (face-attribute face :height frame))
                (set-face-attribute face frame :height 'unspecified))
              ;; Fonts with different width decrease the amount of characters

              ;; on the line, so remove the width properties
              (when (numberp (face-attribute face :width frame))
                (set-face-attribute face frame :width 'unspecified))
              ;; Fonts with different weight decrease the height and width,
              ;;  the line, so remove the weight properties
              ;;           (when (numberp (face-attribute face :weight frame))

              ;;             (set-face-attribute face frame :weight 'unspecified))
              )
            (face-list))))

(add-to-list 'custom-define-hook 'my-faces-set)

;;; settings

;; Enable all disabled commands (eval-expression, narrow-to-..., etc.)
(setq disabled-command-function nil)

;; Enable some useful modes
(and (fboundp 'auto-image-file-mode) (auto-image-file-mode 1))
(and (fboundp 'auto-insert-mode)     (auto-insert-mode     1))
(and (fboundp 'recentf-mode)         (recentf-mode         1))

;; Get rid of all space-wasting garbage
(and (fboundp 'menu-bar-mode)   (menu-bar-mode   -1))
(and (fboundp 'scroll-bar-mode) (scroll-bar-mode -1))
(and (fboundp 'tool-bar-mode)   (tool-bar-mode   -1))
(and (fboundp 'tooltip-mode) (fboundp 'x-show-tip) (tooltip-mode -1))

;; Blinking cursors are very distracting
(and (fboundp 'blink-cursor-mode) (blink-cursor-mode -1))

;; Use "y or n" answers instead of full words "yes or no"
(fset 'yes-or-no-p 'y-or-n-p)


;; If not on AC power line, then display battery status on the mode line
(and (require 'battery nil t)
     (functionp 'battery-status-function)
     (or (equal (cdr (assoc ?L (funcall battery-status-function))) "on-line")
         (display-battery)))

;; Display page delimiter ^L as a horizontal line
(or standard-display-table (setq standard-display-table (make-display-table)))
(aset standard-display-table ?\f (vconcat (make-vector 64 ?-) "^L"))

;;; bindings


(define-key global-map [home]           'beginning-of-line)
(define-key global-map [end]            'end-of-line)
(define-key global-map [(control home)] 'beginning-of-buffer)
(define-key global-map [(control end)]  'end-of-buffer)

(define-key global-map [(control left)]       'backward-sexp)
(define-key global-map [(control right)]      'forward-sexp)
(define-key global-map [(control meta left)]  'backward-word)
(define-key global-map [(control meta right)] 'forward-word)
(define-key global-map [(meta left)]          'dired-jump)
(define-key global-map [(meta right)]         'my-find-thing-at-point)

;; (define-key global-map [(control up)]   'backward-up-list)
;; (define-key global-map [(control down)] 'down-list)
(define-key global-map [(control meta up)]   'backward-paragraph)
(define-key global-map [(control meta down)] 'forward-paragraph)
;; TODO: currently bindings (meta up) (meta down) are free

(define-key global-map [(control meta prior)] 'scroll-right)
(define-key global-map [(control meta next)]  'scroll-left)
(define-key global-map [(control prior)] (lambda (&optional arg) (interactive) (move-to-window-line 0)))
(define-key global-map [(control next)]  (lambda (&optional arg) (interactive) (move-to-window-line -1)))

;; (unless (eq system-type 'gnu/linux) ;; needed?
;;   (define-key global-map [(control pageup)]   (lambda () (interactive) (move-to-window-line 0)))
;;   (define-key global-map [(control pagedown)] (lambda () (interactive) (move-to-window-line -1))))

(define-key global-map [(control return)]    'reindent-then-newline-and-indent)
;; (define-key global-map [(control return)] (lambda () (interactive) (let ((use-hard-newlines t)) (newline))))
;; (define-key global-map [(meta return)]    (lambda () (interactive) (scroll-other-window 1))) ;; [(meta down)]
;; (define-key global-map [(meta backspace)] (lambda () (interactive) (scroll-other-window -1))) ;; [(meta up)]

(define-key global-map [(control backspace)] 'backward-kill-word)
;; (define-key global-map [(meta backspace)] 'undo)
;; (define-key global-map [(meta backspace)] 'backward-kill-word)
;; (define-key global-map [(control backspace)] 'join-lines)

(define-key global-map [(control ?=)] 'compare-windows)
;; alternative: (lambda () (interactive) (compare-windows t))

(define-key global-map [(control kp-home)] 'beginning-of-buffer)
(define-key global-map [(control kp-end)]  'end-of-buffer)
(define-key global-map [(control shift kp-5)] 'goto-line)
(define-key global-map [(control kp-begin)] 'goto-line)

(define-key global-map [(meta kp-divide)] 'dabbrev-expand)
(define-key global-map [(control meta kp-divide)] 'dabbrev-completion)
(define-key global-map [(meta /)] 'dabbrev-expand)
(define-key global-map [(control meta /)] 'hippie-expand)

;; (define-key global-map "\M-n" 'clone-buffer)
(define-key global-map [(control x) (c) (b)] 'clone-buffer)

(define-key ctl-x-map "\C-\M-u" 'raise-sexp)
(define-key ctl-x-map "\M-(" 'delete-pair)

(define-key global-map [f1] 'info)
(define-key global-map [(control f1)] 'info-lookup-symbol)
(define-key global-map [f2] 'save-buffer)
(define-key global-map [f9] 'call-last-kbd-macro)
(define-key global-map [(control f9)] 'compile)

;; (define-key global-map [(control escape)] (lambda () (interactive) (buffer-menu 1))) ; not needed
;; (define-key global-map [(control escape)] 'ibuffer)
;; (define-key global-map [(shift f10)] 'buffer-menu) ; not needed
(define-key global-map [f11] 'my-buffer-prev)
(define-key global-map [f12] 'my-buffer-next)
(define-key global-map [(control f11)] 'previous-error)
(define-key global-map [(control f12)] 'next-error)
(define-key global-map [(control shift f11)] 'compilation-previous-file)
(define-key global-map [(control shift f12)] 'compilation-next-file)
;; TODO: currently the binding (control escape) is free

;; Define keyboard inputs for Scandinavian keyboard
(require 'iso-transl)

;; Next two corrections are for Scandinavian keyboard layouts:
;; fix the AltGr-space inserting space-looking garbage
;; (aka: "nobreakspace", 0xa0, 0x8a0), make it the same as M-space
(define-key global-map [?\xa0]  'just-one-space)
(define-key global-map [?\x8a0] 'just-one-space)
;; Swap currency sign with dollar sign, so dollar sign could be typed
;; more easily by pressing shift-4 instead of AltGr-4
;; (keyboard-translate ?\244 ?\$)
;; (keyboard-translate ?\$ ?\244)

;; Map some diacritic characters (Ao, A", O") to arrow keys
;; which have the same layout as arrow pad keys on AltGr keyboards
;; (define-key global-map [?\x8e5] 'previous-line) ; [up]
;; (define-key global-map [?\x8e4] 'next-line)
;; (define-key global-map [?\x8f6] 'backward-char)
;; (define-key global-map [?'] 'forward-char)


;; Make the prefix key `C-z' for my personal keymap.
;; On qwerty-keyboards `C-z' is one of the most accessible keys
;; like `C-x' and `C-c', but the prefix key `C-c' is reserved
;; for mode-specific commands (both user-defined and standard Emacs extensions).
;; The previous binding of `C-z' (`suspend-emacs' or `iconify-or-deiconify-frame')
;; here is reassigned to double key sequence `C-z C-z'.

(defvar my-map
  (let ((map (make-sparse-keymap))
        (c-z (global-key-binding "\C-z")))
    (global-unset-key "\C-z")
    (define-key global-map "\C-z" map)
    (define-key map "\C-z" c-z)
    map))


;; my map can be used from isearch
(define-key isearch-mode-map "\C-z" my-map)

;; Single escape instead of knocking 3 times
(define-key global-map [escape] 'keyboard-escape-quit)

;; Set esc-modifier to C-z escape
;; This is useful to invoke M-TAB or M-| on keyboards with AltGr key
(define-key my-map [escape] esc-map)

(define-key my-map [(control ?u)] 'rotate-windows)
(define-key my-map "t" 'toggle-truncate-lines)
(define-key my-map "v" 'set-variable)
(define-key my-map "V" 'customize-set-variable)
(define-key my-map "r" 'revert-buffer)
(define-key my-map "h" 'my-goto-home)
(define-key my-map "f" (lambda () (interactive) (font-lock-mode 1)))
(define-key my-map "p" (lambda () (interactive) (my-shell-command "perl test.pl")))

;; TEST: try `C-z C-x C-x C-x C-x ...', try `C-x z C-z C-z C-z' (repeat.el)

;; Insert paired characters
(define-key esc-map "\"" 'insert-pair)
(define-key esc-map "`"  'insert-pair)
;; (define-key global-map "\M-`" 'insert-pair)
(define-key esc-map "'"  'insert-pair)
(define-key esc-map "["  'insert-pair)
(define-key esc-map "{"  'insert-pair)
(define-key my-map  "<"  'insert-pair)
(define-key esc-map ")"  'up-list)



;;; functions

(defun my-home (&optional arg)
  "Return my home directory string."
  (or (and (boundp 'my-home)
           (cadr (assoc arg my-home))
;;            (or (and arg (or (and (listp my-home) (cadr my-home)) my-home))
;;                (or (and (listp my-home) (car my-home)) my-home))

           )
      (getenv "HOME")
      (expand-file-name "~")))

(defun my-goto-home (&optional arg)
  (interactive "c")
  (find-file (my-home arg)))

(defun my-find-thing-at-point ()
  "Find variable, function or file at point."

  (interactive)
  (cond ((not (eq (variable-at-point) 0))
         (call-interactively 'describe-variable))
        ((function-called-at-point)
         (call-interactively 'describe-function))
        (t (find-file-at-point))))

(defun my-shell-command (command &optional output-buffer)
  "Beep 3 times if command execution time is longer than 10 seconds."
  (interactive (list (read-from-minibuffer "Shell command: "

                                           nil nil nil 'shell-command-history)
                     current-prefix-arg))
  (if (not (and (eq system-type 'windows-nt)
                ;; calling date/time on window$ is dangerous,
                ;; because it waits for user input and hangs up
                (member (upcase command) '("DATE" "TIME"))))
      (let ((start-time (nth 1 (current-time))))
        (shell-command command output-buffer)
        (if (> (- (nth 1 (current-time)) start-time) 10)
            (dotimes (x 3)
              (sleep-for 0.2)
              (beep t))))))
(define-key esc-map "!" 'my-shell-command)
(define-key my-map  "!" 'my-shell-command)


;; this command have so many bindings because it's difficult to type with AltGr
(define-key esc-map "|"    'shell-command-on-region-or-buffer)
(define-key esc-map "\M-|" 'shell-command-on-region-or-buffer) ; `M-ESC |'
(define-key global-map [(control ?|)] 'shell-command-on-region-or-buffer)
(define-key my-map "|" 'shell-command-on-region-or-buffer)

(defun my-next-link-or-scroll-page-forward (next-point)
  "Scroll one page forward when no more next links on the current page."

  (if (and (> (window-end) next-point) (> next-point (point)))
      (goto-char next-point)
    (if (>= (window-end) (point-max))
        (goto-char (point-max))
      (progn (View-scroll-page-forward-set-page-size) (move-to-window-line 0)))))

(defun my-prev-link-or-scroll-page-backward (prev-point)
  "Scroll one page backward when no more previous links on the current page."

  (if (and (< (window-start) prev-point) (< prev-point (point)))
      (goto-char prev-point)
    (if (<= (window-start) (point-min))
        (goto-char (point-min))
      (progn (View-scroll-page-backward-set-page-size)))))

(defvar my-scroll-auto-timer 0)
(defun my-scroll-auto (arg)
  "Scroll text of current window automatically with a given frequency.
With a numeric prefix ARG, use its value as frequency in seconds.
With C-u, C-0 or M-0, cancel the timer."

  (interactive
   (list (progn
           (if (and (boundp 'my-scroll-auto-timer)
                    (timerp  my-scroll-auto-timer))
               (cancel-timer my-scroll-auto-timer))
           (or current-prefix-arg
               (read-from-minibuffer
                "Enter scroll frequency measured in seconds (0 or RET for cancel): "
                nil nil t nil "0")))))
  (if (not (or (eq arg 0) (equal arg '(4))))
      (setq my-scroll-auto-timer (run-at-time t arg 'scroll-up 1))))
(define-key my-map "s" 'my-scroll-auto)

(defun my-windows-balance ()
  (interactive)
  (other-window 1)
  (balance-windows)
  (shrink-window-if-larger-than-buffer)
  (other-window -1))
(define-key my-map "wb" 'my-windows-balance)

(defun my-recenter ()
  "Places point in window on eyes level."

  (interactive)
  (recenter 15))
(define-key my-map "\C-l" 'my-recenter)

(setq recenter-position 0.2)

;;; isearch

(defadvice isearch-update (before isearch-update-hook activate)
  (sit-for 0)
  (if (and
       ;; not the scrolling command

       (not (eq this-command 'isearch-other-control-char))
       ;; not the emptry string
       (> (length isearch-string) 0)
       ;; not the first key (to lazy highlight all matches w/o recenter)
       (> (length isearch-cmds) 2)
       ;; the point in within the given window boundaries
       (let ((line (count-screen-lines (point)
                                       (save-excursion

                                         (move-to-window-line 0) (point)))))
         (or (> line (* (/ (window-height) 4) 3))
             (< line (* (/ (window-height) 9) 1)))))
      (let ((recenter-position 0.3))
        (recenter '(4)))))

;; TEST
;; (setq isearch-op-fun
;;       (lambda ()
;;         (if (and
;;              ;; not the scrolling command
;;              (not (eq this-command 'isearch-other-control-char))
;;              ;; not the emptry string
;;              (> (length isearch-string) 0)
;;              ;; not the first key (to lazy highlight all matches w/o recenter)
;;              (> (length isearch-cmds) 2)
;;              ;; the point in within the given window boundaries
;;              (let ((line (count-screen-lines (point)
;;                                              (save-excursion
;;                                                (move-to-window-line 0) (point)))))
;;                (or (> line (* (/ (window-height) 4) 3))
;;                    (< line (* (/ (window-height) 9) 1)))))
;;             (let ((recenter-position 0.3))
;;               (recenter '(4))))))


(defun isearch-beginning-of-buffer ()
  "Move isearch point to the beginning of the buffer."
  (interactive)
  (goto-char (point-min))
  (isearch-repeat-forward))

(defun isearch-end-of-buffer ()
  "Move isearch point to the end of the buffer."

  (interactive)
  (goto-char (point-max))
  (isearch-repeat-backward))

(define-key isearch-mode-map "\M-<" 'isearch-beginning-of-buffer)
(define-key isearch-mode-map "\M->" 'isearch-end-of-buffer)

(define-key isearch-mode-map             "\t" 'isearch-complete)
(define-key minibuffer-local-isearch-map "\t" 'isearch-complete-edit)

(define-key isearch-mode-map [(control return)] 'isearch-exit)

(add-hook 'isearch-mode-end-hook
          (lambda ()
            ;; On typing C-RET

            (when (eq last-input-char 'C-return)
              ;; Set the point at the beginning of the search string
              (if (and isearch-forward isearch-other-end)
                (goto-char isearch-other-end))
              ;; Don't push the search string into the search ring
              (if isearch-regexp
                  (setq regexp-search-ring (cdr regexp-search-ring))
                (setq search-ring (cdr search-ring))))))


;; TEST
;; (setq search-whitespace-regexp "[
;;      ]+")

;;; minibuffer

(define-key minibuffer-local-map "\eN" 'next-complete-history-element)
(define-key minibuffer-local-map "\eP" 'previous-complete-history-element)

(defun delete-history-element ()
  "Delete the current minibuffer history element from the history.
After deleting the element the history position is changed either
to the the previous history element, or to the next history element
if the deleted element was the last in the history list."

  (interactive)
  (cond
   ((= minibuffer-history-position 1)
    (set minibuffer-history-variable
         (cdr (symbol-value minibuffer-history-variable))))
   ((> minibuffer-history-position 1)
    (setcdr (nthcdr (- minibuffer-history-position 2)
                    (symbol-value minibuffer-history-variable))
            (nthcdr minibuffer-history-position
                    (symbol-value minibuffer-history-variable)))))
  (condition-case nil (next-history-element     1) (error nil))
  (condition-case nil (previous-history-element 1) (error nil)))

(define-key minibuffer-local-map "\ek" 'delete-history-element)

(defun isearch-delete-ring-element ()
  "Delete the current minibuffer history element from the history.
After deleting the element the history position is changed either
to the the previous history element, or to the next history element
if the deleted element was the last in the history list."

  (interactive)
  (if isearch-regexp
      (setq regexp-search-ring (delete isearch-string regexp-search-ring))
    (setq search-ring (delete isearch-string search-ring)))
  (isearch-ring-advance))

(define-key minibuffer-local-isearch-map "\ek" 'isearch-delete-ring-element)

;;; other features

(defun my-info-refresh (&optional arg)
  "Prints a lot of useful information."

  (interactive "P")
  (cond
   ((equal arg '(4))  ; C-u f5
    (insert (format-time-string "%Y%m%d" (current-time))))
   ((equal arg '(16)) ; C-u C-u f5
    (insert (format-time-string "%Y-%m-%d" (current-time))))
   (t (message "%s"

               (concat
                (format-time-string "%Y-%m-%d %H:%M:%S %z" (current-time)) ;; ISO
                " "
                (aref calendar-day-abbrev-array (nth 6 (decode-time (current-time))))
                (if (buffer-file-name) (concat " : " (buffer-file-name))))))))
(define-key my-map     [f5]  'my-info-refresh)
(define-key global-map [f5]  'my-info-refresh)

(defun my-buffer-xray ()
  "Display the text properties and overlays of the current buffer
by adding markups."

  (interactive)
  (let* ((newbuf (get-buffer-create (format "*xray-buffer*/%s" (buffer-name))))
         (s (buffer-substring (point-min) (point-max))) ;; (buffer-string) -no-properties
         (overlays (sort (overlays-in (point-min) (point-max))
                         (lambda (a b) (< (overlay-start a)
                                          (overlay-start b)))))
         (oi 0)
         ;; ois is indexes of overlays sorted by start positions

         (ois (mapcar (lambda (o) (setq oi (1+ oi)) (cons o oi))
                      overlays))
         ;; poss is list of positions of boundaries of text properties
         ;; and start and end positions of overlays
         (poss (sort
                (append
                 (let ((p (point-min)) (pp))
                   (while p
                     (setq pp (cons (cons p (text-properties-at p)) pp))
                     (setq p (next-property-change p)))
                   pp)
                 (mapcar (lambda (o)
                           (list (overlay-start o) 'os (cdr (assq o ois))))
                         overlays)
                 (mapcar (lambda (o)
                           (list (overlay-end o) 'oe (cdr (assq o ois))))
                         overlays))
                ;; sort positions in the descending order

                (lambda (a b) (if (= (car a) (car b))
                                  ;; for equal positions first no prop
                                  (or (null (cadr b))
                                      (and (eq (cadr a) 'os) (eq (cadr b) 'os)
                                           (> (caddr a) (caddr b)))
                                      (and (eq (cadr a) 'oe) (eq (cadr b) 'oe)
                                           (< (caddr a) (caddr b))))
                                (> (car a) (car b))))))
         (p (point)))
    (switch-to-buffer newbuf)
    (insert s)
    (goto-char p)
    (save-excursion

      (mapcar (lambda (pos)
                (goto-char (car pos))
                ;; insert markup from buffer end to the beginning
                (cond
                 ((eq (cadr pos) 'os)
                  (insert (format "<o%s>" (caddr pos))))
                 ((eq (cadr pos) 'oe)
                  (insert (format "</o%s>" (caddr pos))))
                 ((null (cdr pos))
                  (insert "</p>"))
                 (t (let ((props (cdr pos)))
                      (insert "<p")
                      (while props
                        (insert (format " %s=\"" (car props)))
                        (insert
                         (cond

                          ((overlayp (cadr props))
                           (format "o%s" (cdr (assq (cadr props) ois))))
                          (t
                           (format "%s" (cadr props)))))
                        (insert "\"")
                        (setq props (cddr props)))
                      (insert ">")))))
              poss))
    (run-hooks 'my-buffer-xray)))
(add-hook 'my-buffer-xray 'html-mode)

;;; packages

;; Load some useful packages

(and (require 'ffap) (ffap-bindings))
(require 'generic)
(require 'generic-x)
(require 'tempo)
(require 'wid-edit)
(require 'misc)


;;; ee

(when (require 'ee-autoloads nil t)
  (define-key global-map [f1] 'ee-info)
  (define-key global-map [(control tab)] 'ee-buffers)
  (define-key my-map "eb"  'ee-buffers)
  (define-key my-map "ehc" 'ee-history-command)
  (define-key my-map "ehe" 'ee-history-extended-command)
  (define-key my-map "ehs" 'ee-history-shell-command)
  (define-key my-map "ei"  'ee-imenu)
  (define-key my-map "em"  'ee-marks)
  (define-key my-map "eo"  'ee-outline)
  (define-key my-map "epr" 'ee-programs)
  (define-key my-map "eps" 'ee-ps)
  (define-key my-map "et"  'ee-tags)
  (define-key my-map "ewa" 'ee-windows-add)
  (define-key my-map "eww" 'ee-windows)
  (define-key global-map [(meta ?\x8a7)] 'ee-windows-and-add-current)
  (eval-after-load "ee-windows"

    '(progn
       (define-key ee-windows-keymap [(meta ?\x8a7)] 'ee-windows-select-and-delete-current)
       (define-key ee-windows-keymap [(?\x8a7)] 'ee-view-record-next)
       (define-key ee-windows-keymap [(?\x8bd)] 'ee-view-record-prev)))
  (define-key my-map "el"
    ;; jump to my links
    (lambda () (interactive)
      (ee-datafile nil (concat (my-home ?h) "/bookmark.ee")))))


;;; lisp

(defun my-reindent-then-newline-and-indent-and-indent-sexp ()
  "Reindent current line, insert newline, then indent the new line.
Move backward out of one level of parentheses.
Indent each line of the list starting just after point."
  (interactive "*")
  (reindent-then-newline-and-indent)
  (save-excursion

    (backward-up-list)
    (indent-sexp)))

(defun my-join-line-and-indent-sexp ()
  "Join this line to previous and fix up whitespace at join.
Move backward out of one level of parentheses.
Indent each line of the list starting just after point."
  (interactive "*")
  (join-line)
  (save-excursion
    (backward-up-list)
    (indent-sexp)))

(defun my-join-line-and-indent-sexp-or-backward-kill-word ()
  "If point is on the whitespaces at the beginning of a line,
then join this line to previous and indent each line of the upper list.
Otherwise, kill characters backward until encountering the end of a word."

  (interactive "*")
  (if (save-excursion (and (skip-chars-backward " \t") (bolp)))
      (my-join-line-and-indent-sexp)
    (backward-kill-word 1)))
;; TODO: propose patch for Emacs

;; eval-after-load "lisp-mode"
(progn

  (define-key lisp-mode-map [(control return)] 'my-reindent-then-newline-and-indent-and-indent-sexp)
  (define-key lisp-mode-map [(control backspace)] 'my-join-line-and-indent-sexp-or-backward-kill-word)
  (tempo-define-template "lisp-print-map" '("(map (lambda (x) ) " p ")"))
  (define-key lisp-mode-map "\C-zim" 'tempo-template-lisp-print-map)
  (define-key emacs-lisp-mode-map [(control return)] 'my-reindent-then-newline-and-indent-and-indent-sexp)
  (define-key emacs-lisp-mode-map [(control backspace)] 'my-join-line-and-indent-sexp-or-backward-kill-word)
  (define-key emacs-lisp-mode-map [(control meta tab)] 'lisp-complete-symbol)
  (define-key emacs-lisp-mode-map "\C-ze\t" 'lisp-complete-symbol)
  (define-key emacs-lisp-mode-map "\C-xF"  'find-function)
  (define-key emacs-lisp-mode-map "\C-x4F" 'find-function-other-window)
  (define-key emacs-lisp-mode-map "\C-x5F" 'find-function-other-frame)
  (define-key emacs-lisp-mode-map "\C-xK"  'find-function-on-key)
  (define-key emacs-lisp-mode-map "\C-xV"  'find-variable)
  (define-key emacs-lisp-mode-map "\C-x4V" 'find-variable-other-window)
  (define-key emacs-lisp-mode-map "\C-x5V" 'find-variable-other-frame)
  (tempo-define-template "emacs-lisp-print-message" '("(message \"%s\" " p ")"))
  (define-key emacs-lisp-mode-map "\C-zim" 'tempo-template-emacs-lisp-print-message)
  (tempo-define-template "emacs-lisp-print-defun" '("(defun " p " ()\n  (interactive)\n\n)\n"))
  (define-key emacs-lisp-mode-map "\C-zid" 'tempo-template-emacs-lisp-print-defun)
  (tempo-define-template "lisp-print-map" '("(map (lambda (x) ) " p ")"))
  (define-key lisp-interaction-mode-map "\C-zim" 'tempo-template-emacs-lisp-print-message)
  (define-key lisp-interaction-mode-map [(control return)] 'my-reindent-then-newline-and-indent-and-indent-sexp)
  (define-key lisp-interaction-mode-map [(control backspace)] 'my-join-line-and-indent-sexp-or-backward-kill-word)
  (define-key lisp-interaction-mode-map [(control meta tab)] 'lisp-complete-symbol))


;; (add-hook
;;  'emacs-lisp-mode-hook
;;  (lambda ()
;;    (setq tab-width 4)
;;    (setq indent-tabs-mode nil)
;;    (setq fill-column 128)))

(font-lock-add-keywords
 nil `(("\\<lambda\\>"
        (0 (progn (compose-region (match-beginning 0) (match-end 0)
                                  ,(make-char 'greek-iso8859-7 107))
                  nil)))))

(eval-after-load "scheme"
  '(progn

     (define-key scheme-mode-map [(control return)] 'my-reindent-then-newline-and-indent-and-indent-sexp)
     (define-key scheme-mode-map [(control backspace)] 'my-join-line-and-indent-sexp-or-backward-kill-word)))

;;; snd

(autoload 'snd-mode "snd" "Major mode for editing Snd transcripts." t)
;; transcripts snd files
(add-to-list 'auto-mode-alist '("\\.trs\\'" . snd-mode))
;; marks snd files

(add-to-list 'auto-mode-alist '("\\.marks\\'" . scheme-mode))

(defun run-snd ()
  (interactive)
  (run-scheme "snd -notebook" "snd"))

(add-to-list 'same-window-buffer-names "*snd*")

(setq inferior-lisp-prompt "^[^<> \n]*>+:? *") ; added "<" for Scheme "#<unspecified>"
;(define-key inferior-scheme-mode-map [(meta down)] 'comint-next-prompt)
;(define-key inferior-scheme-mode-map [(meta up)] 'comint-previous-prompt)

(add-hook
 'inferior-scheme-mode-hook
 (lambda ()
   ;; no special variable for prompt in cmuscheme.el
   (setq comint-prompt-regexp "^[^<>\n]*>+ *") ; added "<"
   (define-key global-map "\C-zii"

     (lambda ()
       (interactive)
       (let* ((proc (scheme-proc))
              (m (marker-position (process-mark proc)))
              (str
               (save-excursion
                 (comint-send-string
                  proc
                  "(list (selection-position) (selection-length))\n")
                 (accept-process-output proc)
                 (set-buffer "*scheme*")
                 (buffer-substring
                  m
                  (marker-position (process-mark proc))))))
         (insert str))))))


;;; dsssl

;; Make font-lock recognise more DSSSL keywords.
;; (setq scheme-font-lock-keywords
;;      (cons '("(\\(make\\|element\\|style\\|mode\\|root\\|with-mode\\)[ \t\n]\\([0-9a-z.-]+\\|([^)]+)\\)"
;;              (1 font-lock-keyword-face)
;;              (2 font-lock-function-name-face))
;;            scheme-font-lock-keywords))

;; Use Scheme mode for DSSSL files.
;; (add-to-list 'auto-mode-alist '("\\.dss?s?l$" . scheme-mode))
(add-to-list 'auto-mode-alist '("\\.ss$" . scheme-mode))

;;; perl

;; Use cperl mode instead of perl mode
(fset 'perl-mode 'cperl-mode)

(add-to-list
 'auto-insert-alist
 '(cperl-mode
   nil
   "#!/usr/bin/perl -w" \n
   "# -*- Perl -*-" \n
   ;; "# \$Id\$" \n

   ;; "# \$RCSfile\$\$Revision\$\$Date\$" \n
   "# \$Revision\$" \n
   \n
   "while (<>) {" \n
   > "chomp;" \n
   > _ \n
   > "print \"$_\\n\";\n"

   "}\n"))

(eval-after-load "cperl-mode"
  '(progn
     ;; (define-auto-insert 'cperl-mode (lambda () (tempo-template-perl-skeleton)))
     (define-key cperl-mode-map "\C-ziw" 'tempo-template-perl-while-skeleton)
     (define-key cperl-mode-map "\C-zip" 'tempo-template-perl-print-skeleton)
     (define-key cperl-mode-map "\C-zis" 'tempo-template-perl-s-skeleton)))

(tempo-define-template "perl-skeleton" '("#!/usr/bin/perl -w\n# -*- Perl -*-\n# \$Revision\$\n\nwhile (<>) {\n  chomp;\n  " p "\n}\n"))
(tempo-define-template "perl-s-skeleton" '("s/" p "//;"))
(tempo-define-template "perl-print-skeleton" '("print \"$_" p "\\n\";"))
(tempo-define-template "perl-while-skeleton" '("while (<>) {\n  chomp;\n  " p "\n}\n"))


;; Try to distinguish between Perl and Prolog file types
;; TODO: make/use external programs (a-la 'file')
;; but best solution is to use "-*-" in the first line
(setq auto-mode-alist
      (append '(("\\.perl\\'" . perl-mode)
                ("\\.pm\\'" . perl-mode)
                ;; pl files in *perl* dir are Perl files
                ;; ("perl.*\\.pl\\'" . perl-mode)
                ("\\.pl\\'" . perl-mode))
              auto-mode-alist))
(defun my-pl-find-file-hook ()
  ;; to distinguish Prolog and Perl files with same file extension '.pl'

  ;; it assumes that Perl programs starts with comments
  ;; but this doesn't work yet for Prolog shell scripts,
  ;; so use file local variables with needed mode specified
  (if (and (looking-at "#")
           (or
            ;; this works when '.pl' is attached to Prolog mode
            (string-match "Prolog" mode-name)
            ;; BTW, Perl mode fits perfectly for different conf-files

            (equal mode-name "Fundamental")))
      (perl-mode)))
;;(setq find-file-hooks (cons 'my-pl-find-file-hook find-file-hooks))

;;; prolog

(setq prolog-system 'swi)
(setq prolog-indent-width 8)
(setq prolog-electric-dot-flag t)
(setq prolog-program-switches
  '((sicstus ("-i"))
    (swi ("-G8M"))
    (t nil)))
(setq prolog-info-predicate-index "(prolog)Predicates188")
;; look prolog.el in /usr/local/share/emacs/20.3/site-lisp
;; use progmodes/prolog2.el
;; from /CD5/DOC/PROG/PROLOG/emacs/prolog.el
;; (load "progmodes/prolog2.el")
(autoload 'run-prolog "prolog2" "Start a Prolog sub-process." t)
(autoload 'prolog-mode "prolog2" "Major mode for editing Prolog programs." t)
(autoload 'mercury-mode "prolog2" "Major mode for editing Mercury programs." t)

; (setq outline-regexp "[0-9]+ \\?-") ; for *prolog*
(setq auto-mode-alist
      (append '(
               ;; ("\\.pl?\\'" . 'prolog-mode) ; SWI Prolog
               ;; pl files in *prolog* dir are Prolog files
               ("prolog.*\\.pl?\\'" . prolog-mode) ; SWI Prolog
               ("\\.[Pp][Rr][Oo]\\'" . prolog-mode)
               ("\\.ari\\'" . prolog-mode) ; Arity Prolog

               ) auto-mode-alist))

;; Resolve file extension conflict between Octave and Mercury Prolog
;; in favor of Mercury Prolog
;; (add-to-list 'auto-mode-alist '("\\.m\\'" . octave-mode))
(add-to-list 'auto-mode-alist '("\\.m\\'" . mercury-mode))

(add-hook
 'prolog-mode-hook
 (lambda ()
   (require 'prolog)
   ;;(if (null prolog-mode-abbrev-table)
   ;; (load-file "~/usr/prog/prolog/swi/.abbrevs");) ; should be in swi-load-hook

   (setq prolog-system 'swi)
   (setq comint-input-ring-file-name "~/.pl_history")
   (comint-read-input-ring t)
   ;; THIS CAUSED TRANSIENT-MODE NOT-WORKING !!!
   ;; -> (add-hook 'pre-command-hook 'comint-write-input-ring)
   (define-key prolog-mode-map [(control f1)]
     (lambda () (interactive) (my-search-prolog-doc-at-point)))
   ;;(fset 'prolog-add-predicate-comment [C-f5 up up ?\M-3 ?% ?  ?\M-2 C-right ?\C-k ?\C-m ?\M-2 ?% ?  ? ])
   (fset 'prolog-add-predicate-comment [?\C-n ?\C-o C-f5 ?\C-a up ?\M-3 ?% ?  ?\M-2 C-right ?\C-k ?\C-m ?\M-2 ?% ?  ? ])
   (define-key prolog-mode-map "\C-zic" 'prolog-add-predicate-comment)
   ;;           (define-key prolog-mode-map "\C-zic"

   ;;             (lambda () (interactive) (end-of-line) (insert-string " :- ")))
   ;;           (define-key prolog-mode-map "\C-zi,"
   ;;             (lambda () (interactive) (end-of-line) (insert-string ", ")))
   ;;           (define-key prolog-mode-map "\C-zi."
   ;;             (lambda () (interactive) (end-of-line) (insert-string ".") (newline)))
   ;; (defun prolog-outline-level () (- 4 (outline-level)))
   (set (make-local-variable 'outline-regexp) "%%%+")
   (set (make-local-variable 'outline-level) (lambda () (- 5 (outline-level))))
   ;; (setq outline-level 'prolog-outline-level)

   ;; (font-lock-mode 1) ;; global-font-lock-mode doesn't work with prolog.el, but works with prolog2.el
   ))

(add-hook
 'prolog-inferior-mode-hook
 (lambda ()
   (define-key prolog-inferior-mode-map [(control f1)]
     (lambda () (interactive) (my-search-prolog-doc-at-point)))
   (define-key prolog-inferior-mode-map "\C-zo" 'comint-kill-output-since-last-prompt)
   (set (make-local-variable 'outline-regexp) "^[1-9][0-9]* \\?- ")
   (set (make-local-variable 'outline-level) (lambda () 1))))

(defun my-search-prolog-doc-at-point ()
  (let* ((wordchars "a-zA-Z_0-9")
         (str
          (concat "\n\n"

                  (current-word)
                  ;; (buffer-substring-no-properties
                  ;; (save-excursion (skip-chars-backward wordchars) (point))
                  ;; (save-excursion (skip-chars-forward  wordchars) (point)))
                  "(")))
    (view-file "~/doc/prog/prolog/PROLOG")
    ;; (set (make-local-variable 'outline-regexp) "^\\(Chapter [0-9]\\|\\)")
    ;; (make-local-variable 'outline-level)
    (if (not (re-search-forward str nil t))
        (progn

          (goto-char (point-min))
          (re-search-forward str nil t)))
    (show-entry) ;?
    (message str)))

;; for PROLOG manual:
;; outline-regexp: "Chapter\\|[0-9]\\.[0-9]+ .....\\|[0-9]+\\.[0-9]+\\.[0-9]+ ....."
;; outline-level: outline-level-for-prolog-manual
;; mode: outline-minor
; (setq outline-regexp "Chapter\\|[0-9]+\\.[0-9]+ .....\\|[0-9]+\\.[0-9]+\\.[0-9]+ .....")
; (setq outline-level (lambda ()
;                       (save-excursion
;                         (cond
;                          ((looking-at "Chapter") 1)
;                          ((looking-at "[0-9]+\\.[0-9]+ ") 2)
;                          ((looking-at "[0-9]+\\.[0-9]+\\.[0-9]+ ") 3)))))
; (defun outline-level-for-prolog-manual ()
;   (save-excursion
;     (cond
;      ((looking-at "Chapter") 1)
;      ((looking-at "[0-9]+\\.[0-9]+ ") 2)
;      ((looking-at "[0-9]+\\.[0-9]+\\.[0-9]+ ") 3))))

;; don't show newlines between headings
;; (defun outline-next-preface ()
;;   (if (re-search-forward (concat "\n\\(" outline-regexp "\\)") nil 'move)
;;       (goto-char (match-beginning 0))))

;;; html

(eval-after-load "sgml-mode"
  '(progn

     (setq html-quick-keys t) ;; TODO: make it customizable
     (setq html-tag-face-alist (append '(("h1" . underline)
                                         ("h2" . underline)
                                         ("title" . underline))
                                       html-tag-face-alist))))

(add-hook 'html-mode-hook 'turn-off-auto-fill)
;; (add-hook 'html-mode-hook
;;           (lambda () (define-key html-mode-map "\C-z" my-map)))

;;; htmlize


(global-set-key [print] 'htmlize-buffer)

;;; debug

;; Add key bindings similar to IDEBUG or Turbo Debugger
(defun my-gud-gdb-find-file-OLD (f)
  ;; TODO: make gdb minor mode to make rebindings more easy !
  (save-excursion

    (let ((buf (find-file-noselect f)))
      (set-buffer buf)
      (use-local-map (nconc (make-sparse-keymap) (current-local-map))) ;; TODO: why it is needed?
      ;; TODO: use (local-set-key) instead
      (define-key (current-local-map) [f4]
        (lambda () (interactive) (gud-call "tbreak %f:%l") (gud-call "cont")))
      (define-key (current-local-map) [f5]
        (lambda () (interactive)
           (if (and transient-mark-mode mark-active)
               (gud-call (concat "print "

                                 (buffer-substring-no-properties
                                  (region-beginning) (region-end))))
             (gud-call "print %e"))))
      (define-key (current-local-map) [f7]
        (lambda () (interactive) (gud-call "step %p")))
      (define-key (current-local-map) [f8]
        (lambda () (interactive) (gud-call "next %p")))
; TODO: try next instead of prev
;       (local-set-key [f5] (lambda () (interactive) (gud-call "print %e")))
;       (local-set-key [f7] (lambda () (interactive) (gud-call "step %p")))
;       (local-set-key [f8] (lambda () (interactive) (gud-call "next %p")))
      ))
  (gud-gdb-find-file f))


;; (add-hook 'gdb-mode-hook
;;           (lambda ()
;;             (setq gud-find-file 'my-gud-gdb-find-file)))

(defun my-gud-perldb-find-file (f)
  (save-excursion
    (let ((buf (find-file-noselect f)))
      (set-buffer buf)
      (use-local-map (nconc (make-sparse-keymap) (current-local-map))) ;; TODO: why it is needed?
      ;; TODO: use (local-set-key) instead

      (define-key (current-local-map) [f4]
        (lambda () (interactive) (gud-call "c %l")))
      (define-key (current-local-map) [f5]
        (lambda () (interactive) (gud-call ".")))
      (define-key (current-local-map) [f6]
        (lambda () (interactive) (gud-call "x %e")))
      (define-key (current-local-map) [f7]
        (lambda () (interactive) (gud-call "s")))
      (define-key (current-local-map) [f8]
        (lambda () (interactive) (gud-call "n")))))
  (gud-perldb-find-file f))

(add-hook
 'perldb-mode-hook
 (lambda ()
    (setq gud-find-file 'my-gud-perldb-find-file)))


;;; outline

(define-key global-map [(shift f5)] 'outline-minor-mode)

(eval-after-load "outline"
  '(progn
     (define-key outline-mode-map [(control ?o)] outline-mode-prefix-map)
     (define-key outline-mode-map [(meta left)]   'my-outline-hide-entry-or-subtree)
     (define-key outline-mode-map [(meta right)]  'my-outline-show-entry-or-subtree)
     (define-key outline-mode-map [(meta down)]   'outline-next-visible-heading)
     (define-key outline-mode-map [(meta up)]     'outline-previous-visible-heading)
     (define-key outline-mode-map [(control meta down)] 'outline-forward-same-level)
     (define-key outline-mode-map [(control meta up)]   'outline-up-heading)
;              (define-key outline-mode-map [(meta up)]    'my-outline-prev-or-up)
;              (define-key outline-mode-map [(meta left)]
;                (lambda () (interactive) (hide-subtree))) ;; (hide-entry)
;              (define-key outline-mode-map [(meta right)]
;                (lambda () (interactive) (show-children) (show-entry)))
; Use `C-M-l' instead of `f5'
;              (define-key outline-mode-map [f5]
;                (lambda () (interactive) (recenter 0) (show-entry) (beginning-of-line)))

     (define-key outline-mode-map [(control ?*)]
       (lambda () (interactive) (show-branches)))
     (define-key outline-minor-mode-map [f5] outline-mode-prefix-map)
     (define-key outline-minor-mode-map [(meta left)]   'my-outline-hide-entry-or-subtree)
     (define-key outline-minor-mode-map [(meta right)]  'my-outline-show-entry-or-subtree)
     (define-key outline-minor-mode-map [(meta down)]   'outline-next-visible-heading)
     (define-key outline-minor-mode-map [(meta up)]     'outline-previous-visible-heading)
     (define-key outline-minor-mode-map [(control meta down)] 'outline-forward-same-level)
     (define-key outline-minor-mode-map [(control meta up)]   'outline-up-heading)
;              (define-key outline-minor-mode-map [(meta up)]    'my-outline-prev-or-up)
;              (define-key outline-minor-mode-map [(meta left)]
;                (lambda () (interactive) (hide-subtree))) ;; (hide-entry)
;              (define-key outline-minor-mode-map [(meta right)]
;                (lambda () (interactive) (show-children) (show-entry)))
; Use `C-M-l' instead of `f5'
;              (define-key outline-minor-mode-map [f5]
;                (lambda () (interactive) (recenter 0) (show-entry) (beginning-of-line)))
     (define-key outline-minor-mode-map [(control ?*)]
       (lambda () (interactive) (show-branches)))
     ;; functions redefinitions moved to outline.el (and made patch)
     (require 'foldout)))


;; Start outline mode with hidden sublevels or hidden body
(add-hook
 'outline-mode-hook
 (lambda ()
   ;; (hide-sublevels 1) ; alternative
   (hide-body)))

;; Start outline minor mode with hidden sublevels or hidden body
(add-hook
 'outline-minor-mode-hook
 (lambda ()
   ;; (hide-sublevels 1) ; alternative
   (hide-body)))

; this is old and bad
; (defun my-outline-hide-entry-or-subtree ()
;   (interactive)
;   (if (save-excursion (next-line 1) (looking-at outline-regexp))
;       ;; (save-excursion (outline-end-of-heading) (outline-visible))
;       (hide-subtree)
;     (progn (hide-entry) (beginning-of-line))))


(defun my-outline-hide-entry-or-subtree ()
  (interactive)
  (if (save-excursion (next-line 1) (or (looking-at outline-regexp) (eobp)))
      (if (>= (funcall outline-level)
              (save-excursion (next-line 1)
                              (or (and (eobp) 0) (funcall outline-level))))
          (if (= (funcall outline-level) 1)
              (goto-char (point-min))
            (outline-up-heading 1))
        (hide-subtree))
    (progn (hide-entry) (beginning-of-line))))

(defun my-outline-show-entry-or-subtree ()
  (interactive)
  (if (save-excursion

        (re-search-forward (concat "\n\\(" outline-regexp "\\)")
                           (save-excursion
                             (outline-next-visible-heading 1) ; (next-line 1)
                             (point))
                           t))
      (show-children)
    (show-entry)))

;  (defun my-outline-prev-or-up ()
;    (interactive)
;    (if (and (looking-at outline-regexp)
;            (= (funcall outline-level)
;               (save-excursion (outline-previous-visible-heading 1)
;                               (funcall outline-level))))
;        (outline-up-heading 1)
;      (outline-previous-visible-heading 1)))

;  (defun my-outline-hide-or-up ()
;    (interactive)
;    (if (save-excursion (outline-end-of-heading) (outline-visible))
;        (hide-subtree)
;      (outline-up-heading 1)))


;;; diff

(eval-after-load "diff-mode"
  '(progn
     (define-key diff-mode-map [(meta down)] 'diff-hunk-next)
     (define-key diff-mode-map [(meta up)] 'diff-hunk-prev)
     ;; Patched diff-font-lock-keywords with my regexps
     (setcar (assoc "^!.*\n" diff-font-lock-keywords) "^!")
     (setcar (assoc "^[+>].*\n" diff-font-lock-keywords) "^[+>]")
     (setcar (assoc "^[-<].*\n" diff-font-lock-keywords) "^[-<]")
     (setcdr (assoc "^#.*" diff-font-lock-keywords) font-lock-comment-face)))

(define-generic-mode 'diff-generic-mode
  (list ?#)
  nil
  '(("^\\(<-? \\)" 1 'font-lock-keyword-face)
    ("^\\(-?> \\)" 1 'font-lock-function-name-face)
    ("^\\(\\(<!\\|!>\\) .*\\)" 1 'font-lock-warning-face))
  (list "\\.subpatch\\'")
  nil
  "For diffuniq and subpatch.")


;;; text

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

(eval-after-load "view"
  '(progn
     (define-key view-mode-map " " 'View-scroll-page-forward-set-page-size)
     (define-key view-mode-map "g" (lambda () (interactive) (revert-buffer nil t t)))
     (define-key view-mode-map "l" 'View-goto-line)
     (define-key view-mode-map [f2] 'toggle-truncate-lines)
     ;; (define-key view-mode-map [tab] 'other-window) ; used for next-ref

     ;; global: (define-key view-mode-map [(meta right)] 'find-file-at-point)
     (define-key view-mode-map [(meta left)]
       (lambda ()
         (interactive)
         (goto-char (point-min))
         (View-quit))) ; for emacs-places
     (define-key view-mode-map [(meta down)]
       (lambda ()
         (interactive)
         (if (>= (window-end) (point-max))
             (goto-char (point-max))
           (View-scroll-page-forward-set-page-size))))
     (define-key view-mode-map [(meta up)]
       (lambda ()
         (interactive)
         (if (<= (window-start) (point-min))
             (goto-char (point-min))
           (View-scroll-page-backward-set-page-size))))))


;;; dired

(require 'dired-x)

;; HINT: next expression is very useful for M-( in Dired mode:
;; (string-match "perl" (shell-command-to-string (concat "file " name)))

;; uses editor/viewer info from /usr/bin/run-mailcap
(defun my-dired-run-find-file ()
  "My view file for dired."

  (interactive)
  (let* ((file (dired-get-filename)))
    (cond
     ((let* ((command
              (and (functionp 'mm-mime-info)
                   (mm-mime-info
                    (mm-extension-to-mime (file-name-extension file))))))
        (if (and command (stringp command))
            ;; always return `t' for `cond'

            (or (ignore (shell-command (concat (format command file) "&")))
                t))))
     ;; ((string-match "\\.html?$" file) (w3-open-local file))
     ((string-match "\\.html?$" file)
      (cond
       ((fboundp 'w3m-goto-url-new-session)
        (w3m-find-file-new-session file))
       ((fboundp 'browse-url)
        (browse-url file))))
     ((string-match "\\.elc?$" file)
      (load-file file))
     ((string-match "\\.info?$" file)
      (info file))
     ((eq window-system 'w32)
      (let ((file-list (list (dired-get-filename))))
        (shell-command
         (concat
          (dired-shell-stuff-it "start /max" file-list nil 0)
          "&")
         (generate-new-buffer "*Async Shell Command*"))))
     (;; (or (string-match "\\.jpe?g$" file)

      ;;           (string-match "\\.gif$" file)
      ;;           (string-match "\\.pdf$" file))
      (let* ((file-list (list (dired-get-filename)))
             (command (dired-guess-default file-list)))
        (if (listp command)
            (setq command (car command)))
        (if command
            (shell-command
             (dired-shell-stuff-it command file-list nil 0)))))
     (t
      (message file)))))

;; Add different directory sorting keys
(mapc (lambda (elt)
        (define-key dired-mode-map (car elt)
          `(lambda ()
            (interactive)
            (dired-sort-other (concat dired-listing-switches ,(cadr elt))))))
      '(([(control f3)]       ""     "by name")
        ([(control f4)]       " -X"  "by extension")
        ([(control f5)]       " -t"  "by date")
        ([(control f6)]       " -S"  "by size")
        ([(control shift f3)] " -r"  "by reverse name")
        ([(control shift f4)] " -rX" "by reverse extension")
        ([(control shift f5)] " -rt" "by reverse date")
        ([(control shift f6)] " -rS" "by reverse size")))


;; Next two bindings allow to quickly look to the file and return back to dired
;; by pressing [f3] twice (same keys are used in the Midnight Commander)
(define-key dired-mode-map [f3]
  (lambda () (interactive) (let (dired-view-command-alist) (dired-view-file))))
(define-key global-map [f3] 'kill-current-buffer)
(define-key global-map [(control f3)] 'kill-current-buffer-and-dired-jump)
(define-key dired-mode-map [(shift f3)] 'dired-find-file-literally)

;; Next two bindings allow to open file for editing by [f4], and return
;; back to dired without killing the buffer.
(define-key dired-mode-map [f4] 'dired-find-file) ;; 'dired-view-file
(define-key global-map [f4] 'dired-jump)

(define-key dired-mode-map [(control return)] 'my-dired-run-find-file)

(define-key dired-mode-map [(control meta ?=)] 'dired-compare-directories)

;; Next keys resemble *Commander's bindings.
;; But currently I use original Emacs bindings: "C", "R", "D"
;; (define-key dired-mode-map [f5] 'dired-do-copy)
;; (define-key dired-mode-map [f6] 'dired-do-rename)
;; (define-key dired-mode-map [f8] 'dired-do-delete)
(define-key dired-mode-map [delete] 'dired-do-delete)
(define-key dired-mode-map [f7] 'dired-create-directory)
(define-key dired-mode-map [(shift f7)] 'find-dired)

(define-key dired-mode-map [(shift f5)] 'dired-count-sizes)

(define-key dired-mode-map [(meta left)]
  ;; Mozilla-like navigation
  (lambda (arg)
     (interactive "P")
     (if (not (and (memq ?R (append dired-actual-switches nil))
                   (dired-between-files)))
         (dired-up-directory)
       (if (dired-subdir-hidden-p (dired-current-directory))
           (dired-tree-up 1)
         (progn (dired-hide-subdir 1) (dired-previous-line 1))))))

(define-key dired-mode-map [(meta right)]
  ;; Mozilla-like navigation

  (lambda (arg)
     (interactive "P")
     (let (dired-view-command-alist)
       (if (not (and (memq ?R (append dired-actual-switches nil))
                     (dired-between-files)))
           (dired-view-file)
         (if (dired-subdir-hidden-p (dired-current-directory))
             (progn (dired-hide-subdir 1)
                    (dired-prev-subdir 1)
                    (dired-next-line 4))
           (dired-view-file))))))

(defun my-dired-move-to-next-dir (arg)
  (interactive "P")
  (if (not (memq ?R (append dired-actual-switches nil)))
      (dired-next-dirline-cycle 1)
    (progn (dired-next-subdir 1))))
(define-key dired-mode-map [(meta down)] 'dired-next-line-cycle) ; dired-next-line

(define-key dired-mode-map [(control meta down)] 'my-dired-move-to-next-dir)
(define-key dired-mode-map [tab] 'my-dired-move-to-next-dir) ;'other-window

(defun my-dired-move-to-prev-dir (arg)
  (interactive "P")
  (if (not (memq ?R (append dired-actual-switches nil)))
      (dired-prev-dirline-cycle 1)
    (progn (dired-prev-subdir 1))))
(define-key dired-mode-map [(meta up)] 'dired-previous-line-cycle) ; dired-previous-line

(define-key dired-mode-map [(control meta up)] 'my-dired-move-to-prev-dir)
(define-key dired-mode-map [(shift iso-lefttab)] 'my-dired-move-to-prev-dir)

(define-key dired-mode-map [insert]
  (lambda (arg) (interactive "P")
     (dired-mark arg)
     (dired-count-sizes dired-marker-char)))
(define-key dired-mode-map [backspace]
  (lambda (arg) (interactive "p")
     (dired-unmark-backward arg)
     (dired-count-sizes dired-marker-char)))
(define-key dired-mode-map "q" (lambda () (interactive) (quit-window 1)))


;; set ls patched to sort directories first in any ordering
;; (TODO: post patch to coreutils)
(let ((ls-dir "/usr/local/bin/ls"))
  (if (file-exists-p ls-dir)
      (setq insert-directory-program ls-dir)))

;; My preferences for default shell commands
(setq dired-guess-shell-alist-user
      (list
       (list "\\.pl$" "perl")
       (list "\\.wav$" "play")
       (list "\\.bmp" "xli -dispgamma 1.0" "xv")
       (list "\\.p[bgpn]m$" "xli -dispgamma 1.0" "display" "xloadimage" "xview -quiet")
       (list "\\.xbm$" "xli -dispgamma 1.0" "bitmap")
       (list "\\.xwd$" "xli -dispgamma 1.0" "display" "xview -quiet")
       (list "\\.png$" "xli -dispgamma 1.0" "xv" "display")
       (list "\\.jpe?g$" "xli -dispgamma 1.0" "xv" "display" "xview -quiet")
       (list "\\.gif$" "xli -dispgamma 1.0" "xv" "display" "xview -quiet")
       (list "\\.e?ps$" "gv -scale 1 -resize -spartan -antialias * &" "xv")
       ;; gv understands .ps.gz.  Good.

       (list "\\.e?ps\\.g?z$" "gv -scale 1 -resize -spartan -antialias * &")
       (list "\\.e?ps\\.Z$" "zcat * | gv -scale 1 -resize -spartan -antialias -&"
             '(concat "znew"
                      (if dired-guess-shell-gzip-quiet " -q")
                      " " dired-guess-shell-znew-switches))))


;; (add-hook 'dired-mode-hook (function (lambda () (dired-omit-mode 1))))

(add-hook 'archive-mode-hook
          (lambda ()
            ;; (view-mode -1) ; doesn't work here ;; see view-mode-hook
            (define-key archive-mode-map [f3] 'archive-view)
            (define-key archive-mode-map [(meta right)] 'archive-view) ;; archive-extract
            (define-key archive-mode-map [(meta left)] 'kill-current-buffer)
            (define-key archive-mode-map "q" 'kill-current-buffer)))

(add-hook 'tar-mode-hook
          (lambda ()
            ;; (view-mode -1) ; doesn't work here ;; see view-mode-hook

            (define-key tar-mode-map "q" 'kill-current-buffer)
            (define-key tar-mode-map [f3] 'tar-view)
            (define-key tar-mode-map [(meta up)] 'tar-previous-line)
            (define-key tar-mode-map [(meta down)] 'tar-next-line)
            (define-key tar-mode-map [(meta left)] 'kill-current-buffer)
            (define-key tar-mode-map [(meta right)] 'tar-view)))

;; wdired

;; http://mail.gnu.org/archive/html/emacs-devel/2004-04/msg01190.html
;; http://mail.gnu.org/archive/html/emacs-devel/2004-04/msg01247.html
(define-key dired-mode-map "r"        'wdired-change-to-wdired-mode)
(define-key dired-mode-map "\C-x\C-q" 'wdired-change-to-wdired-mode)
(eval-after-load "wdired"

  '(progn
     (define-key wdired-mode-map [return] 'wdired-finish-edit)
     (define-key wdired-mode-map "\C-x\C-q" 'wdired-finish-edit)))

;;; locate

(defun locate-make-command-line-ignore-case (search-string)
  (list locate-command "-i" search-string))

(setq locate-make-command-line 'locate-make-command-line-ignore-case)


;;; comint

(add-hook 'comint-mode-hook ;; 'comint-load-hook
          (lambda ()
            ;; (define-key comint-mode-map "\C-zo" 'comint-kill-output-since-last-prompt)
            (define-key comint-mode-map [(meta down)] 'comint-next-prompt)
            (define-key comint-mode-map [(meta up)] 'comint-previous-prompt)))

(if delete-selection-mode
    (put 'comint-delchar-or-maybe-eof 'delete-selection 'supersede))


;;; switch

(define-key global-map [(control ?\x8a7)] 'other-window)
(define-key global-map [(control ?\x8bd)] (lambda () (interactive) (other-window -1)))
(define-key global-map [(control ?\247)] 'other-window)
(define-key global-map [(control ?\275)] (lambda () (interactive) (other-window -1)))
(define-key global-map [(control ?`)] 'other-window)
(define-key global-map [(control ?~)] (lambda () (interactive) (other-window -1)))
(define-key global-map [(control ?<)] 'other-window)
(define-key global-map [(control ?>)] (lambda () (interactive) (other-window -1)))
(define-key global-map [(control ?,)] 'other-window)
(define-key global-map [(control ?.)] (lambda () (interactive) (other-window -1)))
(define-key global-map [(control print)] 'other-window)


;; something wrong with buffer lists in built-in functions
;; TODO: support buffer creation order! (as in Tab-list in some www browsers)
(defun my-buffer-next ()
  "Primitive buffer navigation function: next-buffer."
  (interactive)
  (bury-buffer) ;; (switch-to-buffer (other-buffer))
  (my-display-prev-next-buffers))

(defun my-buffer-prev ()
  "Primitive buffer navigation function: prev-buffer."

  (interactive)
  (switch-to-buffer (car (last (buffer-list))))
  (my-display-prev-next-buffers))

(defun my-display-prev-next-buffers ()
  "Show two previous, current and two next buffer names in the minibuffer.
Example:
-2:*Messages* -1:*Help*    0:.emacs      1:*info*  2:*scratch*"
  (interactive)
  (let ((n -3))
    (message "%s"
             (mapconcat
              (lambda (x)
                (setq n (+ n 1))
                (format "%d:%-12s"

                        n (substring (buffer-name x) 0 (min (length (buffer-name x)) 11))))
              (append
               (last (buffer-list) 2)
               (reverse (last (reverse (buffer-list)) 3)))
              " "))))

;; TEST IT:
;; (add-to-list 'same-window-buffer-names "*Help*")

;;; info

;; It's easier to type C-5 C-h C-i with control key pressed for all keys:
(define-key global-map "\C-h\C-i" 'info)

;; Info to look and behave as Midnight Commander, Lynx (Links) and Mozilla
(eval-after-load "info"

  '(progn
     (define-key Info-mode-map "\M-s" 'Info-search-next) ; obsoleted by C-M-s
     ;; TRY:
     (add-hook 'Info-selection-hook (lambda () (recenter 45)))
     ;; Mozilla-like navigation:

     (define-key Info-mode-map [(meta right)] 'Info-follow-nearest-node)
     (define-key Info-mode-map [(meta left)]  'Info-last)
     (define-key Info-mode-map [(tab)]  'Info-next-reference)
     (define-key Info-mode-map [(shift tab)] 'Info-prev-reference)
     (define-key Info-mode-map [(shift iso-lefttab)] 'Info-prev-reference)
     (define-key Info-mode-map [(shift f7)] (lambda () (interactive) (Info-search (car Info-search-history))))
     ;; Lynx-like navigation:
     (define-key Info-mode-map [(meta up)]
       (lambda ()
         (interactive)
         (my-prev-link-or-scroll-page-backward
          (save-excursion
            (ignore-errors

              (Info-prev-reference))
            (point)))))
     (define-key Info-mode-map [(meta down)]
       (lambda ()
         (interactive)
         (my-next-link-or-scroll-page-forward
          (save-excursion
            (ignore-errors
              (Info-next-reference))
            (point)))))
     ;; more/less scrolling style
     (define-key Info-mode-map [return] 'View-scroll-line-forward)
     ;; ThinkPad additional keys, try to use them

     (when (equal (upcase system-name) "THINKPAD")
       (define-key Info-mode-map [osfPrior] 'Info-last)
       (define-key Info-mode-map [osfNext] 'Info-follow-nearest-node))))

(eval-after-load "man"
  '(progn
     ;; Mozilla-like navigation:

     (define-key Man-mode-map [(meta right)] 'man-follow)
     (define-key Man-mode-map [(meta left)] 'quit-window)
     ;; Lynx-like navigation:
     (define-key Man-mode-map [(meta up)]
       (lambda ()
          (interactive)
          (my-prev-link-or-scroll-page-backward
           (save-excursion
             (ignore-errors (Man-previous-section 1))
             (point)))))
     (define-key Man-mode-map [(meta down)]
       (lambda ()
          (interactive)
          (my-next-link-or-scroll-page-forward
           (save-excursion

             (ignore-errors (Man-next-section 1))
             (point)))))
     (define-key Man-mode-map [f2] 'toggle-truncate-lines)
     ;; (define-key view-mode-map [tab] 'other-window) ; used for next-ref
     ;; more/less scrolling style
     (define-key Man-mode-map [return] 'View-scroll-line-forward)))

;; NOTE that 'help-next-ref' is better than 'Info-next-reference'
;; because it uses 'message' instead of 'error' if "No cross references"
(eval-after-load "help"
  '(progn

            ;; View mode steals key bindings from us.
            ;; doesn't work (set (make-local-variable 'overriding-local-map) (copy-keymap view-mode-map))
            ;; does exist better method than (car (current-minor-mode-maps))?
            ;; Mozilla-like navigation:
; DOESN'T WORK (current-minor-mode-maps)
;             (define-key (car (current-minor-mode-maps)) [(meta left)]  'help-go-back)
;             (define-key (car (current-minor-mode-maps)) [(meta right)] 'help-follow)
            ;; Lynx-like navigation:
; DOESN'T WORK (current-minor-mode-maps)
;             (define-key (car (current-minor-mode-maps)) [(meta up)]
;               (lambda () (interactive)
;                  (my-prev-link-or-scroll-page-backward
;                    (save-excursion
;                      (ignore-errors (help-previous-ref))
;                      (point)))))
;             (define-key (car (current-minor-mode-maps)) [(meta down)]
;               (lambda () (interactive)
;                  (my-next-link-or-scroll-page-forward
;                    (save-excursion
;                      (ignore-errors (help-next-ref))
;                      (point)))))
            ))

;;; dictionary

(defvar my-dict-history nil
  "History list for previous word definitions.")

(defun my-dict-search-word (word &optional output-buffer)
  "Search the word under point (by default) or entered from minibuffer,
if prefix argument is not null. Search is preformed using
external program `dict2'. The output appears in the buffer `*Dictionary*'.
If the output is one line, it is displayed in the echo area.
If OUTPUT-BUFFER is not nil, or prefix argument is not nil or 0,
then output is inserted in current buffer."

  (interactive
   (let* ((default (if (and transient-mark-mode mark-active)
                       (buffer-substring-no-properties
                        (region-beginning) (region-end))
                     (current-word)))
          (value (if t;; (not (null current-prefix-arg))
                     (read-from-minibuffer
                      "Search word: " default nil nil 'my-dict-history)
                   default)))
     (list (if (equal value "") default value)
           (if (not (equal current-prefix-arg 0)) current-prefix-arg))))
  (let* ((new-buffer-name (or output-buffer "*Dictionary*"))) ; (concat "*Dictionary " word "*")

    (shell-command (concat "dict2 \"" word "\"") new-buffer-name)
    (if (member new-buffer-name (mapcar (function buffer-name) (buffer-list)))
        (with-current-buffer new-buffer-name
          ;; (my-windows-balance)
          (goto-char (point-min))
          (while (re-search-forward "{+\\([^}]+\\)}+" nil t)
            (let* ((link-text (match-string 1))
                   (link-value link-text))
              (replace-match "")        ; create widget in place of text

              (while (string-match "\n\\s-*" link-value) ; multi-line links
                (setq link-value (replace-match " " t t link-value)))
              (widget-create 'link
                             :format (concat "%[" link-text "%]")
                             :button-face 'info-xref
                             :notify (lambda (widget &rest ignore)
                                       (push (widget-value widget) my-dict-history)
                                       (my-dict-search-word (widget-value widget)))
                             :button-prefix ""

                             :button-suffix ""
                             link-value)))
          (goto-char (point-min))
          (setq buffer-read-only nil)
          ;; (toggle-read-only 1) ;; don't use view mode, but instead use it's keymap
          ;; is it right? (another solution is in help-mode-hook)
          (select-window (get-buffer-window new-buffer-name))
          (setq view-return-to-alist
                (list (cons (selected-window) (cons (next-window (selected-window)) t))))
          ;; make major or minor mode for *Dictionary <word>* buffers
          ;; TODO: use (local-set-key) instead

          ;; (use-local-map widget-keymap)
          (use-local-map (copy-keymap view-mode-map))
          (set-keymap-parent (current-local-map) widget-keymap)
          ;; Mozilla-like navigation:
          (define-key (current-local-map) [(meta right)] 'widget-button-press)
          ;; Lynx-like navigation:
          (define-key (current-local-map) [(meta left)]
            (lambda () (interactive)
               (pop my-dict-history)
               (my-dict-search-word (car my-dict-history))))
          (define-key (current-local-map) [(meta up)]
            (lambda ()
               (interactive)
               (my-prev-link-or-scroll-page-backward
                (save-excursion

                  (ignore-errors
                    (widget-backward 1))
                  (point)))))
          (define-key (current-local-map) [(meta down)]
            (lambda ()
               (interactive)
               (my-next-link-or-scroll-page-forward
                (save-excursion
                  (ignore-errors
                    (widget-forward 1))
                  (point)))))
          (define-key (current-local-map) "q"

            (lambda () (interactive) (view-mode) (View-quit))) ; works only in view-mode
          )
      (delete-other-windows))))

;; (push "*Dictionary*" pop-up-frames)

;;; calendar

(define-key my-map "d" 'calendar) ; "d" = diary


;;; diary

(setq diary-file (concat (my-home ?h) "/.diary"))

(add-hook 'diary-hook 'appt-make-list)
;; (add-hook 'diary-display-hook 'fancy-diary-display)

;; My diary entries are only in ISO date format, so override all other formats
;; If other date formats exist, then use next (add ISO to existing):
;; (setq diary-date-forms (cons '(year "-" month "-" day "[^0-9]") diary-date-forms))

;; (diary)
;; (calendar)

;;; w3

(setq w3-default-stylesheet "~/.default.css")
(eval-after-load "w3"

  '(progn
     ;; Mozilla-like navigation:
     (define-key w3-mode-map [(meta right)] 'widget-button-press)
     (define-key w3-mode-map [(meta left)] 'w3-history-backward)
     (define-key w3-mode-map [(meta down)] 'w3-widget-forward)
     (define-key w3-mode-map [(meta up)] 'w3-widget-backward)
     ;; more/less scrolling style
     (define-key w3-mode-map [return] 'View-scroll-line-forward)
     ;; (setq w3-use-terminal-glyphs nil)
     ;; (fset 'w3-fetch-orig (symbol-function 'w3-fetch))
     ;; (defun w3-fetch (&optional url target)

     ;;   (interactive (list (w3-read-url-with-default)))
     ;;   (if (eq major-mode 'gnus-article-mode)
     ;;       (browse-url url)
     ;;     (w3-fetch-orig url target)))
     ))

;;; w3m

(eval-after-load "w3m.elc"

  '(progn
     ;; Mozilla-like navigation:
     (define-key w3m-mode-map [(meta right)] 'w3m-view-this-url)
     (define-key w3m-mode-map [(meta left)]  'w3m-view-previous-page)
     (define-key w3m-mode-map [(meta shift right)] 'w3m-view-this-url-new-session)
     (define-key w3m-mode-map [(control return)] 'w3m-view-this-url-new-session)
     ;; Lynx-like navigation:
     (define-key w3m-mode-map [(meta up)]
       (lambda ()
         (interactive)
         (my-prev-link-or-scroll-page-backward
          (save-excursion
            (ignore-errors (w3m-previous-anchor))
            (point)))))
     (define-key w3m-mode-map [(meta down)]
       (lambda ()
         (interactive)
         (my-next-link-or-scroll-page-forward
          (save-excursion

            (ignore-errors (w3m-next-anchor))
            (point)))))
     ;; more/less scrolling style if point is not on URL
     (define-key w3m-mode-map [return]
       (lambda ()
         (interactive)
         (if (or (not (w3m-anchor))
                 (eq (point) (save-excursion (move-to-window-line -1) (point))))
             (View-scroll-line-forward)
           (w3m-view-this-url))))
     ;; Tabs navigation (useful when tabs are visible):

     ;; to avoid conflict with (control tab) calling ee-buffers,
     ;; w3m could be used in the separate frame
     (define-key w3m-mode-map [(control tab)] 'w3m-next-buffer)
     (define-key w3m-mode-map [(control shift tab)] 'w3m-previous-buffer)
     (define-key w3m-mode-map [(control shift iso-lefttab)] 'w3m-previous-buffer)
     ;; Add emacs version and gnu/linux version
     (setq w3m-user-agent (concat
                           "Emacs-w3m/" emacs-w3m-version
                           " " w3m-version
                           " Emacs/" emacs-version
                           (if (string-match "[Ll]inux" system-configuration)
                               (concat " (" system-configuration ")")
                             "")))
     ;; (my-faces-set)

     ))

(add-hook
 'w3m-display-hook
 (lambda (url)
   ;; but better idea is display these names only in buffer list
   (rename-buffer
    (generate-new-buffer-name
     (concat "*w3m*<"
             w3m-current-title
             ;; (substring w3m-current-title 0 (min (length w3m-current-title) 11))
             ">")))))


;;; gnus

(define-key my-map "g" 'gnus)
;; (define-key my-map "g" (lambda () (gnus 3)))
;; (define-key my-map "G" 'gnus-no-server)
;; BAD?:
(define-key my-map "G" (lambda () (interactive)
                          (gnus-no-server)
                          ;; BUG? mail groups don't come automatically
                          (gnus-group-jump-to-group "nnml:mail.inbox")))
(define-key my-map "Q" 'smtpmail-send-queued-mail)

(eval-after-load "gnus"

  '(progn
     (setq gnus-group-line-format "%M%m%S%p%P%4y:%B%(%-30,30g%) %3T %5t %2I %o %s\n")
     ;; (setq gnus-group-line-format "%M%S%5y: %(%-30,30g%) %9,9~(cut 4)d %5t %2I %2T %o %n %s\n")
     (setq gnus-message-archive-group
           '((lambda (group)
               (if (or (message-news-p)
                       (not group)
                       (and (stringp group)
                            (or (eq (length group) 0)
                                (string-match "^nnml:list\." gnus-newsgroup-name)
                                (not (string-match "^nnml:" gnus-newsgroup-name)))))
                   "nnml:archive"

                 group))))
     (define-key gnus-group-mode-map [tab] 'gnus-group-next-unread-group)
     (define-key gnus-group-mode-map [(shift iso-lefttab)] 'gnus-group-prev-unread-group)

;;      (setq message-required-mail-headers
;;            (nconc message-required-mail-headers
;;                   (list '(X-Face . ")\"~C=98Lq,\\7*A~m2T<$:a0M,-gT(-VJBt&X=Qy&eU])Ebih-1gS7Af)=W59R7TEgvNX~X!
;;  W\\zn4kY^u%OD]D]+\"T\\{Ky9}n5X0?2NaOO!CmwDa?Ul8=>?h)AUqd@TR\"<=|V`FXM0z$aV<kyRZDk;
;;  Rv%3Y`??;h1(4yZ"))))
;;      (setq message-required-mail-head