.emacs

(tool-bar-mode 0)
(menu-bar-mode 0)
(setq inhibit-splash-screen t)

(setq text-mode-hook 'turn-on-auto-fill)

(auto-compression-mode t)

(setq next-line-add-newlines t)
(setq truncate-partial-width-windows nil)
(global-font-lock-mode 1)
(global-hl-line-mode t)
(toggle-uniquify-buffer-names)
(setq uniquify-buffer-name-style 'post-forward)

(setq history-length 500)
(setq history-delete-duplicates t)
(savehist-mode 1)


(add-to-list 'load-path (concat (getenv "HOME") "/elisp"))
(autoload 'dired-count-marked-files "dired-plus" "Count marked files." t)
(autoload 'dired-find-marked-files "dired-plus" "Count marked files." t)
(autoload 'goto-last-change "goto-last-change" "Go to the last edit." t)

(set-language-environment "Czech")
(set-input-method 'czech-qwerty)
(toggle-input-method)

; used as hard space
(global-set-key [?\C-`] (lambda () (interactive) (insert "~")))
(global-set-key [?\C-~] (lambda () (interactive) (insert-char 160)))

(global-set-key [?\C-<] (lambda () (interactive) (insert "‚")))
(global-set-key [?\C->] (lambda () (interactive) (insert "‘")))
(global-set-key [?\C-\"] (lambda () (interactive) (insert "’")))
(global-set-key [?\C-.] (lambda () (interactive) (insert "“")))
(global-set-key [?\C-,] (lambda () (interactive) (insert "„")))
(global-set-key [?\C-'] (lambda () (interactive) (insert "”")))

; key bindings
(global-set-key  [delete]   'delete-char)
(global-set-key  [home]     'beginning-of-buffer)
(global-set-key  [end]      'end-of-buffer)
(global-set-key  "\M-m"     'blink-matching-open)
(global-set-key  [?\M-/]    'hippie-expand)
(global-set-key  "\C-x\M-a" 'back-to-indentation)
(global-set-key  "\C-x\M-k" 'kill-some-buffers)
(global-set-key  "\C-xl"    'align-regexp)
(global-set-key  [?\C-%]    'occur)
(global-set-key  "\C-x%"    'occur-all-buffers)
(global-set-key  "\C-x\M-q" 'fill-region)
(global-set-key  [M-right]  'find-bracket-forward)
(global-set-key  [M-left]   'find-bracket-backward)
(global-set-key  "\C-x/"    'goto-last-change)
(global-set-key  "\C-xw"    'write-region)
(global-set-key  "\C-xt"    'tags-apropos)

(defun find-bracket-forward () "Move to the next bracket."
  (interactive)
  (search-forward-regexp "[][()/}{<>]"))

(defun find-bracket-backward () "Move to the previous bracket."
  (interactive)
  (search-backward-regexp "[][()/}{<>]"))

;;;; Progmodes

;; elisp
(defface font-lock-func-face
  '((nil (:foreground "slate blue")))
  "Font lock mode face for function calls."
  :group 'font-lock-highlighting-faces)

(defface font-lock-elisp-value
  '((nil (:foreground "tomato")))
  "Font lock mode face for nil and t."
  :group 'font-lock-highlighting-faces)

(font-lock-add-keywords
 'emacs-lisp-mode
 '(("\\_<\\(nil\\|t\\)\\_>"                1 'font-lock-elisp-value)
   ("(\\s-*\\(\\_<\\(?:[^: ()]\\)+\\)\\_>" 1 'font-lock-func-face))
 1)

(defun occur-all-buffers (regex) "Occur in all buffers"
  (interactive "sRegex to search for:")
  (multi-occur (buffer-list) regex))

;; perl
(defalias 'perl-mode 'cperl-mode)

(defun perl-boilerplate () "Basic perl template." (interactive)
  (if (not (file-exists-p (buffer-file-name (current-buffer))))
      (let ((strictures "use warnings;\nuse strict;\n\n#use Data::Dumper;\n\n"))
          (cond
           ((string-match "\.\\(?:p\\(?:er\\)?l\\|t\\)$" buffer-file-name)
            (insert
             (concat "#!/usr/bin/perl\n" strictures)))
           ((string-match "\\([^/]*\\)\.pm$" buffer-file-name)
            (insert
             (concat "package " (match-string 1 buffer-file-name) ";\n"
                     "\n=head1 " (match-string 1 buffer-file-name)
                     "\n\n=cut\n\n"
                     strictures
                     "\n__PACKAGE__\n"))
            (backward-char 14))))))
(add-hook 'cperl-mode-hook 'perl-boilerplate)
(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p)

(defun cperl-add-feature-say () "Add the 'say' pragma." (interactive)
  (save-excursion
    (goto-char (point-min))
    (if (search-forward "use feature" nil t) 
        (message "'use feature' already present.")
      (search-forward "use strict;\n")
      (insert "use feature qw{ say };\n")
      )))

(defun cperl-add-data-dumper () "Add the 'Data::Dumper' module." (interactive)
  (save-excursion
    (goto-char (point-min))
    (if (search-forward "use Data::Dumper" nil t) 
        (message "'use Data::Dumper' already present.")
      (search-forward "use strict;\n")
	  (forward-paragraph 1)
      (insert "use Data::Dumper;\n")
      )))

(defun cperl-run () "Save the buffer and run the code." (interactive)
  (save-buffer)
  (shell-command (concat "perl " (shell-quote-argument buffer-file-name))))

(defvaralias 'cperl-indent-level 'tab-width)

(eval-after-load "cperl-mode"
  '(progn (define-key cperl-mode-map "\C-c\C-s" 'cperl-add-feature-say)
          (define-key cperl-mode-map "\C-c\C-d" 'cperl-add-data-dumper)
          (define-key cperl-mode-map (kbd "<f5>") 'cperl-run)
          (define-key cperl-mode-map "\C-cm" 'cperl-build-manpage)))


(autoload 'php-mode "php-mode" "Mode for editing php." t)

;; alternative editor for pine
(setq auto-mode-alist
      (append
       '(("/pico\\." . mail-mode))
       auto-mode-alist))

(add-hook 'mail-mode-hook (lambda()
                            (make-face 'font-lock-re2-face)
                            (make-face 'font-lock-re3-face)
                            (set-face-foreground 'font-lock-re2-face "blue")
                            (set-face-foreground 'font-lock-re3-face "green3")
                            (font-lock-add-keywords 'mail-mode
                                                    '(("^[ \t]*>[ \t\f]*>.*$" (0 'font-lock-re2-face))))
                            (font-lock-add-keywords 'mail-mode
                                                    '(("^[ \t]*>[ \t\f]*>[ \t\f]*>.*$" (0 'font-lock-re3-face))))))

;; SGML, HTML
(require 'htmlize)
(defun sgml-html-mode () (interactive)
  (sgml-mode)
  (make-local-variable 'sgml-default-doctype-name)
  (setq
   sgml-default-doctype-name "html"
   sgml-always-quote-attributes t
   sgml-indent-step 2
   sgml-indent-data t
   sgml-auto-insert-required-elements t
   sgml-validate-command "nsgmls -s /usr/share/sgml/html/dtd/4.01/HTML4.decl %s %s"
   sgml-minimize-attribute nil
   sgml-omittag-transparent t
)
  (defun sgml-insert-entity (entity)
    (interactive
      (list
       (completing-read
        "Entity: " 
        (mapcar (function (lambda (x) (cons x x)))
                (sort (sgml-map-entities (function sgml-entity-name)
                                         (sgml-dtd-entities sgml-dtd-info)
                                         t)
                      (function string-lessp)))))
      )
    (insert (concat "&" entity ";"))
    )
  (defun sgml-br () (interactive) (insert "<br>")
    )
  (defun sgml-nbsp () (interactive) (insert "&nbsp;")
    )
  (local-set-key "\C-cn" 'sgml-insert-entity)
  (local-set-key "\C-cd" 'sgml-custom-dtd)
  (local-set-key "\C-c\C-j" 'sgml-br)
  (local-set-key "~" 'sgml-nbsp)
  (local-set-key "\C-cv" 'browse-url-of-buffer)
  (local-set-key "\C-cq" 'fill-region)
  )

(setq-default sgml-ident-data t)
(setq-default sgml-set-face t)
(setq sgml-auto-activate-dtd t)
(setq sgml-live-element-indicator t)
(setq sgml-recompile-out-of-date-cdtd "ask")
(setq sgml-custom-dtd
      '(
        ("HTML 4.01"
         "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
	("DocBk XML V3.1.7"
	 "<!DOCTYPE book PUBLIC \"-//Norman Walsh//DocBk XML V3.1.7//EN\" \"file:///usr/local/share/sgml/docbkx/docbookx.dtd\">")
	)
      )
(add-hook 'sgml-mode-hook 
          '(lambda () (setq sgml-indent-data t)
             (turn-on-auto-fill))
          )
(setq sgml-catalog-files 
      '("/etc/sgml/catalog" "/usr/share/sgml/html/dtd/catalog")
      )

; vc
;; (defun vc-cvs-tag-file ()
;;   "Tag the marked files with the given tag, ask for revisions."
;;   (interactive)
;;   (let* (tag
;;          rev
;;          (dir-length (length default-directory))
;;          (fileset (vc-deduce-fileset))
;;          (backend (pop fileset))
;;          (files (pop fileset)))
;;     (if (string= backend "CVS")
;;         (progn
;;           (setq tag (read-string "Tag (STAGE): " nil nil "STAGE"))
;;           (dolist (file files)
;;             (setq file (substring file dir-length))
;;             (vc-print-log-internal backend (list file) (vc-working-revision file))
;;             (setq rev (read-string (concat "Revision for " file ": ")))
;;             (vc-cvs-command (get-buffer-create "*vc-tag*") 0 file
;;                             "tag" "-F" "-l" "-r" rev tag))
;;           (switch-to-buffer-other-window "*vc-tag*")
;;           (message "%s" "Tagged."))
;;       (error "%s" "Tagging possible only in CVS"))))

(defun vc-git-push-quit () (interactive)
  (let ((old-buffer git-old-buffer))
    (set-buffer-modified-p nil)
    (kill-buffer)
    (switch-to-buffer old-buffer)))

(defun vc-git-push-redo () (interactive)
  (vc-git-push git-repo))

(define-derived-mode vc-git-push-mode fundamental-mode "push"
  "Show progress for git push."
  (local-set-key "r" 'vc-git-push-redo)
  (local-set-key "q" 'vc-git-push-quit)
  (toggle-read-only 1)) ; read-only-mode in 24.3

(defun vc-git-push (repo)
  "Push changes into a repository specified at prompt (or the default one)."
  (interactive "sRepository: ")
  (let ((command '("push"))
        (old-buffer)
        (push-buffer))
    (if (boundp 'git-old-buffer)
        (setq old-buffer git-old-buffer)
      (setq old-buffer (current-buffer)))
    (setq push-buffer (get-buffer-create "*vc-push*"))
    (when (> (length repo) 0) (setq command (append command (list repo))))
    (apply 'call-process "git" nil push-buffer t command)
    (when (not (local-variable-p 'repo)) (switch-to-buffer push-buffer))
    (vc-git-push-mode)
    (make-local-variable 'git-repo)
    (make-local-variable 'git-old-buffer)
    (setq git-repo repo)
    (setq git-old-buffer old-buffer)))

(defun vc-mark-matching (unmark regex)
  "Mark all matching files. ARG means unmark."
  (interactive "P\nsregex: ")
  (goto-char (point-min))
  (while (progn
           (when (search-forward-regexp regex)
             (if unmark
                 (vc-dir-unmark)
               (vc-dir-mark)))
           t)))

(setq vc-dir-mode-hook nil)
(add-hook 'vc-dir-mode-hook
          (lambda ()
            (define-key vc-prefix-map   [insert] 'vc-dir-show-fileentry)
            (define-key vc-dir-mode-map [insert] 'vc-dir-show-fileentry)
            (define-key vc-prefix-map   "!" 'vc-annotate)
            (define-key vc-dir-mode-map "!" 'vc-annotate)
            (define-key vc-prefix-map   "P" 'vc-git-push)
            (define-key vc-dir-mode-map "P" 'vc-git-push)
            (define-key vc-dir-mode-map "r" 'vc-mark-matching)))
(require 'magit)

; SVN
(autoload 'svn-status "psvn" "SVN status" t)
(add-hook 'diff-mode-hook
          '(lambda () (set-face-foreground 'diff-removed "red")
                      (set-face-foreground 'diff-added "green2")))

;; date
(global-set-key "\C-\M-d"
                (lambda (arg) (interactive "P")
                  (insert
                   (mapconcat (lambda (n) (format "%02d" n))
                              (mapcar (lambda (i)
                                        (nth i (decode-time)))
                                      '(5 4 3))
                              (if arg "/" "")))))

(if window-system
    (progn
      (set-default-font "-unknown-monofur-normal-normal-normal-*-13-*-*-*-m-0-iso10646-1")
                                        ;"-Misc-Misc Fixed-normal-normal-normal-*-13-*-*-*-c-70-iso10646-1")
      (scroll-bar-mode -1)
      (set-frame-width (selected-frame) 81)
      (set-frame-height (selected-frame) 50)
      (setq mouse-yank-at-point t)
      (if (member '(background-mode . light) (frame-parameters))
          (progn (set-face-background 'hl-line "white")
                 (set-face-background 'region "#ffef90")
                 (set-face-foreground 'region nil)
                 (set-background-color "beige")
                 )
        (set-face-background 'hl-line "black")
        (set-face-background 'region "#400040")
        )
      (set-face-inverse-video-p 'menu t)
      (set-face-foreground 'font-lock-comment-face "red")
      (server-start)
      (setq focus-follows-mouse nil)))

;; melpa
(require 'package)
(add-to-list 'package-archives
             ; '("melpa" . "http://stable.melpa.org/packages/")
             '("melpa" . "http://melpa.org/packages/")
             t)
(package-initialize)

;; GD
(smart-tabs-insinuate 'cperl)

;; 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.
 '(cperl-highlight-variables-indiscriminately t)
 '(cperl-indent-level 4)
 '(cperl-close-paren-offset -4)
 '(cperl-continued-statement-offset 4)
 '(cperl-indent-parens-as-block t)
 '(cperl-tab-always-indent t)
 '(delete-selection-mode nil)
 '(mark-even-if-inactive t)
 '(safe-local-variable-values (quote ((encoding . utf-8))))
 '(scroll-bar-mode nil)
 '(sentence-end-double-space nil)
 '(session-registers (quote ((48 . 57) t (32 . 127))))
 '(sgml-markup-faces (quote ((start-tag . font-lock-keyword-face) (end-tag . font-lock-keyword-face) (comment . font-lock-comment-face) (pi . font-lock-type-face) (sgml . underline) (doctype . font-lock-builtin-face) (entity . font-lock-constant-face) (shortref . bold))) t)
 '(transient-mark-mode 1)
 '(whitespace-style (quote (face trailing tabs tab-mark space-after-tab space-before-tab))))
(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.
 '(cperl-array-face ((t (:foreground "dodgerblue"))))
 '(cperl-hash-face ((t (:foreground "darkorange2"))))
 '(font-latex-sedate-face ((((class color) (background dark)) (:foreground "green3"))))
 '(font-lock-builtin-face ((t (:foreground "seagreen"))))
 '(font-lock-comment-face ((t (:foreground "red" :slant italic))))
 '(font-lock-string-face ((t (:foreground "peachpuff4"))))
 '(sh-quoted-exec ((((class color) (background dark)) (:foreground "green3")))))

;; disabled
(put 'narrow-to-region 'disabled nil)
(put 'upcase-region 'disabled nil)
(put 'downcase-region 'disabled nil)