The Kitchin Research Group

I am using git more and more in Emacs, and I would like a way to know the status of the git repo I am working in by looking at the modeline. I know about magit , and other git modes, but none of them provide something as easy as useful as say bash-git-prompt in the bash shell, which is to say I do not want to run a command to see the status (I might as well be in the shell then). Part of this need comes from a project with hundreds of git repos in it, and I want convenient status when I open any one of them.

Here, I want to emulate the bash-git-prompt feature in the Emacs modeline where it will show you when you are in a git repo, and then some basic information like what branch you are on, the number of untracked, modified files, and the commit status with respect to a remote. First, we only want this when we are in a git repo. We can check for that like this. The command in this block returns a string that starts with fatal when not in a git repo.

(not (string-match "^fatal" (shell-command-to-string "git rev-parse --git-dir")))

t

Let us wrap that in a nice function so we can use it later..

(defun in-git-p ()
  (not (string-match "^fatal" (shell-command-to-string "git rev-parse --git-dir"))))

(in-git-p)

t

Next, we would like to know how many untracked, modified and other (e.g. unmerged, deleted, etc…) files we have. We can get this from git status --porcelain. I am going to set these to be red if they are not zero, so they stand out, and be green otherwise. We will also store a list of each file type so we can make a tooltip on the counter to see what is there.

(defun git-parse-status ()
  (interactive)
  (let ((U 0)   ; untracked files
        (M 0)   ; modified files
        (O 0)   ; other files
        (U-files "")
        (M-files "")
        (O-files ""))
    (dolist (line (split-string
                   (shell-command-to-string "git status --porcelain")
                   "\n"))
      (cond

       ;; ignore empty line at end
       ((string= "" line) nil)

       ((string-match "^\\?\\?" line)
        (setq U (+ 1 U))
        (setq U-files (concat U-files "\n" line)))

       ((string-match "^ M" line)
        (setq M (+ 1 M))
        (setq M-files (concat M-files "\n" line))
        )

       (t
        (message "detected other in %s" line)
        (setq O (+ 1 O))
        (setq O-files (concat O-files "\n" line)))))
      
    ;; construct propertized string
    (concat
     "("
     (propertize 
      (format "M:%d" M)
      'face (list ':foreground (if (> M 0)
                                   "red"
                                 "forest green"))
      'help-echo M-files)
     "|"
     (propertize 
      (format "U:%d" U)
      'face (list ':foreground (if (> U 0)
                                   "red"
                                 "forest green"))
      'help-echo U-files)
     "|"
     (propertize 
      (format "O:%d" O)
      'face (list ':foreground (if (> O 0)
                                   "red"
                                 "forest green"))
      'help-echo O-files)                   
      ") ")))

(git-parse-status)

(M:1|U:2|O:0) 

Finally, let us get the branch we are on, and the commits with respect to a remote. We can do that like this. We use some unicode characters to indicate what direction things go, e.g. an up arrow to indicate you need to push, and a down arrow to indicate you should pull.

(defun git-remote-status ()
  (interactive)
  (let* (;; get the branch we are on.
         (branch (s-trim
                  (shell-command-to-string
                   "git rev-parse --abbrev-ref HEAD")))
         ;; get the remote the branch points to.
         (remote (s-trim
                  (shell-command-to-string
                   (format "git config branch.%s.remote" branch))))
         (remote-branch (s-trim
                         (shell-command-to-string
                          "git for-each-ref --format='%(upstream:short)' $(git symbolic-ref -q HEAD)")))
         (commits (split-string
                   (s-trim
                    (shell-command-to-string
                     (format
                      "git rev-list --count --left-right HEAD...%s"
                      remote-branch)))))
         (local (nth 0 commits))
         (remotes (nth 1 commits)))
    (concat
     "["
     (propertize
      (format "%s" branch)
      'face (list :foreground "magenta"))
     "|"
     (format "↑%s|↓%s" local remotes)
     "]"))) 

(git-remote-status)

[source|↑0|↓0]

Now, we can finally put this together in a little minor mode. We add an element to the mode-line-format variable that evaluates those functions. When we turn off the minor mode, we remove the element from the modeline.

(define-minor-mode git-mode
  "minor mode to put git repo status in modeline"
  nil nil nil
  (let ((git-modeline '(:eval (if (not (in-git-p))
                                  ""
                                (concat 
                                 (git-remote-status)
                                 (git-parse-status))))))
    (if git-mode
        ;; put in modeline
        (push git-modeline mode-line-format)
      ;; remove from modeline
      (setq mode-line-format
            (-remove (lambda (x)
                       (equal x git-modeline))                                  
                     mode-line-format)))))

