Emacs user interface to navigate Basecamp 3.
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.

206 lines
6.6KB

  1. ;;; bcel.el --- User interface to control basecamp -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2019 Damien Cassou
  3. ;; Author: Damien Cassou <damien@cassou.me>
  4. ;; Url: https://gitea.petton.fr/bcel/bcel
  5. ;; Package-requires: ((emacs "26.1") (libbcel "0.4.0"))
  6. ;; Version: 0.1.0
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; This program is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; An Emacs user-interface for Basecamp 3.
  19. ;;; Code:
  20. (require 'navigel)
  21. (require 'libbcel)
  22. (require 'bcel-chat)
  23. ;;;###autoload
  24. (defun bcel-list-projects ()
  25. "List all basecamp projects."
  26. (interactive)
  27. (let ((navigel-app 'bcel))
  28. (navigel-open 'projects nil)))
  29. (navigel-method bcel navigel-children (entity callback)
  30. (libbcel-nav-children entity callback))
  31. (navigel-method bcel navigel-name (entity)
  32. (libbcel-entity-name entity))
  33. (navigel-method bcel navigel-name ((symbol symbol))
  34. (symbol-name symbol))
  35. (navigel-method bcel navigel-equal ((entity1 libbcel-entity) (entity2 libbcel-entity))
  36. (libbcel-equal entity1 entity2))
  37. (navigel-method bcel navigel-parent ((entity libbcel-entity))
  38. (libbcel-entity-parent entity))
  39. ;;; Modes
  40. (define-derived-mode bcel-tablist-mode navigel-tablist-mode "bcel Tablist")
  41. (define-key bcel-tablist-mode-map (kbd "C-c C-o") #'bcel-browse)
  42. (define-key bcel-tablist-mode-map (kbd "c") #'bcel-chat)
  43. (define-derived-mode bcel-todolist-tablist-mode bcel-tablist-mode "bcel todos")
  44. (define-key bcel-todolist-tablist-mode-map (kbd "C-c C-c") #'bcel-todo-toggle)
  45. ;;; Listing projects:
  46. (navigel-method bcel navigel-tablist-format ((_entity (eql projects)))
  47. (vector (list "Name" 30 t)
  48. (list "Description" 0 nil)))
  49. (navigel-method bcel navigel-entity-to-columns ((project libbcel-project))
  50. (vector (libbcel-entity-name project)
  51. (or (libbcel-project-description project) "")))
  52. (navigel-method bcel navigel-entity-tablist-mode ((_entity (eql projects)))
  53. (bcel-tablist-mode))
  54. ;;; Listing tools:
  55. (navigel-method bcel navigel-tablist-format ((_project libbcel-project))
  56. (vector (list "Name" 50 t)))
  57. (navigel-method bcel navigel-entity-to-columns ((tool libbcel-tool))
  58. (vector (libbcel-entity-name tool)))
  59. (navigel-method bcel navigel-entity-tablist-mode ((_project libbcel-project))
  60. (bcel-tablist-mode))
  61. ;;; Listing messages
  62. (navigel-method bcel navigel-tablist-format ((_tool libbcel-message-board))
  63. (vector (list "Name" 50 t)
  64. (list "Comments" 5 nil)))
  65. (navigel-method bcel navigel-entity-to-columns ((message libbcel-message))
  66. (vector (libbcel-entity-name message)
  67. (format "%s" (libbcel-entity-comments-count message))))
  68. (navigel-method bcel navigel-entity-tablist-mode ((_tool libbcel-message-board))
  69. (bcel-tablist-mode))
  70. ;;; Listing todo lists:
  71. (navigel-method bcel navigel-tablist-format ((_tool libbcel-todoset))
  72. (vector (list "Name" 50 t)
  73. (list "Comments" 5 nil)))
  74. (navigel-method bcel navigel-entity-to-columns ((todo-list libbcel-todolist))
  75. (vector (libbcel-entity-name todo-list)
  76. (format "%s" (libbcel-entity-comments-count todo-list))))
  77. (navigel-method bcel navigel-entity-tablist-mode ((_tool libbcel-todoset))
  78. (bcel-tablist-mode))
  79. ;;; Listing todo items:
  80. (navigel-method bcel navigel-tablist-format ((_todolist libbcel-todolist))
  81. (vector (list "✔?" 3 t)
  82. (list "Name" 50 t)
  83. (list "Comments" 5 nil)))
  84. (navigel-method bcel navigel-entity-to-columns ((todo libbcel-todo))
  85. (vector (if (libbcel-todo-completed todo) "✔" "")
  86. (libbcel-entity-name todo)
  87. (format "%s" (libbcel-entity-comments-count todo))))
  88. (navigel-method bcel navigel-entity-tablist-mode ((_todolist libbcel-todolist))
  89. (bcel-todolist-tablist-mode))
  90. ;;; Listing comments
  91. (navigel-method bcel navigel-tablist-format ((_todolist libbcel-todolist))
  92. (vector (list "✔?" 3 t)
  93. (list "Name" 50 t)
  94. (list "Comments" 5 nil)))
  95. (navigel-method bcel navigel-entity-to-columns ((todo libbcel-todo))
  96. (vector (if (libbcel-todo-completed todo) "✔" "")
  97. (libbcel-entity-name todo)
  98. (format "%s" (libbcel-entity-comments-count todo))))
  99. (navigel-method bcel navigel-entity-tablist-mode ((_todolist libbcel-todolist))
  100. (bcel-todolist-tablist-mode))
  101. ;;; Displaying HTML content
  102. (navigel-method bcel navigel-open ((message libbcel-message) _target)
  103. (let ((html-file (make-temp-file "bcel" nil ".html"
  104. (libbcel-message-content message))))
  105. (unwind-protect
  106. (progn
  107. (advice-add 'url-queue-retrieve :filter-args #'bcel--url-queue-retrieve-filter-args)
  108. (eww-open-file html-file)
  109. (setq-local navigel-entity message))
  110. (advice-remove 'url-queue-retrieve #'bcel--url-queue-retrieve-filter-args))
  111. (setq header-line-format (libbcel-entity-name message))))
  112. (defun bcel--url-queue-retrieve-filter-args (args)
  113. "Always enable cookies.
  114. ARGS are passed unchanged to `url-queue-retrieve' except that INHIBIT-COOKIES is always nil."
  115. (list (seq-elt args 0)
  116. (seq-elt args 1)
  117. (seq-elt args 2)
  118. (seq-elt args 3)
  119. nil))
  120. (defun bcel--show-alist (entity)
  121. "Show the alist of ENTITY."
  122. (interactive (list (navigel-entity-at-point)))
  123. (with-current-buffer
  124. (generate-new-buffer (format "*-%s alist*"(libbcel-entity-name entity)))
  125. (insert (format "%s" (libbcel-entity-alist entity)))
  126. (pp-buffer)
  127. (switch-to-buffer (current-buffer))))
  128. ;;; Commands
  129. (defun bcel-todo-toggle (todo)
  130. "Toggle completed state of TODO.
  131. Interactively, use selected TODOs or TODO at point.
  132. TODO can be a todo item or a list of todo items."
  133. (interactive (list (navigel-marked-entities t)))
  134. (libbcel-actions-todo-toggle todo #'navigel-refresh))
  135. (defun bcel-browse (entity)
  136. "Open a web-browser on ENTITY.
  137. Interactively, use ENTITY at point."
  138. (interactive (list (navigel-entity-at-point)))
  139. (browse-url (libbcel-entity-app-url entity)))
  140. (defun bcel-chat (entity)
  141. "Open a chat-like interface to comment on ENTITY.
  142. Interactively, use ENTITY at point."
  143. (interactive (list (navigel-entity-at-point)))
  144. (bcel-chat-open entity))
  145. (provide 'bcel)
  146. ;;; bcel.el ends here