spacemacs/layers/+distribution/spacemacs-base/local/helm-spacemacs/helm-spacemacs.el
Fabien Dubosson 315528c89f Refactor CONTRIBUTING documentations
This commit merge the `CONTRIBUTING.md` and `doc/CONTRIBUTE.org` file
into a new `CONTRIBUTING.org` file. It also refactors the content to be
more organized and make its navigation more goal-oriented.

Github displays a link to the `CONTRIBUTING.*` file when people are
opening new issues or proposing new PRs. This file is important because
it is the entry-point to contributions guidelines for most of the users.
The current setup is non-optimal, even broken, as it adds a level of
indirection, and points to a contributing file that has broken
links (due to the new documentation format). The possible drawback of
the proposed solution is that I'm not sure if it is possible to include
it into the new online documentation as it is not in `doc/` folder.

The other possibility is to keep a small `CONTRIBUTING.md` file, as it
is now, pointing to the new documentation system (once online), but I'm
preferring the proposed solution for the following reasons:

- People that are willing to contribute will probably open Github
  first (for forking, creating PR, etc), not the online documentation.

- It has one level of indirection less when people click on the
  guidelines guide from a new issue/PR.

- `CONTRIBUTING.*` is by convention a special kind of file on github, so
  it's valid reason to break the rule and not having it in the `doc/`
  folder.
2015-12-11 01:09:09 -05:00

332 lines
13 KiB
EmacsLisp