This leads to a modeline that looks like this (when my mouse is hovered over the M):

This seems to have some performance issue, since pretty much everytime I type a key, it updates the modeline, and runs git. That is too often. Let us redefine the mode here so we have a minimum time between updates, say 15 seconds. We will store the last time updated, and the last value of the mode-line. Then each time the modeline updates, if the time since the last update is greater than our interval, then we will run the git commands. Otherwise, we just use the old modeline value.

(defvar git-modeline-last-update (float-time) "Last time we updated")
(defvar git-modeline-update-interval 15 "Minimum time between update in seconds")
(defvar git-modeline "" "Last value of the modeline")

(define-minor-mode git-mode
  "minor mode to put git repo status in modeline"
  nil nil nil
  (let ((git-modeline '(:eval (if
                                  (> (- (float-time) git-modeline-last-update)
                                     git-modeline-update-interval)
                                  ;; we are updating                              
                                  (setq git-modeline
                                        (if (not (in-git-p))
                                            ""                                   
                                          (setq  git-modeline-last-update (float-time))
                                          (concat 
                                           (git-remote-status)
                                           (git-parse-status))))
                                
                              ;; use last value of the modeline
                              git-modeline))))
    (if git-mode
        ;; put in modeline
        (push git-modeline mode-line-format)
      ;; remove from modeline
      (setq mode-line-format
            (-remove (lambda (x)
                       (equal x git-modeline))                                  
                     mode-line-format)))))

That does it I think. I don't have any performance issues here now. I have not tested this super thoroughly on many git repos, but it seems to be pretty consistent and correct so far. The remote status code is where there is the most probability for issues. I still do not know that part of git very well. I wonder if there is a more elegant solution than this, perhaps an idle timer. I notice a little lag in updating the data when I switch to another git repo. That might be a little confusing one day.

Otherwise, this seems like a pretty nice solution so far. There are still some things that would be nice to see on here. For example, a pop-up menu on the modeline to switch branches, push or pull, and with actions for the files, e.g. add/commit, etc… Those do not seem to hard to

Copyright (C) 2014 by John Kitchin. See the License for information about copying.

org-mode source

Org-mode version = 8.2.7c

As I continue investigating Emacs + org-mode as a platform for creating applications, it has come up a few times that it would be useful to display colored text. For example, in a summary report of a git repo, you might want to see some information in red, e.g. if you have uncommitted changes, and some information in green, e.g. the repo is clean and consistent with a remote.

We can set colors on a string in Emacs like this:

(propertize "Red Text" 'font-lock-face '(:foreground "red"))

The only tricky part is that we need to insert the text into a font-locked buffer to see it. That is also a tad tricky to illustrate in a code block, so here is a way to try it:

(re-search-forward "-> ")
(insert
  (propertize "Red Text" 'font-lock-face '(:foreground "red")))

-> Red Text

The red text does not show in the HTML post, so this is a screenshot of what it looks like in my buffer:

Now, here is how we might use this in a summary report. Say we have a git repo, and we want to know various facts about it. We can get information about tracked/ untracked and modified files like this:

git status --porcelain

 M _blog/blog.html
 M _blog/blog.org
A  _blog/images/red-text.png

This shows we have two tracked, but modified files, and on added but not committed file. We can use this code to show if we have any untracked files.

(let ((n 0) s)
  (dolist (line (split-string
                 (shell-command-to-string "git status --porcelain")
                 "\n"))
    (when (string-match "^\\?\\?" line)
      (setq n (+ 1 n))))
  (if (> n 0)
      (setq s (propertize (format "%s untracked files" n)
                          'font-lock-face '(:foreground "red")))
    (setq s (propertize "No untracked files" 
                        'font-lock-face '(:foreground "forest green"))))
  (re-search-forward "->")
  (insert s))

->No untracked files

