diff options
Diffstat (limited to 'elpa/dashboard-20220409.620/dashboard.el')
| -rw-r--r-- | elpa/dashboard-20220409.620/dashboard.el | 472 |
1 files changed, 472 insertions, 0 deletions
diff --git a/elpa/dashboard-20220409.620/dashboard.el b/elpa/dashboard-20220409.620/dashboard.el new file mode 100644 index 0000000..9c8b80e --- /dev/null +++ b/elpa/dashboard-20220409.620/dashboard.el @@ -0,0 +1,472 @@ +;;; dashboard.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*- + +;; Copyright (c) 2016-2022 emacs-dashboard maintainers +;; +;; Author : Rakan Al-Hneiti <rakan.alhneiti@gmail.com> +;; Maintainer : Jesús Martínez <jesusmartinez93@gmail.com> +;; Shen, Jen-Chieh <jcs090218@gmail.com> +;; URL : https://github.com/emacs-dashboard/emacs-dashboard +;; +;; This file is not part of GNU Emacs. +;; +;;; License: GPLv3 +;; +;; Created: October 05, 2016 +;; Package-Version: 1.8.0-SNAPSHOT +;; Keywords: startup, screen, tools, dashboard +;; Package-Requires: ((emacs "26.1")) +;;; Commentary: + +;; An extensible Emacs dashboard, with sections for +;; bookmarks, projects (projectile or project.el), org-agenda and more. + +;;; Code: + +(require 'ffap) +(require 'recentf) + +(require 'dashboard-widgets) + +(declare-function bookmark-get-filename "ext:bookmark.el") +(declare-function bookmark-all-names "ext:bookmark.el") +(declare-function dashboard-ls--dirs "ext:dashboard-ls.el") +(declare-function dashboard-ls--files "ext:dashboard-ls.el") +(declare-function page-break-lines-mode "ext:page-break-lines.el") +(declare-function project-forget-projects-under "ext:project.el") + +(defgroup dashboard nil + "Extensible startup screen." + :group 'applications) + +;; Custom splash screen +(defvar dashboard-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-p") 'dashboard-previous-line) + (define-key map (kbd "C-n") 'dashboard-next-line) + (define-key map (kbd "<up>") 'dashboard-previous-line) + (define-key map (kbd "<down>") 'dashboard-next-line) + (define-key map (kbd "k") 'dashboard-previous-line) + (define-key map (kbd "j") 'dashboard-next-line) + (define-key map [tab] 'widget-forward) + (define-key map (kbd "C-i") 'widget-forward) + (define-key map [backtab] 'widget-backward) + (define-key map (kbd "RET") 'dashboard-return) + (define-key map [mouse-1] 'dashboard-mouse-1) + (define-key map (kbd "}") #'dashboard-next-section) + (define-key map (kbd "{") #'dashboard-previous-section) + + (define-key map (kbd "<backspace>") #'dashboard-remove-item-under) + (define-key map (kbd "<delete>") #'dashboard-remove-item-under) + (define-key map (kbd "DEL") #'dashboard-remove-item-under) + + (define-key map (kbd "1") #'dashboard-section-1) + (define-key map (kbd "2") #'dashboard-section-2) + (define-key map (kbd "3") #'dashboard-section-3) + (define-key map (kbd "4") #'dashboard-section-4) + (define-key map (kbd "5") #'dashboard-section-5) + (define-key map (kbd "6") #'dashboard-section-6) + (define-key map (kbd "7") #'dashboard-section-7) + (define-key map (kbd "8") #'dashboard-section-8) + (define-key map (kbd "9") #'dashboard-section-9) + map) + "Keymap for dashboard mode.") + +(defcustom dashboard-after-initialize-hook nil + "Hook that is run after dashboard buffer is initialized." + :group 'dashboard + :type 'hook) + +(define-derived-mode dashboard-mode special-mode "Dashboard" + "Dashboard major mode for startup screen." + :group 'dashboard + :syntax-table nil + :abbrev-table nil + (buffer-disable-undo) + (when (featurep 'whitespace) (whitespace-mode -1)) + (when (featurep 'linum) (linum-mode -1)) + (when (featurep 'display-line-numbers) (display-line-numbers-mode -1)) + (when (featurep 'page-break-lines) (page-break-lines-mode 1)) + (setq-local revert-buffer-function #'dashboard-refresh-buffer) + (setq inhibit-startup-screen t + buffer-read-only t + truncate-lines t)) + +(defcustom dashboard-center-content nil + "Whether to center content within the window." + :type 'boolean + :group 'dashboard) + +(defconst dashboard-buffer-name "*dashboard*" + "Dashboard's buffer name.") + +(defvar dashboard-force-refresh nil + "If non-nil, force refresh dashboard buffer.") + +(defvar dashboard--section-starts nil + "List of section starting positions.") + +;; +;; Util +;; +(defun dashboard--goto-line (line) + "Goto LINE." + (goto-char (point-min)) (forward-line (1- line))) + +(defmacro dashboard--save-excursion (&rest body) + "Execute BODY save window point." + (declare (indent 0) (debug t)) + `(let ((line (line-number-at-pos nil t)) + (column (current-column))) + ,@body + (dashboard--goto-line line) + (move-to-column column))) + +;; +;; Core +;; +(defun dashboard--current-section () + "Return section symbol in dashboard." + (save-excursion + (if (and (search-backward dashboard-page-separator nil t) + (search-forward dashboard-page-separator nil t)) + (let ((ln (thing-at-point 'line))) + (cond ((string-match-p "Recent Files:" ln) 'recents) + ((string-match-p "Bookmarks:" ln) 'bookmarks) + ((string-match-p "Projects:" ln) 'projects) + ((string-match-p "Agenda for " ln) 'agenda) + ((string-match-p "Registers:" ln) 'registers) + ((string-match-p "List Directories:" ln) 'ls-directories) + ((string-match-p "List Files:" ln) 'ls-files) + (t (user-error "Unknown section from dashboard")))) + (user-error "Failed searching dashboard section")))) + +;; +;; Navigation +;; +(defun dashboard-previous-section () + "Navigate back to previous section." + (interactive) + (let ((current-position (point)) current-section-start previous-section-start) + (dolist (elt dashboard--section-starts) + (when (and current-section-start (not previous-section-start)) + (setq previous-section-start elt)) + (when (and (not current-section-start) (< elt current-position)) + (setq current-section-start elt))) + (goto-char (if (eq current-position current-section-start) + previous-section-start + current-section-start)))) + +(defun dashboard-next-section () + "Navigate forward to next section." + (interactive) + (let ((current-position (point)) next-section-start + (section-starts (reverse dashboard--section-starts))) + (dolist (elt section-starts) + (when (and (not next-section-start) + (> elt current-position)) + (setq next-section-start elt))) + (when next-section-start + (goto-char next-section-start)))) + +(defun dashboard--section-lines () + "Return a list of integer represent the starting line number of each section." + (let (pb-lst) + (save-excursion + (goto-char (point-min)) + (while (search-forward dashboard-page-separator nil t) + (when (ignore-errors (dashboard--current-section)) + (push (line-number-at-pos) pb-lst)))) + (setq pb-lst (reverse pb-lst)) + pb-lst)) + +(defun dashboard--goto-section-by-index (index) + "Navigate to item section by INDEX." + (let* ((pg-lst (dashboard--section-lines)) + (items-id (1- index)) + (items-pg (nth items-id pg-lst)) + (items-len (length pg-lst))) + (when (and items-pg (< items-id items-len)) + (dashboard--goto-line items-pg)))) + +(defun dashboard-section-1 () + "Navigate to section 1." (interactive) (dashboard--goto-section-by-index 1)) +(defun dashboard-section-2 () + "Navigate to section 2." (interactive) (dashboard--goto-section-by-index 2)) +(defun dashboard-section-3 () + "Navigate to section 3." (interactive) (dashboard--goto-section-by-index 3)) +(defun dashboard-section-4 () + "Navigate to section 4." (interactive) (dashboard--goto-section-by-index 4)) +(defun dashboard-section-5 () + "Navigate to section 5." (interactive) (dashboard--goto-section-by-index 5)) +(defun dashboard-section-6 () + "Navigate to section 6." (interactive) (dashboard--goto-section-by-index 6)) +(defun dashboard-section-7 () + "Navigate to section 7." (interactive) (dashboard--goto-section-by-index 7)) +(defun dashboard-section-8 () + "Navigate to section 8." (interactive) (dashboard--goto-section-by-index 8)) +(defun dashboard-section-9 () + "Navigate to section 9." (interactive) (dashboard--goto-section-by-index 9)) + +(defun dashboard-previous-line (arg) + "Move point up and position it at that line’s item. +Optional prefix ARG says how many lines to move; default is one line." + (interactive "^p") + (dashboard-next-line (- arg))) + +(defun dashboard-next-line (arg) + "Move point down and position it at that line’s item. +Optional prefix ARG says how many lines to move; default is one line." + ;; code heavily inspired by `dired-next-line' + (interactive "^p") + (let (line-move-visual goal-column) + (line-move arg t)) + ;; We never want to move point into an invisible line. Dashboard doesn’t + ;; use invisible text currently but when it does we’re ready! + (while (and (invisible-p (point)) + (not (if (and arg (< arg 0)) (bobp) (eobp)))) + (forward-char (if (and arg (< arg 0)) -1 1))) + (beginning-of-line-text)) + +;; +;; ffap +;; +(defun dashboard--goto-section (section) + "Move to SECTION declares in variable `dashboard-item-shortcuts'." + (let ((fnc (intern (format "dashboard-jump-to-%s" section)))) + (dashboard-funcall-fboundp fnc))) + +(defun dashboard--current-index (section &optional pos) + "Return the idex by SECTION from POS." + (let (target-ln section-line) + (save-excursion + (when pos (goto-char pos)) + (setq target-ln (line-number-at-pos)) + (dashboard--goto-section section) + (setq section-line (line-number-at-pos))) + (- target-ln section-line))) + +(defun dashboard--section-list (section) + "Return the list from SECTION." + (cl-case section + (`recents recentf-list) + (`bookmarks (bookmark-all-names)) + (`projects (dashboard-projects-backend-load-projects)) + (`ls-directories (dashboard-ls--dirs)) + (`ls-files (dashboard-ls--files)) + (t (user-error "Unknown section for search: %s" section)))) + +(defun dashboard--current-item-in-path () + "Return the path from current dashboard section in path." + (let ((section (dashboard--current-section)) path) + (cl-case section + (`bookmarks (setq path (bookmark-get-filename path))) + (t + (let ((lst (dashboard--section-list section)) + (index (dashboard--current-index section))) + (setq path (nth index lst))))) + path)) + +(defun dashboard--on-path-item-p () + "Return non-nil if current point is on the item path from dashboard." + (save-excursion + (when (= (point) (line-end-position)) (ignore-errors (forward-char -1))) + (eq (get-char-property (point) 'face) 'dashboard-items-face))) + +(defun dashboard--ffap-guesser--adv (fnc &rest args) + "Advice execution around function `ffap-guesser'. + +Argument FNC is the adviced function. +Optional argument ARGS adviced function arguments." + (cl-case major-mode + (`dashboard-mode + (or (and (dashboard--on-path-item-p) + (dashboard--current-item-in-path)) + (apply fnc args))) ; fallback + (t (apply fnc args)))) +(advice-add 'ffap-guesser :around #'dashboard--ffap-guesser--adv) + +;; +;; Removal +;; +(defun dashboard-remove-item-under () + "Remove a item from the current item section." + (interactive) + (cl-case (dashboard--current-section) + (`recents (dashboard-remove-item-recentf)) + (`bookmarks (dashboard-remove-item-bookmarks)) + (`projects (dashboard-remove-item-projects)) + (`agenda (dashboard-remove-item-agenda)) + (`registers (dashboard-remove-item-registers))) + (dashboard--save-excursion (dashboard-refresh-buffer))) + +(defun dashboard-remove-item-recentf () + "Remove a file from `recentf-list'." + (interactive) + (let ((path (save-excursion (end-of-line) (ffap-guesser)))) + (setq recentf-list (delete path recentf-list))) + (dashboard-mute-apply (recentf-save-list))) + +(defun dashboard-remove-item-projects () + "Remove a path from `project--list'." + (interactive) + (let ((path (save-excursion (end-of-line) (ffap-guesser)))) + (dashboard-mute-apply + (cl-case dashboard-projects-backend + (`projectile ) ; TODO: .. + (`project-el (project-forget-projects-under path)))))) + +(defun dashboard-remove-item-bookmarks () + "Remove a bookmarks from `bookmark-alist'." + (interactive)) ; TODO: .. + +(defun dashboard-remove-item-agenda () + "Remove an agenda from `org-agenda-files'." + (interactive "P") + (let ((agenda-file (get-text-property (point) 'dashboard-agenda-file)) + (agenda-loc (get-text-property (point) 'dashboard-agenda-loc))) + (with-current-buffer (find-file-noselect agenda-file) + (goto-char agenda-loc) + (call-interactively 'org-todo)))) + +(defun dashboard-remove-item-registers () + "Remove a registers from `register-alist'." + (interactive)) ; TODO: .. + +;; +;; Confirmation +;; +(defun dashboard-return () + "Hit return key in dashboard buffer." + (interactive) + (let ((start-ln (line-number-at-pos)) (fd-cnt 0) diff-line entry-pt) + (save-excursion + (while (and (not diff-line) + (not (= (point) (point-min))) + (not (get-char-property (point) 'button)) + (not (= (point) (point-max)))) + (forward-char 1) + (setq fd-cnt (1+ fd-cnt)) + (unless (= start-ln (line-number-at-pos)) + (setq diff-line t))) + (unless (= (point) (point-max)) + (setq entry-pt (point)))) + (when (= fd-cnt 1) + (setq entry-pt (1- (point)))) + (if entry-pt + (widget-button-press entry-pt) + (call-interactively #'widget-button-press)))) + +(defun dashboard-mouse-1 () + "Key for keymap `mouse-1'." + (interactive) + (let ((old-track-mouse track-mouse)) + (when (call-interactively #'widget-button-click) + (setq track-mouse old-track-mouse)))) + +;; +;; Insertion +;; +(defun dashboard-maximum-section-length () + "For the just-inserted section, calculate the length of the longest line." + (let ((max-line-length 0)) + (save-excursion + (dashboard-previous-section) + (while (not (eobp)) + (setq max-line-length + (max max-line-length + (- (line-end-position) (line-beginning-position)))) + (forward-line 1))) + max-line-length)) + +(defun dashboard-insert-startupify-lists () + "Insert the list of widgets into the buffer." + (interactive) + (let ((buffer-exists (buffer-live-p (get-buffer dashboard-buffer-name))) + (recentf-is-on (recentf-enabled-p)) + (origial-recentf-list recentf-list) + (dashboard-num-recents (or (cdr (assoc 'recents dashboard-items)) 0)) + (max-line-length 0)) + ;; disable recentf mode, so we don't flood the recent files list with org + ;; mode files do this by making a copy of the part of the list we'll use + ;; let dashboard widgets change that then restore the orginal list afterwards + ;; (this avoids many saves/loads that would result from disabling/enabling + ;; recentf-mode) + (when recentf-is-on + (setq recentf-list (dashboard-subseq recentf-list dashboard-num-recents))) + (when (or dashboard-force-refresh + (not (eq dashboard-buffer-last-width (window-width))) + (not buffer-exists)) + (setq dashboard-banner-length (window-width) + dashboard-buffer-last-width dashboard-banner-length) + (with-current-buffer (get-buffer-create dashboard-buffer-name) + (let (buffer-read-only) + (erase-buffer) + (dashboard-insert-banner) + (dashboard-insert-page-break) + (setq dashboard--section-starts nil) + (mapc (lambda (els) + (let* ((el (or (car-safe els) els)) + (list-size + (or (cdr-safe els) + dashboard-items-default-length)) + (item-generator + (cdr-safe (assoc el dashboard-item-generators)))) + (add-to-list 'dashboard--section-starts (point)) + (funcall item-generator list-size) + (when recentf-is-on + (setq recentf-list origial-recentf-list)) + (setq max-line-length + (max max-line-length (dashboard-maximum-section-length))) + (dashboard-insert-page-break))) + dashboard-items) + (when dashboard-center-content + (when dashboard--section-starts + (goto-char (car (last dashboard--section-starts)))) + (let ((margin (floor (/ (max (- (window-width) max-line-length) 0) 2)))) + (while (not (eobp)) + (unless (string-suffix-p (thing-at-point 'line) dashboard-page-separator) + (insert (make-string margin ?\ ))) + (forward-line 1)))) + (dashboard-insert-footer)) + (goto-char (point-min)) + (dashboard-mode))) + (when recentf-is-on + (setq recentf-list origial-recentf-list)))) + +(add-hook 'window-setup-hook + (lambda () + (add-hook 'window-size-change-functions 'dashboard-resize-on-hook) + (dashboard-resize-on-hook))) + +(defun dashboard-refresh-buffer (&rest _) + "Refresh buffer." + (interactive) + (let ((dashboard-force-refresh t)) (dashboard-insert-startupify-lists)) + (switch-to-buffer dashboard-buffer-name)) + +(defun dashboard-resize-on-hook (&optional _) + "Re-render dashboard on window size change." + (let ((space-win (get-buffer-window dashboard-buffer-name)) + (frame-win (frame-selected-window))) + (when (and space-win + (not (window-minibuffer-p frame-win))) + (with-selected-window space-win + (dashboard-insert-startupify-lists))))) + +;;;###autoload +(defun dashboard-setup-startup-hook () + "Setup post initialization hooks. +If a command line argument is provided, assume a filename and skip displaying +Dashboard." + (when (< (length command-line-args) 2) + (add-hook 'after-init-hook (lambda () + ;; Display useful lists of items + (dashboard-insert-startupify-lists))) + (add-hook 'emacs-startup-hook (lambda () + (switch-to-buffer dashboard-buffer-name) + (goto-char (point-min)) + (redisplay) + (run-hooks 'dashboard-after-initialize-hook))))) + +(provide 'dashboard) +;;; dashboard.el ends here |