;;; helm-spacemacs.el --- Spacemacs layer exploration with `helm'.
;; Author: Sylvain Benner <sylvain.benner@gmail.com>
;; Keywords: helm, spacemacs
;; Version: 0.1
;; Package-Requires: ((helm "1.5"))
;; This file 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, or (at your option)
;; any later version.
;; This file 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 GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; This package adds a convenient way to discover Spacemacs configuration
;; layers thanks to helm.
;;; Code:
(require 'cl)
(require 'ht)
(require 'helm)
(require 'helm-command)
(require 'helm-org)
(require 'core-configuration-layer)
(defvar helm-spacemacs-all-layers nil
"Alist of all configuration layers.")
(defvar helm-spacemacs-all-packages nil
"Hash table of all packages in all layers.")
;;;###autoload
(define-minor-mode helm-spacemacs-mode
"Layers discovery with helm interface."
:group 'spacemacs
:global t)
(defun helm-spacemacs//init (&optional arg)
(when (or arg (null helm-spacemacs-all-packages))
(mapc (lambda (layer) (push (configuration-layer/make-layer layer)
helm-spacemacs-all-layers))
(configuration-layer/get-layers-list))
(dolist (layer helm-spacemacs-all-layers)
(unless (configuration-layer/layer-usedp (oref layer :name))
(configuration-layer//load-layer-files layer '("funcs.el"
"config.el"))))
(setq helm-spacemacs-all-packages (configuration-layer/get-packages
helm-spacemacs-all-layers))))
;;;###autoload
(defun helm-spacemacs (arg)
"Layers discovery with helm interface."
(interactive "P")
(helm-spacemacs-mode)
(helm-spacemacs//init arg)
(helm :buffer "*helm: spacemacs*"
:sources `(,(helm-spacemacs//documentation-source)
,(helm-spacemacs//layer-source)
,(helm-spacemacs//package-source)
,(helm-spacemacs//dotspacemacs-source)
,(helm-spacemacs//toggle-source)
,(helm-spacemacs//faq-source))))
;;;###autoload
(defun helm-spacemacs-faq (arg)
"Looking in the FAQ with helm."
(interactive "P")
(helm-spacemacs-mode)
(helm :buffer "*helm: spacemacs*"
:sources `(,(helm-spacemacs//faq-source))))
(defun helm-spacemacs//documentation-source ()
"Construct the helm source for the documentation section."
(helm-build-sync-source "Spacemacs Documentation"
:candidates #'helm-spacemacs//documentation-candidates
:persistent-action #'helm-spacemacs//documentation-action-open-file
:keymap helm-map
:action (helm-make-actions
"Open Documentation" #'helm-spacemacs//documentation-action-open-file)))
(defun helm-spacemacs//documentation-candidates ()
(let (result file-extension)
(dolist (filename (directory-files spacemacs-docs-directory))
(setq file-extension (file-name-extension filename))
(when (or (equal file-extension "md")
(equal file-extension "org"))
(push filename result)))
;; CONTRIBUTING.org is a special case as it should be at the root of the
;; repository to be linked as the contributing guide on Github.
(push "CONTRIBUTING.org" result)
;; delete DOCUMENTATION.org to make it the first guide
(delete "DOCUMENTATION.org" result)
(push "DOCUMENTATION.org" result)
;; give each document an appropriate title
(mapcar (lambda (r)
(cond
((string-equal r "CONTRIBUTING.org")
`("How to contribute to Spacemacs" . ,r))
((string-equal r "CONVENTIONS.org")
`("Spacemacs conventions" . ,r))
((string-equal r "DOCUMENTATION.org")
`("Spacemacs documentation" . ,r))
((string-equal r "FAQ.org")
`("Spacemacs FAQ" . ,r))
((string-equal r "HOWTOs.org")
`("Quick HOW-TOs for Spacemacs" . ,r))
((string-equal r "LAYERS.org")
`("Tips on writing layers for Spacemacs" . ,r))
((string-equal r "QUICK_START.org")
`("Quick start guide for Spacemacs" . ,r))
((string-equal r "VIMUSERS.org")
`("Vim users migration guide" . ,r))
(t
`(r . ,r))))
result)))
(defun helm-spacemacs//documentation-action-open-file (candidate)
"Open documentation FILE."
(let ((file (if (string= candidate "CONTRIBUTING.org")
;; CONTRIBUTING.org is a special case as it should be at the
;; root of the repository to be linked as the contributing
;; guide on Github.
(concat user-emacs-directory candidate)
(concat spacemacs-docs-directory candidate))))
(cond ((and (equal (file-name-extension file) "md")
(not helm-current-prefix-arg))
(condition-case nil
(with-current-buffer (find-file-noselect file)
(gh-md-render-buffer)
(kill-this-buffer))
;; if anything fails, fall back to simply open file
(find-file file)))
((equal (file-name-extension file) "org")
(spacemacs/view-org-file file "^" 'all))
(t
(find-file file)))))
(defun helm-spacemacs//layer-source ()
"Construct the helm source for the layer section."
`((name . "Layers")
(candidates . ,(sort (configuration-layer/get-layers-list) 'string<))
(candidate-number-limit)
(action . (("Open README.org"
. helm-spacemacs//layer-action-open-readme)
("Open packages.el"
. helm-spacemacs//layer-action-open-packages)
;; TODO remove extensions in 0.105.0
("Open extensions.el"
. helm-spacemacs//layer-action-open-extensions)
("Open README.org (for editing)"
. helm-spacemacs//layer-action-open-readme-edit)))))
(defun helm-spacemacs//package-source ()
"Construct the helm source for the packages."
`((name . "Packages")
(candidates . ,(helm-spacemacs//package-candidates))
(candidate-number-limit)
(action . (("Go to init function"
. helm-spacemacs//package-action-goto-init-func)))))
(defun helm-spacemacs//package-candidates ()
"Return the sorted candidates for package source."
(let (result)
(dolist (pkg helm-spacemacs-all-packages)
(push (format "%s (%S layer)"
(propertize (symbol-name (oref pkg :name))
'face 'font-lock-type-face)
(oref pkg :owner))
result))
(sort result 'string<)))
(defun helm-spacemacs//toggle-source ()
"Construct the helm source for the toggles."
(helm-build-sync-source "Toggles"
:candidates #'helm-spacemacs//toggle-candidates
:persistent-action #'helm-spacemacs//toggle
:keymap helm-map
:action (helm-make-actions "Toggle" #'helm-spacemacs//toggle)))
(defun helm-spacemacs//toggle-candidates ()
"Return the sorted candidates for toggle source."
(let (result)
(dolist (toggle spacemacs-toggles)
(let* ((toggle-symbol (symbol-name (car toggle)))
(toggle-name (capitalize (replace-regexp-in-string "-" " " toggle-symbol)))
(toggle-doc (format "%s: %s"
toggle-name
(propertize
(or (plist-get (cdr toggle) :documentation) "")
'face 'font-lock-doc-face))))
(when (plist-member (cdr toggle) :evil-leader)
(let ((key (key-description
(kbd (concat dotspacemacs-leader-key " "
(plist-get (cdr toggle) :evil-leader))))))
(setq toggle-doc
(format "%s (%s)"
toggle-doc
(propertize key 'face 'helm-M-x-key)))))
(if (plist-member (cdr toggle) :documentation)
(push `(,toggle-doc . ,toggle-symbol) result)
(push `(,toggle-name . ,toggle-symbol) result))))
(setq result (cl-sort result 'string< :key 'car))
result))
(defun helm-spacemacs//dotspacemacs-source ()
`((name . "Dotfile")
(candidates . ,(helm-spacemacs//dotspacemacs-candidates))
(candidate-number-limit)
(action . (("Go to variable" . helm-spacemacs//go-to-dotfile-variable)))))
(defun helm-spacemacs//dotspacemacs-candidates ()
"Return the sorted candidates for all the dospacemacs variables."
(sort (dotspacemacs/get-variable-string-list) 'string<))
(defun helm-spacemacs//layer-action-open-file (file candidate &optional edit)
"Open FILE of the passed CANDIDATE. If EDIT is false, open in view mode."
(let ((path (if (and (equalp file "README.org") (equalp candidate "spacemacs"))
;; Readme for spacemacs is in the project root
(ht-get configuration-layer-paths (intern candidate))
(file-name-as-directory
(concat (ht-get configuration-layer-paths
(intern candidate))
candidate)))))
(if (and (equal (file-name-extension file) "org")
(not helm-current-prefix-arg))
(if edit
(find-file (concat path file))
(spacemacs/view-org-file (concat path file) "^" 'all))
(find-file (concat path file)))))
(defun helm-spacemacs//layer-action-open-readme (candidate)
"Open the `README.org' file of the passed CANDIDATE for reading."
(helm-spacemacs//layer-action-open-file "README.org" candidate))
(defun helm-spacemacs//layer-action-open-readme-edit (candidate)
"Open the `README.org' file of the passed CANDIDATE for editing."
(helm-spacemacs//layer-action-open-file "README.org" candidate t))
(defun helm-spacemacs//layer-action-open-packages (candidate)
"Open the `packages.el' file of the passed CANDIDATE."
(helm-spacemacs//layer-action-open-file "packages.el" candidate))
;; TODO remove extensions in 0.105.0
(defun helm-spacemacs//layer-action-open-extensions (candidate)
"Open the `extensions.el' file of the passed CANDIDATE."
(helm-spacemacs//layer-action-open-file "extensions.el" candidate))
(defun helm-spacemacs//package-action-goto-init-func (candidate)
"Open the file `packages.el' and go to the init function."
(save-match-data
(string-match "^\\(.+\\)\s(\\(.+\\) layer)$" candidate)
;; (string-match "^(\\(.+\\))\s\\(.+\\):\s\\(.+\\)$" candidate)
(let* ((package (match-string 1 candidate))
(layer (match-string 2 candidate))
(path (file-name-as-directory
(concat (ht-get configuration-layer-paths (intern layer))
layer)))
(filename (concat path "packages.el")))
(find-file filename)
(goto-char (point-min))
(re-search-forward (format "init-%s" package))
(beginning-of-line))))
(defun helm-spacemacs//toggle (candidate)
"Toggle candidate."
(let ((toggle (assq (intern candidate) spacemacs-toggles)))
(when toggle
(funcall (plist-get (cdr toggle) :function)))))
(defun helm-spacemacs//go-to-dotfile-variable (candidate)
"Go to candidate in the dotfile."
(find-file dotspacemacs-filepath)
(goto-char (point-min))
;; try to exclude comments
(re-search-forward (format "^[a-z\s\\(\\-]*%s" candidate))
(beginning-of-line))
(defvar helm-spacemacs--faq-filename
(concat spacemacs-docs-directory "FAQ.org")
"Location of the FAQ file.")
(defun helm-spacemacs//faq-source ()
"Construct the helm source for the FAQ."
`((name . "FAQ")
(candidates . ,(helm-spacemacs//faq-candidates))
(candidate-number-limit)
(action . (("Go to question" . helm-spacemacs//faq-goto-marker)))))
(defun helm-spacemacs//faq-candidate (cand)
(let ((str (substring-no-properties (car cand))))
(when (string-match "\\`\\([^/]*\\)/\\(.*\\)\\'" str)
(cons (concat (propertize
(match-string 1 str)
'face 'font-lock-type-face)
": " (match-string 2 str))
(cdr cand)))))
(defun helm-spacemacs//faq-candidates ()
(delq nil
(mapcar 'helm-spacemacs//faq-candidate
(with-temp-buffer
(insert-file-contents helm-spacemacs--faq-filename)
(org-mode)
(mapcar (lambda (candidate)
(cons (car candidate)
(marker-position (cdr candidate))))
(helm-get-org-candidates-in-file
(current-buffer) 1 8 nil t))))))
(defun helm-spacemacs//faq-goto-marker (marker)
(find-file helm-spacemacs--faq-filename)
(goto-char marker)
(org-show-context)
(org-show-entry))
(provide 'helm-spacemacs)
;;; helm-spacemacs.el ends here