In HTML (i.e. the blog post) you cannot really see the green text, so here is a screenshot illustrating it.

Similarly, we can check for modified files. We add a wrinkle and add a tooltip like text that shows the output of the git command.

(let ((n 0)
      (output (shell-command-to-string "git status --porcelain"))
      s)
  (dolist (line (split-string
                 output
                 "\n"))
    (when (string-match "^ M" line)
      (setq n (+ 1 n))))
  (if (> n 0)
      (setq s (propertize (format "%s modified files" n)
                          'help-echo output
                          'font-lock-face '(:foreground "red")))
    (setq s (propertize "No modified files" 
                        'font-lock-face '(:foreground "forest green"))))
  (re-search-forward "-> ")
  (insert s))

-> 2 modified files

That looks like this in emacs:

That is the main idea in this post. You can create strings with properties, and use code to determine what they e.g. what color the text is, etc… There are lots of properties listed at http://www.gnu.org/software/emacs/manual/html_node/elisp/Special-Properties.html that might be helpful in an application. Here are some previous posts that examined similar ideas.

• Read-only text http://kitchingroup.cheme.cmu.edu/blog/2014/09/13/Make-some-org-sections-read-only/
• Tool tips: http://kitchingroup.cheme.cmu.edu/blog/2013/04/12/Tool-tips-on-text-in-Emacs/
• Invisible text (this is not exactly a property, but it is similar)

http://kitchingroup.cheme.cmu.edu/blog/2014/02/06/Invisible-text-in-emacs/

Copyright (C) 2014 by John Kitchin. See the License for information about copying.

org-mode source

Org-mode version = 8.2.7c

There are times where I want an org-file to be partly read-only. For example, there might be instructions that should not be modified. In this post we consider how to implement that. For now, we only want an org-section to be read-only, and we will designate those sections by a tag read_only. Then, the idea is that a hook function would be run when the org-file is loaded, and mark regions of text as read-only before the user can do anything.

In Emacs, you can mark a section of text, and set it to have a property of read-only. So, we can just map over the entries, and any heading that is tagged as read_only can be made read-only!

Here we set the first few characters of this buffer to be read-only.

