Emacs interface to view and manipulate CouchDB databases
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.

175 lines
5.8KB

  1. ;;; elcouch.el --- View and manipulate CouchDB databases -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2018 Damien Cassou
  3. ;; Author: Damien Cassou <damien@cassou.me>
  4. ;; Url: https://gitlab.petton.fr/DamienCassou/elcouch
  5. ;; Package-requires: ((emacs "25.1") (json-mode "1.0.0") (libelcouch "0.9.0") (navigel "0.3.0"))
  6. ;; Version: 0.3.0
  7. ;; Keywords: data, tools
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; View and manipulate CouchDB databases.
  20. ;;; Code:
  21. (require 'tabulated-list)
  22. (require 'json-mode)
  23. (require 'navigel)
  24. (require 'libelcouch)
  25. ;;; Customization
  26. (defgroup elcouch nil
  27. "View and manipulate CouchDB databases."
  28. :group 'externa)
  29. ;;; Entity listing code
  30. ;;;###autoload
  31. (defun elcouch-open (instance)
  32. "Open a new buffer listing CouchDB databases of INSTANCE.
  33. Interactively, the user is asked to select a CouchDB instance from
  34. `elcouch-couchdb-instances'."
  35. (interactive (list (libelcouch-choose-instance)))
  36. (elcouch-open-entity instance))
  37. ;;;###autoload
  38. (defun elcouch-open-url (url)
  39. "Open entity pointed to by URL, a string."
  40. (interactive (list (read-from-minibuffer "URL: ")))
  41. (elcouch-open-entity (libelcouch-entity-from-url url)))
  42. (defun elcouch-open-entity (entity)
  43. "Open a buffer showing ENTITY."
  44. (let ((navigel-app 'elcouch))
  45. (navigel-open entity nil)))
  46. ;;; Document view mode
  47. (defvar-local elcouch--document nil
  48. "Remember the CouchDB document of current buffer.")
  49. (defvar elcouch-document-view-mode-map
  50. (let ((map (make-sparse-keymap)))
  51. (define-key map (kbd "C-c C-c") #'elcouch-document-save)
  52. (define-key map (kbd "C-x C-q") #'elcouch-document-read-only-mode)
  53. map)
  54. "Keybindings for `elcouch-document-view-mode'.")
  55. (define-derived-mode elcouch-document-view-mode json-mode "elcouch document"
  56. "Major mode to view and edit a CouchDB document.")
  57. (defun elcouch--document-prepare-buffer (content)
  58. "Insert json CONTENT into current buffer."
  59. (let ((inhibit-read-only t))
  60. (erase-buffer)
  61. (insert content)
  62. (json-pretty-print-buffer))
  63. ;; Give more keybindings to buffer navigation:
  64. (setq buffer-read-only t)
  65. (goto-char (point-min))
  66. (font-lock-ensure))
  67. (defun elcouch-view-document (document &optional saved-point saved-mark)
  68. "Display a CouchDB DOCUMENT in a JSON read-write buffer.
  69. If SAVED-POINT and/or SAVED-MARK are provided, the point and/or
  70. mark are changed to those ones."
  71. (interactive (list (tabulated-list-get-id)))
  72. (libelcouch-document-content
  73. document
  74. (lambda (json-document)
  75. (with-current-buffer (get-buffer-create (format "*elcouch-doc-%s" (libelcouch-entity-full-name document)))
  76. (elcouch-document-view-mode)
  77. (setq-local elcouch--document document)
  78. (elcouch--document-prepare-buffer json-document)
  79. (switch-to-buffer (current-buffer))
  80. (when saved-point
  81. (goto-char saved-point))
  82. (when saved-mark
  83. (save-mark-and-excursion--restore saved-mark))
  84. (message "Press %s to edit the document."
  85. (substitute-command-keys "\\[elcouch-document-read-only-mode]"))))))
  86. (defun elcouch-document-refresh (&optional buffer)
  87. "Refresh BUFFER with new document content.
  88. Use current buffer if BUFFER is nil."
  89. (interactive)
  90. (with-current-buffer (or buffer (current-buffer))
  91. (let ((saved-point (point))
  92. (saved-mark (save-mark-and-excursion--save)))
  93. (elcouch-view-document elcouch--document saved-point saved-mark))))
  94. (defun elcouch-document-save ()
  95. "Save buffer's document to CouchDB."
  96. (interactive)
  97. (libelcouch-document-save elcouch--document nil #'elcouch-document-refresh))
  98. (defun elcouch-document-read-only-mode ()
  99. "Toggle read-only mode in current buffer."
  100. (interactive)
  101. (call-interactively #'read-only-mode)
  102. (if buffer-read-only
  103. (message "Press %s to edit the document."
  104. (substitute-command-keys "\\[elcouch-document-read-only-mode]"))
  105. (message "You can now edit the document. Press %s to send changes to the server."
  106. (substitute-command-keys "\\[elcouch-document-save]"))))
  107. (defun elcouch-document-delete (document)
  108. "Delete the CouchDB DOCUMENT."
  109. (interactive (list elcouch--document))
  110. (when (yes-or-no-p (format "Really delete %s? " (libelcouch-entity-full-name document)))
  111. (let* ((json-object (save-excursion
  112. (goto-char (point-min))
  113. (json-read)))
  114. (revision (map-elt json-object '_rev)))
  115. (libelcouch-document-delete
  116. document
  117. revision
  118. (lambda () (elcouch-open-entity (libelcouch-entity-parent document)))))))
  119. ;; navigel configuration
  120. (navigel-method elcouch navigel-name (entity)
  121. (libelcouch-entity-name entity))
  122. (navigel-method elcouch navigel-buffer-name (entity)
  123. (libelcouch-entity-full-name entity))
  124. (navigel-method elcouch navigel-children (entity callback)
  125. (libelcouch-entity-list entity callback))
  126. (navigel-method elcouch navigel-parent (entity)
  127. (libelcouch-entity-parent entity))
  128. (navigel-method elcouch navigel-parent ((_entity libelcouch-instance))
  129. nil)
  130. (navigel-method elcouch navigel-open ((document libelcouch-document) _target)
  131. (elcouch-view-document document))
  132. (navigel-method elcouch navigel-delete ((document libelcouch-document) &optional function)
  133. (libelcouch-document-delete-latest document function))
  134. (provide 'elcouch)
  135. ;;; elcouch.el ends here