Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

162 line
6.4 KiB

5 年之前
  1. ;;; haskell-menu.el --- A Haskell sessions menu -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2013 Chris Done
  3. ;; Author: Chris Done <chrisdone@gmail.com>
  4. ;; This file is not part of GNU Emacs.
  5. ;; This file is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation; either version 3, or (at your option)
  8. ;; any later version.
  9. ;; This file is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with GNU Emacs; see the file COPYING. If not, write to
  15. ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16. ;; Boston, MA 02110-1301, USA.
  17. ;;; Commentary:
  18. ;;; Todo:
  19. ;;; Code:
  20. (require 'cl-lib)
  21. (require 'haskell-compat)
  22. (require 'haskell-session)
  23. (require 'haskell-process)
  24. (require 'haskell-interactive-mode)
  25. (defcustom haskell-menu-buffer-name "*haskell-menu*"
  26. "The name of the Haskell session menu buffer"
  27. :group 'haskell-interactive
  28. :type 'string)
  29. ;;;###autoload
  30. (defun haskell-menu ()
  31. "Launch the Haskell sessions menu."
  32. (interactive)
  33. (or (get-buffer haskell-menu-buffer-name)
  34. (with-current-buffer (get-buffer-create haskell-menu-buffer-name)
  35. (haskell-menu-mode)))
  36. (switch-to-buffer-other-window (get-buffer haskell-menu-buffer-name))
  37. (haskell-menu-revert-function nil nil))
  38. (defvar haskell-menu-mode-map
  39. (let ((map (make-sparse-keymap)))
  40. (define-key map (kbd "n") 'next-line)
  41. (define-key map (kbd "p") 'previous-line)
  42. (define-key map (kbd "RET") 'haskell-menu-mode-ret)
  43. map)
  44. "Keymap for `haskell-menu-mode'.")
  45. (define-derived-mode haskell-menu-mode special-mode "Haskell Session Menu"
  46. "Major mode for managing Haskell sessions.
  47. Each line describes one session.
  48. Letters do not insert themselves; instead, they are commands."
  49. (setq buffer-read-only t)
  50. (setq-local revert-buffer-function 'haskell-menu-revert-function)
  51. (setq truncate-lines t)
  52. (haskell-menu-revert-function nil t))
  53. (suppress-keymap haskell-menu-mode-map t)
  54. (defun haskell-menu-revert-function (_arg1 _arg2)
  55. "Function to refresh the display."
  56. (let ((buffer-read-only nil)
  57. (orig-line (line-number-at-pos))
  58. (orig-col (current-column)))
  59. (or (eq buffer-undo-list t)
  60. (setq buffer-undo-list nil))
  61. (erase-buffer)
  62. (haskell-menu-insert-menu)
  63. (goto-char (point-min))
  64. (forward-line (1- orig-line))
  65. (forward-char orig-col)))
  66. (defun haskell-menu-insert-menu ()
  67. "Insert the Haskell sessions menu to the current buffer."
  68. (if (null haskell-sessions)
  69. (insert "No Haskell sessions.")
  70. (haskell-menu-tabulate
  71. (list "Name" "PID" "Time" "RSS" "Cabal directory" "Working directory" "Command")
  72. (mapcar (lambda (session)
  73. (let ((process (haskell-process-process (haskell-session-process session))))
  74. (cond
  75. (process
  76. (let ((id (process-id process)))
  77. (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer)
  78. (if (process-live-p process) (number-to-string id) "-")
  79. (if (process-live-p process)
  80. (format-time-string "%H:%M:%S"
  81. (encode-time (cl-caddr (assoc 'etime (process-attributes id)))
  82. 0 0 0 0 0))
  83. "-")
  84. (if (process-live-p process)
  85. (concat (number-to-string (/ (cdr (assoc 'rss (process-attributes id)))
  86. 1024))
  87. "MB")
  88. "-")
  89. (haskell-session-cabal-dir session)
  90. (haskell-session-current-dir session)
  91. (mapconcat 'identity (process-command process) " "))))
  92. (t (list (propertize (haskell-session-name session) 'face 'buffer-menu-buffer)
  93. ""
  94. ""
  95. ""
  96. (haskell-session-cabal-dir session)
  97. (haskell-session-current-dir session))))))
  98. haskell-sessions))))
  99. (defun haskell-menu-tabulate (headings rows)
  100. "Prints a list of lists as a formatted table to the current buffer."
  101. (let* ((columns (length headings))
  102. (widths (make-list columns 0)))
  103. ;; Calculate column widths. This is kind of hideous.
  104. (dolist (row rows)
  105. (setq widths
  106. (let ((list (list)))
  107. (dotimes (i columns)
  108. (setq list (cons (max (nth i widths)
  109. (1+ (length (nth i row)))
  110. (1+ (length (nth i headings))))
  111. list)))
  112. (reverse list))))
  113. ;; Print headings.
  114. (let ((heading (propertize " " 'display '(space :align-to 0))))
  115. (dotimes (i columns)
  116. (setq heading (concat heading
  117. (format (concat "%-" (number-to-string (nth i widths)) "s")
  118. (nth i headings)))))
  119. (setq header-line-format heading))
  120. ;; Print tabulated rows.
  121. (dolist (row rows)
  122. (dotimes (i columns)
  123. (insert (format (concat "%-" (number-to-string (nth i widths)) "s")
  124. (nth i row))))
  125. (insert "\n"))))
  126. (defun haskell-menu-mode-ret ()
  127. "Handle RET key."
  128. (interactive)
  129. (let* ((name (save-excursion
  130. (goto-char (line-beginning-position))
  131. (buffer-substring-no-properties (point)
  132. (progn (search-forward " ")
  133. (forward-char -1)
  134. (point)))))
  135. (session (car (cl-remove-if-not (lambda (session)
  136. (string= (haskell-session-name session)
  137. name))
  138. haskell-sessions))))
  139. (switch-to-buffer (haskell-session-interactive-buffer session))))
  140. (provide 'haskell-menu)
  141. ;;; haskell-menu.el ends here