[submodule "emacsstuff"]
path = emacsstuff
url = git://g0dil.de/emacsstuff.git
+[submodule "git-modes"]
+ path = git-modes
+ url = https://github.com/magit/git-modes.git
--- /dev/null
+;;; cl-lib.el --- Properly prefixed CL functions and macros -*- coding: utf-8 -*-
+
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+;; vcomment: Emacs-24.3's version is 1.0 so this has to stay below.
+;; Version: 0.4
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a forward compatibility package, which provides (a subset of) the
+;; features of the cl-lib package introduced in Emacs-24.3, for use on
+;; previous emacsen.
+
+;; Make sure this is installed *late* in your `load-path`, i.e. after Emacs's
+;; built-in .../lisp/emacs-lisp directory, so that if/when you upgrade to
+;; Emacs-24.3, the built-in version of the file will take precedence, otherwise
+;; you could get into trouble (although we try to hack our way around the
+;; problem in case it happens).
+
+;; This code is largely copied from Emacs-24.3's cl.el, with the alias bindings
+;; simply reversed.
+
+;;; Code:
+
+(when (functionp 'macroexp--compiler-macro)
+ ;; `macroexp--compiler-macro' was introduced as part of the big CL
+ ;; reorganization which moved/reimplemented some of CL into core (mostly the
+ ;; setf and compiler-macro support), so its presence indicates we're running
+ ;; in an Emacs that comes with the new cl-lib.el, where this file should
+ ;; never be loaded!
+ (message "Real cl-lib shadowed by compatibility cl-lib? (%s)" load-file-name)
+ (when load-file-name
+ ;; (message "Let's try to patch things up")
+ (let ((loaddir (file-name-directory load-file-name))
+ load-path-dir)
+ ;; Find the problematic directory from load-path.
+ (dolist (dir load-path)
+ (if (equal loaddir (expand-file-name (file-name-as-directory dir)))
+ (setq load-path-dir dir)))
+ (when load-path-dir
+ ;; (message "Let's move the offending dir to the end")
+ (setq load-path (append (remove load-path-dir load-path)
+ (list load-path-dir)))
+ ;; Here we could manually load cl-lib and then return immediately.
+ ;; But Emacs currently doesn't provide any way for a file to "return
+ ;; immediately", so instead we make sure the rest of the file does not
+ ;; throw away any pre-existing definition.
+ ))))
+
+(require 'cl)
+
+;; Some of Emacs-24.3's cl.el definition are not just aliases, because either
+;; the feature was dropped from cl-lib.el or because the cl-lib version is
+;; not fully compatible.
+;; Let's just not include them here, since it is very important that if code
+;; works with this cl-lib.el it should also work with Emacs-24.3's cl-lib.el,
+;; whereas the reverse is much less important.
+
+(dolist (var '(
+ ;; loop-result-var
+ ;; loop-result
+ ;; loop-initially
+ ;; loop-finally
+ ;; loop-bindings
+ ;; loop-args
+ ;; bind-inits
+ ;; bind-block
+ ;; lambda-list-keywords
+ float-negative-epsilon
+ float-epsilon
+ least-negative-normalized-float
+ least-positive-normalized-float
+ least-negative-float
+ least-positive-float
+ most-negative-float
+ most-positive-float
+ ;; custom-print-functions
+ ))
+ (let ((new (intern (format "cl-%s" var))))
+ (unless (boundp new) (defvaralias new var))))
+
+;; The following cl-lib functions were already defined in the old cl.el,
+;; with a different meaning:
+;; - cl-position and cl-delete-duplicates
+;; the two meanings are clearly different, but we can distinguish which was
+;; meant by looking at the arguments.
+;; - cl-member
+;; the old meaning hasn't been used for a long time and is a subset of the
+;; new, so we can simply override it.
+;; - cl-adjoin
+;; the old meaning is actually the same as the new except for optimizations.
+
+(dolist (fun '(
+ (get* . cl-get)
+ (random* . cl-random)
+ (rem* . cl-rem)
+ (mod* . cl-mod)
+ (round* . cl-round)
+ (truncate* . cl-truncate)
+ (ceiling* . cl-ceiling)
+ (floor* . cl-floor)
+ (rassoc* . cl-rassoc)
+ (assoc* . cl-assoc)
+ ;; (member* . cl-member) ;Handle specially below.
+ (delete* . cl-delete)
+ (remove* . cl-remove)
+ (defsubst* . cl-defsubst)
+ (sort* . cl-sort)
+ (function* . cl-function)
+ (defmacro* . cl-defmacro)
+ (defun* . cl-defun)
+ (mapcar* . cl-mapcar)
+
+ remprop
+ getf
+ tailp
+ list-length
+ nreconc
+ revappend
+ concatenate
+ subseq
+ random-state-p
+ make-random-state
+ signum
+ isqrt
+ lcm
+ gcd
+ notevery
+ notany
+ every
+ some
+ mapcon
+ mapcan
+ mapl
+ maplist
+ map
+ equalp
+ coerce
+ tree-equal
+ nsublis
+ sublis
+ nsubst-if-not
+ nsubst-if
+ nsubst
+ subst-if-not
+ subst-if
+ subsetp
+ nset-exclusive-or
+ set-exclusive-or
+ nset-difference
+ set-difference
+ nintersection
+ intersection
+ nunion
+ union
+ rassoc-if-not
+ rassoc-if
+ assoc-if-not
+ assoc-if
+ member-if-not
+ member-if
+ merge
+ stable-sort
+ search
+ mismatch
+ count-if-not
+ count-if
+ count
+ position-if-not
+ position-if
+ ;; position ;Handle specially via defadvice below.
+ find-if-not
+ find-if
+ find
+ nsubstitute-if-not
+ nsubstitute-if
+ nsubstitute
+ substitute-if-not
+ substitute-if
+ substitute
+ ;; delete-duplicates ;Handle specially via defadvice below.
+ remove-duplicates
+ delete-if-not
+ delete-if
+ remove-if-not
+ remove-if
+ replace
+ fill
+ reduce
+ compiler-macroexpand
+ define-compiler-macro
+ assert
+ check-type
+ typep
+ deftype
+ defstruct
+ callf2
+ callf
+ letf*
+ letf
+ rotatef
+ shiftf
+ remf
+ psetf
+ declare
+ the
+ locally
+ multiple-value-setq
+ multiple-value-bind
+ symbol-macrolet
+ macrolet
+ progv
+ psetq
+ do-all-symbols
+ do-symbols
+ dotimes
+ dolist
+ do*
+ do
+ loop
+ return-from
+ return
+ block
+ etypecase
+ typecase
+ ecase
+ case
+ load-time-value
+ eval-when
+ destructuring-bind
+ gentemp
+ gensym
+ pairlis
+ acons
+ subst
+ ;; adjoin ;It's already defined.
+ copy-list
+ ldiff
+ list*
+ cddddr
+ cdddar
+ cddadr
+ cddaar
+ cdaddr
+ cdadar
+ cdaadr
+ cdaaar
+ cadddr
+ caddar
+ cadadr
+ cadaar
+ caaddr
+ caadar
+ caaadr
+ caaaar
+ cdddr
+ cddar
+ cdadr
+ cdaar
+ caddr
+ cadar
+ caadr
+ caaar
+ tenth
+ ninth
+ eighth
+ seventh
+ sixth
+ fifth
+ fourth
+ third
+ endp
+ rest
+ second
+ first
+ svref
+ copy-seq
+ evenp
+ oddp
+ minusp
+ plusp
+ floatp-safe
+ declaim
+ proclaim
+ nth-value
+ multiple-value-call
+ multiple-value-apply
+ multiple-value-list
+ values-list
+ values
+ pushnew
+ decf
+ incf
+
+ dolist
+ dotimes
+ ))
+ (let ((new (if (consp fun) (prog1 (cdr fun) (setq fun (car fun)))
+ (intern (format "cl-%s" fun)))))
+ (if (fboundp new)
+ (unless (or (eq (symbol-function new) fun)
+ (eq new (and (symbolp fun) (fboundp fun)
+ (symbol-function fun))))
+ (message "%S already defined, not rebinding" new))
+ (defalias new fun))))
+
+(autoload 'cl-position "cl-seq")
+(defadvice cl-position (around cl-lib (cl-item cl-seq &rest cl-keys) activate)
+ (let ((argk (ad-get-args 2)))
+ (if (or (null argk) (keywordp (car argk)))
+ ;; This is a call to cl-lib's `cl-position'.
+ (setq ad-return-value
+ (apply #'position (ad-get-arg 0) (ad-get-arg 1) argk))
+ ;; Must be a call to cl's old `cl-position'.
+ ad-do-it)))
+
+(autoload 'cl-delete-duplicates "cl-seq")
+(defadvice cl-delete-duplicates (around cl-lib (cl-seq &rest cl-keys) activate)
+ (let ((argk (ad-get-args 1)))
+ (if (or (null argk) (keywordp (car argk)))
+ ;; This is a call to cl-lib's `cl-delete-duplicates'.
+ (setq ad-return-value
+ (apply #'delete-duplicates (ad-get-arg 0) argk))
+ ;; Must be a call to cl's old `cl-delete-duplicates'.
+ ad-do-it)))
+
+(when (or (not (fboundp 'cl-member))
+ (eq (symbol-function 'cl-member) #'memq))
+ (defalias 'cl-member #'member*))
+
+;; `cl-labels' is not 100% compatible with `labels' when using dynamic scoping
+;; (mostly because it does not turn lambdas that refer to those functions into
+;; closures). OTOH it is compatible when using lexical scoping.
+
+(unless (fboundp 'cl-labels)
+ (defmacro cl-labels (&rest args)
+ (unless (and (boundp 'lexical-binding) lexical-binding)
+ ;; We used to signal an error rather than a message, but in many uses of
+ ;; cl-labels, the value of lexical-binding doesn't actually matter.
+ ;; More importantly, the value of `lexical-binding' here is unreliable
+ ;; (it does not necessarily reflect faithfully whether the output of this
+ ;; macro will be interpreted as lexically bound code or not).
+ (message "This `cl-labels' requires `lexical-binding' to be non-nil"))
+ `(labels ,@args)))
+
+;;;; ChangeLog:
+
+;; 2014-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * cl-lib.el: Resolve conflicts with old internal definitions
+;; (bug#16353).
+;; (dolist fun): Don't skip definitions silently.
+;; (define-setf-expander): Remove, not in cl-lib.
+;; (cl-position, cl-delete-duplicates): Add advice to distinguish the use
+;; case.
+;; (cl-member): Override old definition.
+;;
+;; 2013-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * cl-lib.el (cl-labels): Demote error to message and improve it.
+;;
+;; 2012-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * cl-lib.el: Try and patch things up in case we're hiding the real
+;; cl-lib.
+;;
+;; 2012-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; Add cl-letf and cl-labels.
+;;
+;; 2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca>
+;;
+;; * packages/cl-lib: New package.
+;;
+
+
+(provide 'cl-lib)
+;;; cl-lib.el ends here
--- /dev/null
+;;; framemove.el --- directional frame selection routines
+;;
+;; Copyright (C) 2010
+;;
+;; Author: Trey Jackson (bigfaceworm@gmail.com)
+;; Created: February 14, 2010
+;; Keywords: frame, movement, convenience
+;;
+;; This file is not (yet) a part of GNU Emacs.
+;;
+;; Very much like the windmove package, only for frames.
+;; Provide a simple set of keystrokes to move the input/focus
+;; between windows.
+;;
+;; Version 0.9
+;;
+;; This software is licensed under the GPL version 3.
+;;
+;; To install:
+;; (require 'framemove)
+;; (framemove-default-keybindings)
+;;
+;; If you want to integrate framemove and windmove
+;; You can omit the call to 'framemove-default-keybindings
+;; And instead do:
+;; (require 'framemove)
+;; (windmove-default-keybindings)
+;; (setq framemove-hook-into-windmove t)
+;;
+;; Compatibility: GNU Emacs 22.x, 23.x
+;;
+
+(defvar framemove-hook-into-windmove nil
+ "When non-nil, try moving frames if moving windows fails.")
+
+(defun fm-frame-bbox (frame)
+ ;; eval b/c when things are beyond borders, you get
+ ;; (+ -11) weirdness
+ (let ((yl (eval (frame-parameter frame 'top)))
+ (xl (eval (frame-parameter frame 'left))))
+ (list xl
+ yl
+ (+ xl (frame-pixel-width frame))
+ (+ yl (frame-pixel-height frame)))))
+
+(defun fm-opposite (dir)
+ (cdr (assq dir '((left . right) (right . left) (up . down) (down . up)))))
+
+(defun fm-frame-coord (frame-or-box dir)
+ (nth (cdr (assq dir '((left . 0) (up . 1) (right . 2) (down . 3))))
+ (if (framep frame-or-box)
+ (fm-frame-bbox frame-or-box)
+ frame-or-box)))
+
+(defun fm-frame-is-completly-to-dir-of (refframe dir otherframe)
+ (cond
+ ((eq refframe otherframe)
+ nil)
+ ((memq dir '(left up))
+ (< (fm-frame-coord refframe (fm-opposite dir)) (fm-frame-coord otherframe dir)))
+ ((memq dir '(right down))
+ (> (fm-frame-coord refframe (fm-opposite dir)) (fm-frame-coord otherframe dir)))
+ (t (error "Invalid direction of movement: %s" dir))))
+
+(defun fm-frame-is-to-dir-of (refframe dir otherframe)
+ (cond
+ ((not (eq (frame-parameter refframe 'display) (frame-parameter otherframe 'display)))
+ nil)
+ ((eq refframe otherframe)
+ nil)
+ ((memq dir '(left up))
+ (< (fm-frame-coord refframe dir) (fm-frame-coord otherframe dir)))
+ ((memq dir '(right down))
+ (> (fm-frame-coord refframe dir) (fm-frame-coord otherframe dir)))
+ (t (error "Invalid direction of movement: %s" dir))))
+
+(defun fm-absolute-coords-of-position (position)
+ (let ((rel-x-y (fm-frame-relative-coordinates position))
+ (frame-bbox (fm-frame-bbox (window-frame (posn-window position)))))
+ (cons (+ (car frame-bbox) (car rel-x-y))
+ (+ (cadr frame-bbox) (cdr rel-x-y)))))
+
+(defun fm-frame-relative-coordinates (position)
+ "Return frame-relative coordinates from POSITION."
+ (let* ((x-y (posn-x-y position))
+ (window (posn-window position))
+ (edges (window-inside-pixel-edges window)))
+ (cons (+ (car x-y) (car edges))
+ (+ (cdr x-y) (cadr edges)))))
+
+(defun fm-project (coord frame dir)
+ "project COORD in direction DIR to edge of FRAME"
+ (if (memq dir '(up down))
+ (cons (car coord)
+ (fm-frame-coord frame dir))
+ (cons (fm-frame-coord frame dir)
+ (cdr coord))))
+
+
+(defun fm-next-frame (dir)
+ "move focus to next frame in direction (from currently focused frame)"
+ (interactive (list
+ (intern (completing-read "Which direction: " '("up" "down" "left" "right") nil t))))
+ (let* ((thisframe (selected-frame))
+ (current-coords (fm-absolute-coords-of-position (posn-at-point)))
+ (coords-projected-in-dir (fm-project current-coords thisframe dir))
+ (possible-frames
+ (sort
+ (remove-if-not
+ '(lambda (f) (fm-frame-is-to-dir-of f dir thisframe))
+ (visible-frame-list))
+ '(lambda (f1 f2) (fm-frame-is-to-dir-of f1 (fm-opposite dir) f2)))))
+ (if possible-frames
+ (let ((frames-in-line-of-cursor
+ ;; try to find frame in line with cursor
+ (remove-if-not
+ '(lambda (f) (fm-coord-in-range current-coords dir f))
+ possible-frames))
+ (frames-in-line-of-frame
+ ;; find frame that overlaps current frame
+ ;; need to sort by distance from cursor
+ (sort
+ (remove-if-not
+ '(lambda (f) (fm-range-overlap thisframe f dir))
+ possible-frames)
+ '(lambda (f1 f2)
+ (< (fm-dist-from-coords coords-projected-in-dir f1)
+ (fm-dist-from-coords coords-projected-in-dir f2))))))
+ (select-frame-set-input-focus
+ (or (car frames-in-line-of-cursor)
+ (car frames-in-line-of-frame)
+ (car possible-frames))))
+ (error "No frame in that direction"))))
+
+(defun fm-dist-from-coords (coord frame)
+ "distance from coord to the bbox of the frame"
+ (let* ((x (car coord))
+ (y (cdr coord))
+ (x-in-range (fm-v-in-range x (fm-bbox-range 'left frame)))
+ (y-in-range (fm-v-in-range y (fm-bbox-range 'up frame)))
+ (x-dist (min (abs (- x (fm-frame-coord frame 'left)))
+ (abs (- x (fm-frame-coord frame 'right)))))
+ (y-dist (min (abs (- y (fm-frame-coord frame 'up)))
+ (abs (- y (fm-frame-coord frame 'down))))))
+ (cond ((and x-in-range y-in-range)
+ 0)
+ (x-in-range
+ y-dist)
+ (y-in-range
+ x-dist)
+ ((sqrt (+ (expt x-dist 2)
+ (expt y-dist 2)))))))
+
+(defun fm-v-in-range (v range)
+ (and (> v (car range))
+ (< v (cdr range))))
+
+(defun fm-bbox-range (dir box)
+ (if (memq dir '(up down))
+ (cons (fm-frame-coord box 'up)
+ (fm-frame-coord box 'down))
+ (cons (fm-frame-coord box 'left)
+ (fm-frame-coord box 'right))))
+
+(defun fm-range-overlap (f1 f2 dir)
+ "return true if the bbox'es of the two frames overlap using coords perpendicular to dir"
+ (let ((perp (if (memq dir '(up down)) 'left 'up))
+ (f1box (fm-frame-bbox f1))
+ (f2box (fm-frame-bbox f2)))
+ (or (fm-v-in-range (fm-frame-coord f1 perp) (fm-bbox-range perp f2))
+ (fm-v-in-range (fm-frame-coord f1 (fm-opposite perp)) (fm-bbox-range perp f2))
+ (fm-v-in-range (fm-frame-coord f2 perp) (fm-bbox-range perp f1))
+ (fm-v-in-range (fm-frame-coord f2 (fm-opposite perp)) (fm-bbox-range perp f1)))))
+
+(defun fm-coord-in-range (coord dir frame)
+ "return true if the coord can be projected in orientation of dir
+onto the bbox of the frame, or more simply, is the part of the coord
+perpendicular to DIR between the edges of frame perpendicular to DIR"
+ (let ((n (if (memq dir '(up down)) (car coord) (cdr coord)))
+ (perp (if (memq dir '(up down)) 'left 'up)))
+ (and (< (fm-frame-coord frame perp) n)
+ (> (fm-frame-coord frame (fm-opposite perp)) n))))
+
+(defun fm-sort-frames-by-edge (framelist dir)
+ (sort
+ framelist
+ (lambda (f1 f2)
+ (apply (symbol-function
+ (if (memq dir '(left up)) '> '<))
+ (list (fm-frame-coord f1 dir) (fm-frame-coord f2 dir))))))
+
+;;;###autoload
+(defun fm-down-frame ()
+ (interactive)
+ (fm-next-frame 'down))
+;;;###autoload
+(defun fm-up-frame ()
+ (interactive)
+ (fm-next-frame 'up))
+;;;###autoload
+(defun fm-left-frame ()
+ (interactive)
+ (fm-next-frame 'left))
+;;;###autoload
+(defun fm-right-frame ()
+ (interactive)
+ (fm-next-frame 'right))
+
+;;;###autoload
+(defun framemove-default-keybindings (&optional modifier)
+ "Set up keybindings for `framemove'.
+Keybindings are of the form MODIFIER-{left,right,up,down}.
+Default MODIFIER is 'meta."
+ (interactive)
+ (unless modifier (setq modifier 'meta))
+
+ (global-set-key (vector (list modifier 'down)) 'fm-down-frame)
+ (global-set-key (vector (list modifier 'up)) 'fm-up-frame)
+ (global-set-key (vector (list modifier 'left)) 'fm-left-frame)
+ (global-set-key (vector (list modifier 'right)) 'fm-right-frame))
+
+(defadvice windmove-do-window-select (around framemove-do-window-select-wrapper activate)
+ "Let windmove do its own thing, if there is an error, try framemove in that direction."
+ (condition-case err
+ ad-do-it
+ (error
+ (if framemove-hook-into-windmove
+ (fm-next-frame (ad-get-arg 0))
+ (error (error-message-string err))))))
+
+(provide 'framemove)
+;;; framemove.el ends here
--- /dev/null
+Subproject commit 0cd113d7c14090e660807fea4be0116003925d2b
--- /dev/null
+(defun my-find-file-at-point-with-line ()
+ "Opens the file at point and goes to line-number."
+ (interactive)
+ (let ((fname (ffap-file-at-point)))
+ (if fname
+ (let ((line
+ (save-excursion
+ (goto-char (cadr ffap-string-at-point-region))
+ (and (re-search-backward ":\\([0-9]+\\)"
+ (line-beginning-position) t)
+ (string-to-int (match-string 1))))))
+ ;; (message "file:%s,line:%s" fname line)
+ (when (and (tramp-tramp-file-p default-directory)
+ (= ?/ (aref fname 0)))
+ ;; if fname is an absolute path in remote machine, it will not return a tramp path,fix it here.
+ (let ((pos (position ?: default-directory)))
+ (if (not pos) (error "failed find first tramp indentifier ':'"))
+ (setf pos (position ?: default-directory :start (1+ pos)))
+ (if (not pos) (error "failed find second tramp indentifier ':'"))
+ (setf fname (concat (substring default-directory 0 (1+ pos)) fname))))
+ (message "fname:%s" fname)
+ (find-file-existing fname)
+ (when line (goto-line line)))
+ (error "File does not exist."))))
+
+(global-set-key (kbd "C-c C-x C-f") 'my-find-file-at-point-with-line)
\ No newline at end of file
projects / emacs-init.git / commitdiff