(add-text-properties 1 8 '(read-only t))

t

Emacs is semi-serious about what read-only means. You cannot even change properties of read-only text, unless you set inhibit-read-only as a variable.

(let ((inhibit-read-only t))
 (remove-text-properties 1 8 '(read-only t)))

t

Now, we can map over the entries in this buffer, and set any heading tagged read_only to actually be that way like this.

(org-map-entries (lambda ()
                   (let* ((element (org-element-at-point))
                          (begin (org-element-property :begin element))
                          (end (org-element-property :end element)))
                     (add-text-properties begin end '(read-only t))))
                 "read_only")

To get this to work when org-mode is turned on, we just wrap it in a function, add the function to a hook, and a function to undo the read-only behavior. I found that if I use the end reported by org-element-at-point, it includes the first character of the next section, we take one away from the end to avoid that.

(defun org-mark-readonly ()
  (interactive)
  (org-map-entries
   (lambda ()
     (let* ((element (org-element-at-point))
            (begin (org-element-property :begin element))
            (end (org-element-property :end element)))
       (add-text-properties begin (- end 1) '(read-only t))))
   "read_only")
 (message "Made readonly!"))


(defun org-remove-readonly ()
  (interactive)
  (org-map-entries
   (lambda ()
     (let* ((element (org-element-at-point))
            (begin (org-element-property :begin element))
            (end (org-element-property :end element))
            (inhibit-read-only t))
         (remove-text-properties begin (- end 1) '(read-only t))))
     "read_only"))

(add-hook 'org-mode-hook 'org-mark-readonly)

That seem to be all there is. After executing the code above, when I open this file, the next section is read-only! I can use the other function to remove that if I need to edit it. Score one for Emacs + org-mode!

Copyright (C) 2014 by John Kitchin. See the License for information about copying.

org-mode source

Org-mode version = 8.2.7c

I recently got a MacBook Air, and I have been exploring what you can do with it and Emacs. The Mac trackpad has some interesting gestures that are useful in Emacs. For example, you can scroll the buffer by moving two fingers up or down the trackpad. Or tap the trackpad with two fingers to get the equivalent of a right click. I was curious what other gestures could be used effectively in Emacs. Emacs does not capture all of the trackpad gestures, but it does capture the two finger swipe left and right as a triple-wheel-left or right key. We can use that to switch buffers. Normally one uses C-x leftarrow or right arrow to do that, but with the trackpack we can use a gesture!

The gesture triggers a triple-wheel key, which we can bind to an function. This code does that.

(global-set-key [triple-wheel-left] 'previous-buffer)
(global-set-key [triple-wheel-right] 'next-buffer)

next-buffer

This scrolls through buffers blazingly fast! Almost unusably fast. If you move very slow, you can get some control and switch one buffer at a time. Interestingly, I see these messages while gesturing slowly:

<wheel-left> is undefined
<double-wheel-left> is undefined
<wheel-right> is undefined
<double-wheel-right> is undefined
<wheel-right> is undefined [2 times]
<double-wheel-right> is undefined

We need a custom function that has some kind of delay to slow down the buffer switching. Here is an idea. We will store a value in a global variable, and only switch buffers when it is true. After we switch the buffer we set the variable to nil, and activate a timer to reset the variable to t after a short delay. say one second. Here it is.

(defvar *my-previous-buffer* t
  "can we switch?")

(defun my-previous-buffer ()
  (interactive)
  (message "custom prev: *my-previous-buffer*=%s" *my-previous-buffer*)
  (when *my-previous-buffer*
    (previous-buffer)
    (setq *my-previous-buffer* nil)
    (run-at-time "1 sec" nil (lambda ()
                               (setq *my-previous-buffer* t)))))

(defvar *my-next-buffer* t
  "can we switch?")

(defun my-next-buffer ()
  (interactive)
  (message "custom prev: *my-next-buffer*=%s" *my-next-buffer*)
  (when *my-next-buffer*
    (next-buffer)
    (setq *my-next-buffer* nil)
    (run-at-time "1 sec" nil (lambda ()
                               (setq *my-next-buffer* t)))))

(global-set-key [triple-wheel-right] 'my-previous-buffer)
(global-set-key [triple-wheel-left] 'my-next-buffer)

my-next-buffer

Note I reversed the left/right order. It seems that swiping left triggers the triple-wheel-right key. Go figure. Anyway, this makes the gesture actually usable, as it only changes one buffer at a time, with a short delay before you can change the buffer again. It is not a groundbreaking addition to Emacs, but it satisfied a curiousity itch for the day for me.

Copyright (C) 2014 by John Kitchin. See the License for information about copying.

org-mode source

Org-mode version = 8.2.7c

I have an application where I want a dynamic menu in Emacs, e.g. the menu auto-updates as things change on your computer. Here is a prototype example. We will make a menu that shows entries for each file in the current directory, and opens that entry.

We start by creating a menu that is initially empty like this. This menu will be called "My Files" in the menu.

(easy-menu-define jrk-menu global-map "MyMenu"
  '("My Files"))

Next, we create this function which will create a submenu with a vector entry for each file in this directory.

(defun get-menu ()
  (easy-menu-create-menu
   "Files"
   (mapcar (lambda (x)
             (vector (file-name-nondirectory x)
                     `(lambda () (interactive) (find-file ,x) t)))
           (f-glob "*"))))

get-menu

Next, we add the submenu. This is a one-time addition, which reflects the files in the directory at the time I ran this block.

(easy-menu-add-item jrk-menu '() (get-menu))

After you do that, the menu looks like this:

This menu is not yet dynamic. We need to create a function that can update the menu, and then add the function to a hook that runs each time the menu opens. Here is the code. The easy-menu-add-item function will replace the contents of an item by the same name, which we use here to update the menu.

(defun update-my-file-menu ()
  (easy-menu-add-item jrk-menu '() (get-menu)))

(add-hook 'menu-bar-update-hook 'update-my-file-menu)

Now, if we run this block to create a file:

touch newfile

Then, after saving this buffer the menu looks like this:

Now, every time a new file appears in this directory, a new menu item will appear every time you check the menu. That is really dynamic.

Copyright (C) 2014 by John Kitchin. See the License for information about copying.

org-mode source

Org-mode version = 8.2.7c