daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2021-01-08 19:32:30 +01:00
parent ce8f24d28a
commit f5649dceab
467 changed files with 26642 additions and 22487 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
lisp/dashboard/dashboard-pkg.el
View File

@@ -1,12 +1,12 @@
(define-package "dashboard" "20200306.1344" "A startup screen extracted from Spacemacs"
(define-package "dashboard" "20210104.1605" "A startup screen extracted from Spacemacs"
'((emacs "25.3")
(page-break-lines "0.11"))
:commit "bf38867ae80902d58207974b4a2bba4249324599" :keywords
'("startup" "screen" "tools" "dashboard")
:authors
:commit "2b1ef13392be2f07d2a52636edf578b89512d501" :authors
'(("Rakan Al-Hneiti"))
:maintainer
'("Rakan Al-Hneiti")
:keywords
'("startup" "screen" "tools" "dashboard")
:url "https://github.com/emacs-dashboard/emacs-dashboard")
;; Local Variables:
;; no-byte-compile: t

666
lisp/dashboard/dashboard-widgets.el
View File

@@ -1,6 +1,8 @@
;;; dashboard-widgets.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
;; Copyright (c) 2016-2020 Rakan Al-Hneiti & Contributors
;; Copyright (c) 2016-2020 Rakan Al-Hneiti <rakan.alhneiti@gmail.com>
;; Copyright (c) 2019-2020 Jesús Martínez <jesusmartinez93@gmail.com>
;; Copyright (c) 2020 Shen, Jen-Chieh <jcs090218@gmail.com>
;;
;; Author: Rakan Al-Hneiti
;; URL: https://github.com/emacs-dashboard/emacs-dashboard
@@ -16,7 +18,7 @@
;;; Commentary:
;; An extensible Emacs dashboard, with sections for
;; bookmarks, projectile projects, org-agenda and more.
;; bookmarks, projects (projectile or project.el), org-agenda and more.
;;; Code:
@@ -25,6 +27,8 @@
;; Compiler pacifier
(declare-function all-the-icons-icon-for-dir "ext:all-the-icons.el")
(declare-function all-the-icons-icon-for-file "ext:all-the-icons.el")
(declare-function all-the-icons-fileicon "ext:data-fileicons.el")
(declare-function all-the-icons-octicon "ext:data-octicons.el")
(declare-function bookmark-get-filename "ext:bookmark.el")
(declare-function bookmark-all-names "ext:bookmark.el")
(declare-function calendar-date-compare "ext:calendar.el")
@@ -32,6 +36,8 @@
(declare-function projectile-load-known-projects "ext:projectile.el")
(declare-function projectile-mode "ext:projectile.el")
(declare-function projectile-relevant-known-projects "ext:projectile.el")
;;; project.el in Emacs 26 does not contain this function
(declare-function project-known-project-roots "ext:project.el" nil t)
(declare-function org-agenda-format-item "ext:org-agenda.el")
(declare-function org-compile-prefix-format "ext:org-agenda.el")
(declare-function org-entry-is-done-p "ext:org.el")
@@ -42,6 +48,12 @@
(declare-function org-get-tags "ext:org.el")
(declare-function org-map-entries "ext:org.el")
(declare-function org-outline-level "ext:org.el")
(declare-function org-today "ext:org.el")
(declare-function org-get-todo-face "ext:org.el")
(declare-function org-get-todo-state "ext:org.el")
(declare-function org-entry-is-todo-p "ext:org.el")
(defalias 'org-time-less-p 'time-less-p)
(defvar org-level-faces "ext:org-faces.el")
(defvar all-the-icons-dir-icon-alist)
(defvar package-activated-list)
@@ -53,18 +65,20 @@
(defcustom dashboard-image-banner-max-height 0
"Maximum height of banner image.
This setting applies only if Emacs is compiled with Imagemagick
support. When value is non-zero the image banner will be resized
to the specified height, with aspect ratio preserved."
This setting applies only if Emacs supports image transforms or
compiled with Imagemagick support. When value is non-zero the image
banner will be resized to the specified height in pixels, with aspect
ratio preserved."
:type 'integer
:group 'dashboard)
(defcustom dashboard-image-banner-max-width 0
"Maximum width of banner image.
This setting applies if Emacs is compiled with Imagemagick
support. When value is non-zero the image banner will be resized
to the specified width, with aspect ratio preserved."
This setting applies if Emacs supports image transforms or compiled
with Imagemagick support. When value is non-zero the image banner
will be resized to the specified width in pixels, with aspect ratio
preserved."
:type 'integer
:group 'dashboard)
@@ -101,8 +115,7 @@ to the specified width, with aspect ratio preserved."
"Happy coding!"
"Vi Vi Vi, the editor of the beast"
"Welcome to the church of Emacs"
"While any text editor can save your files,\
only Emacs can save your soul"
"While any text editor can save your files, only Emacs can save your soul"
"I showed you my source code, pls respond")
"A list of messages, one of which dashboard chooses to display."
:type 'list
@@ -121,9 +134,8 @@ Example:
:group 'dashboard)
(defconst dashboard-banners-directory
(concat (file-name-directory
(locate-library "dashboard"))
"/banners/"))
(concat (file-name-directory (locate-library "dashboard")) "/banners/")
"Default banner directory.")
(defconst dashboard-banner-official-png
(expand-file-name (concat dashboard-banners-directory "emacs.png"))
@@ -151,31 +163,20 @@ Example:
:group 'dashboard)
(defcustom dashboard-init-info
;; Check if package.el was loaded and if package loading was enabled
(if (bound-and-true-p package-alist)
(format "%d packages loaded in %s"
(length package-activated-list) (emacs-init-time))
(if (and (boundp 'straight--profile-cache) (hash-table-p straight--profile-cache))
(format "%d packages loaded in %s"
(hash-table-size straight--profile-cache) (emacs-init-time))
(format "Emacs started in %s" (emacs-init-time))))
(let ((package-count 0) (time (emacs-init-time)))
(when (bound-and-true-p package-alist)
(setq package-count (length package-activated-list)))
(when (boundp 'straight--profile-cache)
(setq package-count (+ (hash-table-size straight--profile-cache) package-count)))
(if (zerop package-count)
(format "Emacs started in %s" time)
(format "%d packages loaded in %s" package-count time)))
"Init info with packages loaded and init time."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-footer
(let ((list '("The one true editor, Emacs!"
"Who the hell uses VIM anyway? Go Evil!"
"Free as free speech, free as free Beer"
"Richard Stallman is proud of you"
"Happy coding!"
"Vi Vi Vi, the editor of the beast"
"Welcome to the church of Emacs"
"While any text editor can save your files,\
only Emacs can save your soul"
"I showed you my source code, pls respond"
)))
(nth (random (1- (1+ (length list)))) list))
(nth (random (1- (1+ (length dashboard-footer-messages)))) dashboard-footer-messages)
"A footer with some short message."
:type 'string
:group 'dashboard)
@@ -198,11 +199,11 @@ Example:
Default value is `official', it displays
the Emacs logo. `logo' displays Emacs alternative logo.
An integer value is the index of text
banner. A string value must be a path to a .PNG file.
banner. A string value must be a path to a .PNG or .TXT file.
If the value is nil then no banner is displayed."
:type '(choice (const :tag "offical" official)
(const :tag "logo" logo)
(string :tag "a png path"))
(string :tag "a png or txt path"))
:group 'dashboard)
(defcustom dashboard-buffer-last-width nil
@@ -210,11 +211,12 @@ If the value is nil then no banner is displayed."
:type 'integer
:group 'dashboard)
(defcustom dashboard-item-generators '((recents . dashboard-insert-recents)
(bookmarks . dashboard-insert-bookmarks)
(projects . dashboard-insert-projects)
(agenda . dashboard-insert-agenda)
(registers . dashboard-insert-registers))
(defcustom dashboard-item-generators
'((recents . dashboard-insert-recents)
(bookmarks . dashboard-insert-bookmarks)
(projects . dashboard-insert-projects)
(agenda . dashboard-insert-agenda)
(registers . dashboard-insert-registers))
"Association list of items to how to generate in the startup buffer.
Will be of the form `(list-type . list-function)'.
Possible values for list-type are: `recents', `bookmarks', `projects',
@@ -222,6 +224,19 @@ Possible values for list-type are: `recents', `bookmarks', `projects',
:type '(repeat (alist :key-type symbol :value-type function))
:group 'dashboard)
(defcustom dashboard-projects-backend 'projectile
"The package that supplies the list of recent projects.
With the value `projectile', the projects widget uses the package
projectile (available in MELPA). With the value `project-el',
the widget uses the package project (available in GNU ELPA).
To activate the projects widget, add e.g. `(projects . 10)' to
`dashboard-items' after making sure the necessary package is
installed."
:type '(choice (const :tag "Use projectile" projectile)
(const :tag "Use project.el" project-el))
:group 'dashboard)
(defcustom dashboard-items '((recents . 5)
(bookmarks . 5)
(agenda . 5))
@@ -232,6 +247,19 @@ If nil it is disabled. Possible values for list-type are:
:type '(repeat (alist :key-type symbol :value-type integer))
:group 'dashboard)
(defcustom dashboard-item-shortcuts '((recents . "r")
(bookmarks . "m")
(projects . "p")
(agenda . "a")
(registers . "e"))
"Association list of items and their corresponding shortcuts.
Will be of the form `(list-type . keys)' as understood by
`(kbd keys)'. If nil, shortcuts are disabled. If an entry's
value is nil, that item's shortcut is disbaled. See
`dashboard-items' for possible values of list-type.'"
:type '(repeat (alist :key-type symbol :value-type string))
:group 'dashboard)
(defcustom dashboard-items-default-length 20
"Length used for startup lists with otherwise unspecified bounds.
Set to nil for unbounded."
@@ -250,8 +278,29 @@ If nil it is disabled. Possible values for list-type are:
:type '(repeat (alist :key-type symbol :value-type string))
:group 'dashboard)
(defcustom dashboard-path-style nil
"Style to display path."
:type '(choice
(const :tag "No specify" nil)
(const :tag "Truncate the beginning part of the path" truncate-beginning)
(const :tag "Truncate the middle part of the path" truncate-middle)
(const :tag "Truncate the end part of the path" truncate-end))
:group 'dashboard)
(defcustom dashboard-path-max-length 70
"Maximum length for path to display."
:type 'integer
:group 'dashboard)
(defcustom dashboard-path-shorten-string "..."
"String the that displays in the center of the path."
:type 'string
:group 'dashboard)
(defvar recentf-list nil)
(defvar dashboard-buffer-name)
;;
;; Faces
;;
@@ -275,6 +324,16 @@ If nil it is disabled. Possible values for list-type are:
"Face used for widget headings."
:group 'dashboard)
(defface dashboard-items-face
'((t (:inherit widget-button)))
"Face used for items."
:group 'dashboard)
(defface dashboard-no-items-face
'((t (:inherit widget-button)))
"Face used for no items."
:group 'dashboard)
(defface dashboard-footer
'((t (:inherit font-lock-doc-face)))
"Face used for widget headings."
@@ -299,31 +358,45 @@ Return entire list if `END' is omitted."
(cl-subseq seq start (and (number-or-marker-p end)
(min len end)))))
(defun dashboard-get-shortcut (item)
"Get the shortcut to be used for ITEM."
(let ((elem (assq item dashboard-item-shortcuts)))
(and elem (cdr elem))))
(defmacro dashboard-insert-shortcut (shortcut-char
search-label
&optional no-next-line)
"Insert a shortcut SHORTCUT-CHAR for a given SEARCH-LABEL.
Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
`(progn
(eval-when-compile (defvar dashboard-mode-map))
(let ((sym (make-symbol (format "Jump to \"%s\"" ,search-label))))
(fset sym (lambda ()
(interactive)
(unless (search-forward ,search-label (point-max) t)
(search-backward ,search-label (point-min) t))
,@(unless no-next-line
'((forward-line 1)))
(back-to-indentation)))
(let* (;; Ensure punctuation and upper case in search string is not
;; used to construct the `defun'
(name (downcase (replace-regexp-in-string
"[[:punct:]]+" "" (format "%s" search-label) nil nil nil)))
;; Ensure whitespace in e.g. "recent files" is replaced with dashes.
(sym (intern (format "dashboard-jump-to-%s" (replace-regexp-in-string
"[[:blank:]]+" "-" name nil nil nil)))))
`(progn
(eval-when-compile (defvar dashboard-mode-map))
(defun ,sym nil
,(concat
"Jump to "
name
". This code is dynamically generated in `dashboard-insert-shortcut'.")
(interactive)
(unless (search-forward ,search-label (point-max) t)
(search-backward ,search-label (point-min) t))
,@(unless no-next-line
'((forward-line 1)))
(back-to-indentation))
(eval-after-load 'dashboard
(define-key dashboard-mode-map ,shortcut-char sym)))))
(define-key dashboard-mode-map ,shortcut-char ',sym)))))
(defun dashboard-append (msg &optional _messagebuf)
"Append MSG to dashboard buffer.
If MESSAGEBUF is not nil then MSG is also written in message buffer."
(with-current-buffer (get-buffer-create "*dashboard*")
(with-current-buffer (get-buffer-create dashboard-buffer-name)
(goto-char (point-max))
(let ((buffer-read-only nil))
(insert msg))))
(let ((buffer-read-only nil)) (insert msg))))
(defun dashboard-modify-heading-icons (alist)
"Append ALIST items to `dashboard-heading-icons' to modify icons."
@@ -364,7 +437,7 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(insert " "))
(insert (propertize heading 'face 'dashboard-heading))
(if shortcut (insert (format " (%s)" shortcut))))
(when shortcut (insert (format " (%s)" shortcut))))
(defun dashboard-center-line (string)
"Center a STRING accoring to it's size."
@@ -399,14 +472,18 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
"Display an image BANNER."
(when (file-exists-p banner)
(let* ((title dashboard-banner-logo-title)
(size-props
(append (when (> dashboard-image-banner-max-width 0)
(list :max-width dashboard-image-banner-max-width))
(when (> dashboard-image-banner-max-height 0)
(list :max-height dashboard-image-banner-max-height))))
(spec
(if (image-type-available-p 'imagemagick)
(apply 'create-image banner 'imagemagick nil
(append (when (> dashboard-image-banner-max-width 0)
(list :max-width dashboard-image-banner-max-width))
(when (> dashboard-image-banner-max-height 0)
(list :max-height dashboard-image-banner-max-height))))
(create-image banner)))
(apply 'create-image banner 'imagemagick nil size-props)
(apply 'create-image banner nil nil
(when (and (fboundp 'image-transforms-p)
(memq 'scale (funcall 'image-transforms-p)))
size-props))))
(size (image-size spec))
(width (car size))
(left-margin (max 0 (floor (- dashboard-banner-length width) 2))))
@@ -426,8 +503,7 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
"Insert init info when `dashboard-set-init-info' is t."
(when dashboard-set-init-info
(dashboard-center-line dashboard-init-info)
(insert
(propertize dashboard-init-info 'face 'font-lock-comment-face))))
(insert (propertize dashboard-init-info 'face 'font-lock-comment-face))))
(defun dashboard-get-banner-path (index)
"Return the full path to banner with index INDEX."
@@ -446,14 +522,14 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(dashboard-get-banner-path 1)))
((integerp dashboard-startup-banner)
(dashboard-get-banner-path dashboard-startup-banner))
((and dashboard-startup-banner
(image-type-available-p (intern (file-name-extension
dashboard-startup-banner)))
(display-graphic-p))
(if (file-exists-p dashboard-startup-banner)
((stringp dashboard-startup-banner)
(if (and (file-exists-p dashboard-startup-banner)
(or (string-suffix-p ".txt" dashboard-startup-banner)
(and (display-graphic-p)
(image-type-available-p (intern (file-name-extension
dashboard-startup-banner))))))
dashboard-startup-banner
(message (format "could not find banner %s"
dashboard-startup-banner))
(message "could not find banner %s, use default instead" dashboard-startup-banner)
(dashboard-get-banner-path 1)))
(t (dashboard-get-banner-path 1)))))
@@ -462,13 +538,12 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(goto-char (point-max))
(let ((banner (dashboard-choose-banner))
(buffer-read-only nil))
(progn
(when banner
(if (image-type-available-p (intern (file-name-extension banner)))
(dashboard-insert-image-banner banner)
(dashboard-insert-ascii-banner-centered banner))
(dashboard-insert-navigator)
(dashboard-insert-init-info)))))
(when banner
(if (image-type-available-p (intern (file-name-extension banner)))
(dashboard-insert-image-banner banner)
(dashboard-insert-ascii-banner-centered banner))
(dashboard-insert-navigator)
(dashboard-insert-init-info))))
(defun dashboard-insert-navigator ()
"Insert Navigator of the dashboard."
@@ -485,10 +560,11 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(widget-create 'item
:tag (concat
(when icon
(propertize icon 'face `(:inherit
,(get-text-property 0 'face icon)
:inherit
,face)))
(propertize icon 'face
(let ((prop-face (get-text-property 0 'face icon)))
(if prop-face
`(:inherit ,prop-face :inherit ,face)
`(:inherit ,face)))))
(when (and icon title
(not (string-equal icon ""))
(not (string-equal title "")))
@@ -496,7 +572,7 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(when title (propertize title 'face face)))
:help-echo help
:action action
:button-face `(:underline nil)
:button-face 'dashboard-items-face
:mouse-face 'highlight
:button-prefix prefix
:button-suffix suffix
@@ -516,15 +592,16 @@ ACTION is theaction taken when the user activates the widget button.
WIDGET-PARAMS are passed to the \"widget-create\" function."
`(progn
(dashboard-insert-heading ,section-name
(if (and ,list dashboard-show-shortcuts) ,shortcut))
(if (and ,list ,shortcut dashboard-show-shortcuts) ,shortcut))
(if ,list
(when (dashboard-insert-section-list
,section-name
(dashboard-subseq ,list 0 ,list-size)
,action
,@widget-params)
(when (and (dashboard-insert-section-list
,section-name
(dashboard-subseq ,list 0 ,list-size)
,action
,@widget-params)
,shortcut)
(dashboard-insert-shortcut ,shortcut ,section-name))
(insert "\n --- No items ---"))))
(insert (propertize "\n --- No items ---" 'face 'dashboard-no-items-face)))))
;;
;; Section list
@@ -557,7 +634,7 @@ WIDGET-PARAMS are passed to the \"widget-create\" function."
(widget-create 'item
:tag tag
:action ,action
:button-face `(:underline nil)
:button-face 'dashboard-items-face
:mouse-face 'highlight
:button-prefix ""
:button-suffix ""
@@ -580,135 +657,390 @@ WIDGET-PARAMS are passed to the \"widget-create\" function."
(insert (propertize footer 'face 'dashboard-footer))
(insert "\n"))))
;;
;; Truncate
;;
(defun dashboard-f-filename (path)
"Return file name from PATH."
(file-name-nondirectory path))
(defun dashboard-f-base (path)
"Return directory name from PATH."
(file-name-nondirectory (directory-file-name (file-name-directory path))))
(defun dashboard-shorten-path-beginning (path)
"Shorten PATH from beginning if exceeding maximum length."
(let* ((len-path (length path)) (len-rep (length dashboard-path-shorten-string))
(len-total (- dashboard-path-max-length len-rep))
front)
(if (<= len-path dashboard-path-max-length) path
(setq front (ignore-errors (substring path (- len-path len-total) len-path)))
(if front (concat dashboard-path-shorten-string front) ""))))
(defun dashboard-shorten-path-middle (path)
"Shorten PATH from middle if exceeding maximum length."
(let* ((len-path (length path)) (len-rep (length dashboard-path-shorten-string))
(len-total (- dashboard-path-max-length len-rep))
(center (/ len-total 2))
(end-back center)
(start-front (- len-path center))
back front)
(if (<= len-path dashboard-path-max-length) path
(setq back (substring path 0 end-back)
front (ignore-errors (substring path start-front len-path)))
(if front (concat back dashboard-path-shorten-string front) ""))))
(defun dashboard-shorten-path-end (path)
"Shorten PATH from end if exceeding maximum length."
(let* ((len-path (length path)) (len-rep (length dashboard-path-shorten-string))
(len-total (- dashboard-path-max-length len-rep))
back)
(if (<= len-path dashboard-path-max-length) path
(setq back (ignore-errors (substring path 0 len-total)))
(if (and back (< 0 dashboard-path-max-length))
(concat back dashboard-path-shorten-string) ""))))
(defun dashboard-shorten-path (path)
"Shorten the PATH."
(setq path (abbreviate-file-name path))
(cl-case dashboard-path-style
(truncate-beginning (dashboard-shorten-path-beginning path))
(truncate-middle (dashboard-shorten-path-middle path))
(truncate-end (dashboard-shorten-path-end path))
(t path)))
(defun dashboard-shorten-paths (paths alist)
"Shorten all path from PATHS and store it to ALIST."
(let (lst-display abbrev (index 0))
(setf (symbol-value alist) nil) ; reset
(dolist (item paths)
(setq abbrev (dashboard-shorten-path item)
;; Add salt here, and use for extraction.
;; See function `dashboard-extract-key-path-alist'.
abbrev (format "%s|%s" index abbrev))
;; store `abbrev' as id; and `item' with value
(push (cons abbrev item) (symbol-value alist))
(push abbrev lst-display)
(cl-incf index))
(reverse lst-display)))
(defun dashboard-extract-key-path-alist (key alist)
"Remove salt from KEY, and return true shorten path from ALIST."
(let* ((key (car (assoc key alist))) (split (split-string key "|")))
(nth 1 split)))
(defun dashboard-expand-path-alist (key alist)
"Get the full path (un-shorten) using KEY from ALIST."
(cdr (assoc key alist)))
(defun dashboard--generate-align-format (fmt len)
"Return FMT after inserting align LEN."
(let ((pos (1+ (string-match-p "%s" fmt))))
(concat (substring fmt 0 pos)
(concat "-" (number-to-string len))
(substring fmt pos (length fmt)))))
(defun dashboard--get-align-length (alist &optional dir)
"Return maximum align length from ALIST.
If optional argument DIR is non-nil; align with directory name instead."
(let ((align-length -1) path len-path)
(dolist (item alist)
(setq path (cdr item)
path (if dir (dashboard-f-base path) (dashboard-f-filename path))
len-path (length path)
align-length (max len-path align-length)))
align-length))
;;
;; Recentf
;;
(defcustom dashboard-recentf-show-base nil
"Show the base file name infront of it's path."
:type '(choice
(const :tag "Don't show the base infront" nil)
(const :tag "Respect format" t)
(const :tag "Align the from base" align))
:group 'dashboard)
(defcustom dashboard-recentf-item-format "%s %s"
"Format to use when showing the base of the file name."
:type 'string
:group 'dashboard)
(defvar dashboard-recentf-alist nil
"Alist records shorten's recent files and it's full paths.")
(defvar dashboard--recentf-cache-item-format nil
"Cache to record the new generated align format.")
(defun dashboard-insert-recents (list-size)
"Add the list of LIST-SIZE items from recently edited files."
(setq dashboard--recentf-cache-item-format nil)
(recentf-mode)
(dashboard-insert-section
"Recent Files:"
recentf-list
(dashboard-shorten-paths recentf-list 'dashboard-recentf-alist)
list-size
"r"
`(lambda (&rest ignore) (find-file-existing ,el))
(abbreviate-file-name el)))
(dashboard-get-shortcut 'recents)
`(lambda (&rest ignore)
(find-file-existing (dashboard-expand-path-alist ,el dashboard-recentf-alist)))
(let* ((file (dashboard-expand-path-alist el dashboard-recentf-alist))
(filename (dashboard-f-filename file))
(path (dashboard-extract-key-path-alist el dashboard-recentf-alist)))
(cl-case dashboard-recentf-show-base
(align
(unless dashboard--recentf-cache-item-format
(let* ((len-align (dashboard--get-align-length dashboard-recentf-alist))
(new-fmt (dashboard--generate-align-format
dashboard-recentf-item-format len-align)))
(setq dashboard--recentf-cache-item-format new-fmt)))
(format dashboard--recentf-cache-item-format filename path))
(nil (format dashboard-recentf-item-format filename path))
(t path)))))
;;
;; Bookmarks
;;
(defvar dashboard-bookmark-alist nil
"Alist records shorten's recent files and it's full paths.")
(defun dashboard-insert-bookmarks (list-size)
"Add the list of LIST-SIZE items of bookmarks."
(require 'bookmark)
(dashboard-insert-section
"Bookmarks:"
(dashboard-subseq (bookmark-all-names)
0 list-size)
(dashboard-subseq (bookmark-all-names) 0 list-size)
list-size
"m"
(dashboard-get-shortcut 'bookmarks)
`(lambda (&rest ignore) (bookmark-jump ,el))
(let ((file (bookmark-get-filename el)))
(if file
(format "%s - %s" el (abbreviate-file-name file))
(format "%s - %s" el (dashboard-shorten-path file))
el))))
;;
;; Projectile
;; Projects
;;
(defcustom dashboard-projects-switch-function
nil
"Custom function to switch to projects from dashboard.
If non-NIL, should be bound to a function with one argument. The
function will be called with the root directory of the project to
switch to."
:type '(choice (const :tag "Default" nil) function)
:group 'dashboard)
(defcustom dashboard-projects-show-base nil
"Show the project name infront of it's path."
:type '(choice
(const :tag "Don't show the base infront" nil)
(const :tag "Respect format" t)
(const :tag "Align the from base" align))
:group 'dashboard)
(defcustom dashboard-projects-item-format "%s %s"
"Format to use when showing the base of the project name."
:type 'string
:group 'dashboard)
(defvar dashboard-projects-alist nil
"Alist records the shorten's project paths and it's full paths.")
(defvar dashboard--projects-cache-item-format nil
"Cache to record the new generated align format.")
(defun dashboard-insert-projects (list-size)
"Add the list of LIST-SIZE items of projects."
(require 'projectile)
(let ((inhibit-message t) (message-log-max nil))
(projectile-cleanup-known-projects))
(projectile-load-known-projects)
(setq dashboard--projects-cache-item-format nil)
(dashboard-insert-section
"Projects:"
(dashboard-subseq (projectile-relevant-known-projects)
0 list-size)
(dashboard-shorten-paths
(dashboard-subseq (dashboard-projects-backend-load-projects) 0 list-size)
'dashboard-projects-alist)
list-size
"p"
`(lambda (&rest ignore) (projectile-switch-project-by-name ,el))
(abbreviate-file-name el)))
(dashboard-get-shortcut 'projects)
`(lambda (&rest ignore)
(funcall (dashboard-projects-backend-switch-function)
(dashboard-expand-path-alist ,el dashboard-projects-alist)))
(let* ((file (dashboard-expand-path-alist el dashboard-projects-alist))
(filename (dashboard-f-base file))
(path (dashboard-extract-key-path-alist el dashboard-projects-alist)))
(cl-case dashboard-projects-show-base
(align
(unless dashboard--projects-cache-item-format
(let* ((len-align (dashboard--get-align-length dashboard-projects-alist t))
(new-fmt (dashboard--generate-align-format
dashboard-projects-item-format len-align)))
(setq dashboard--projects-cache-item-format new-fmt)))
(format dashboard--projects-cache-item-format filename path))
(nil (format dashboard-projects-item-format filename path))
(t path)))))
(defun dashboard-projects-backend-load-projects ()
"Depending on `dashboard-projects-backend' load corresponding backend.
Return function that returns a list of projects."
(cond
((eq dashboard-projects-backend 'projectile)
(require 'projectile)
(let ((inhibit-message t) (message-log-max nil))
(projectile-cleanup-known-projects))
(projectile-load-known-projects))
((eq dashboard-projects-backend 'project-el)
(require 'project)
(project-known-project-roots))
(t
(display-warning '(dashboard)
"Invalid value for `dashboard-projects-backend'"
:error))))
(defun dashboard-projects-backend-switch-function ()
"Return the function to switch to a project.
Custom variable `dashboard-projects-switch-function' variable takes preference
over custom backends."
(or dashboard-projects-switch-function
(cond
((eq dashboard-projects-backend 'projectile)
'projectile-switch-project-by-name)
((eq dashboard-projects-backend 'project-el)
(lambda (project)
"This function is used to switch to `PROJECT'."
(let ((default-directory project))
(project-find-file))))
(t
(display-warning '(dashboard)
"Invalid value for `dashboard-projects-backend'"
:error)))))
;;
;; Org Agenda
;;
(defun dashboard-timestamp-to-gregorian-date (timestamp)
"Convert TIMESTAMP to a gregorian date.
(defcustom dashboard-week-agenda t
"Show agenda weekly if its not nil."
:type 'boolean
:group 'dashboard)
The result can be used with functions like
`calendar-date-compare'."
(let ((decoded-timestamp (decode-time timestamp)))
(list (nth 4 decoded-timestamp)
(nth 3 decoded-timestamp)
(nth 5 decoded-timestamp))))
(defcustom dashboard-agenda-time-string-format "%Y-%m-%d"
"Format time of agenda entries."
:type 'string
:group 'dashboard)
(defun dashboard-date-due-p (timestamp &optional due-date)
"Check if TIMESTAMP is today or in the past.
(defcustom dashboard-match-agenda-entry nil
"Match agenda to extra filter.
It is the MATCH attribute for `org-map-entries'"
:type 'string
:group 'dashboard)
If DUE-DATE is nil, compare TIMESTAMP to today; otherwise,
compare to the date in DUE-DATE.
(defun dashboard-agenda-entry-time (schedule-time)
"Format SCHEDULE-TIME with custom format.
If SCHEDULE-TIME is nil returns a blank string which length
is todays date format."
(let* ((time (or schedule-time (org-today)))
(formated-time (format-time-string
dashboard-agenda-time-string-format time)))
(if schedule-time
formated-time
(replace-regexp-in-string "." " " formated-time))))
The time part of both TIMESTAMP and DUE-DATE is ignored, only the
date part is considered."
(unless due-date
(setq due-date (current-time)))
(setq due-date (time-add due-date 86400))
(let* ((gregorian-date (dashboard-timestamp-to-gregorian-date timestamp))
(gregorian-due-date (dashboard-timestamp-to-gregorian-date due-date)))
(calendar-date-compare (list gregorian-date)
(list gregorian-due-date))))
(defun dashboard-agenda-entry-format ()
"Format agenda entry to show it on dashboard."
(let* ((schedule-time (org-get-scheduled-time (point)))
(deadline-time (org-get-deadline-time (point)))
(item (org-agenda-format-item
(dashboard-agenda-entry-time (or schedule-time deadline-time))
(org-get-heading)
(org-outline-level)
(org-get-category)
(org-get-tags)
t))
(loc (point))
(file (buffer-file-name)))
(dashboard-agenda--set-agenda-headline-face item)
(list item loc file)))
(defun dashboard-agenda--set-agenda-headline-face (headline)
"Set agenda faces to `HEADLINE' when face text property is nil."
(let ((todo (org-get-todo-state))
(org-level-face (nth (- (org-outline-level) 1) org-level-faces)))
(dashboard-agenda--set-face-when-match org-level-face
(org-get-heading t t t t)
headline)
(dashboard-agenda--set-face-when-match (org-get-todo-face todo)
todo
headline)))
(defun dashboard-agenda--set-face-when-match (face text entry)
"Set `FACE' to match text between `TEXT' and `ENTRY'.
Do nothing if `TEXT' has already a face property or is nil."
(let ((match-part (and text (string-match text entry))))
(when (and match-part (null (get-text-property 0 'face text)))
(add-face-text-property (match-beginning 0) (match-end 0)
face t entry))))
(defun dashboard-due-date-for-agenda ()
"Return due-date for agenda period."
(if dashboard-week-agenda
(time-add (current-time) (* 86400 8))
(time-add (current-time) 86400)))
(defun dashboard-filter-agenda-by-time ()
"Include entry if it has a schedule-time or deadline-time in the future.
An entry is included if this function returns nil and excluded
if returns a point."
(let ((schedule-time (org-get-scheduled-time (point)))
(deadline-time (org-get-deadline-time (point)))
(due-date (dashboard-due-date-for-agenda)))
(unless (and (not (org-entry-is-done-p))
(or (and schedule-time
(org-time-less-p schedule-time due-date))
(and deadline-time
(org-time-less-p deadline-time due-date))))
(point))))
(defun dashboard-filter-agenda-by-todo ()
"Include entry if it is todo and not done.
An entry is included if this function returns nil and excluded
if returns a point."
(unless (and (org-entry-is-todo-p)
(not (org-entry-is-done-p)))
(point)))
(defun dashboard-no-filter-agenda ()
"No filter agenda entries."
(when (org-entry-is-done-p) (point)))
(defcustom dashboard-filter-agenda-entry 'dashboard-filter-agenda-by-time
"Function to filter `org-agenda' entries."
:type '(choice
(const :tag "No filter" dashboard-no-filter-agenda)
(const :tag "Filter by time" dashboard-filter-agenda-by-time)
(const :tag "Filter by todo" dashboard-filter-agenda-by-todo)
(function :tag "Custom function"))
:group 'dashboard)
(defun dashboard-get-agenda ()
"Get agenda items for today or for a week from now."
(org-compile-prefix-format 'agenda)
(let ((due-date nil))
(if (and (boundp 'show-week-agenda-p) show-week-agenda-p)
(setq due-date (time-add (current-time) (* 86400 7)))
(setq due-date nil)
)
(let* ((filtered-entries nil))
(org-map-entries
(lambda ()
(let* ((schedule-time (org-get-scheduled-time (point)))
(deadline-time (org-get-deadline-time (point)))
(item (org-agenda-format-item
(format-time-string "%Y-%m-%d" schedule-time)
(org-get-heading t t)
(org-outline-level)
(org-get-category)
(org-get-tags)
t))
(loc (point))
(file (buffer-file-name)))
(if (or (equal dashboard-org-agenda-categories nil)
(member (org-get-category) dashboard-org-agenda-categories))
(when (and (not (org-entry-is-done-p))
(or (and schedule-time (dashboard-date-due-p schedule-time due-date))
(and deadline-time (dashboard-date-due-p deadline-time due-date))))
(setq filtered-entries
(append filtered-entries
(list (list item schedule-time deadline-time loc file))))))))
nil
'agenda)
filtered-entries)))
(org-map-entries 'dashboard-agenda-entry-format
dashboard-match-agenda-entry
'agenda
dashboard-filter-agenda-entry))
(defun dashboard-insert-agenda (list-size)
"Add the list of LIST-SIZE items of agenda."
(require 'org-agenda)
(require 'calendar)
(let ((agenda (dashboard-get-agenda)))
(dashboard-insert-section
(or (and (boundp 'show-week-agenda-p) show-week-agenda-p "Agenda for the coming week:")
"Agenda for today:")
(if dashboard-week-agenda
"Agenda for the coming week:"
"Agenda for today:")
agenda
list-size
"a"
(dashboard-get-shortcut 'agenda)
`(lambda (&rest ignore)
(let ((buffer (find-file-other-window (nth 4 ',el))))
(let ((buffer (find-file-other-window (nth 2 ',el))))
(with-current-buffer buffer
(goto-char (nth 3 ',el)))
(switch-to-buffer buffer)))
(goto-char (nth 1 ',el))
(switch-to-buffer buffer))))
(format "%s" (nth 0 el)))))
;;
@@ -721,7 +1053,7 @@ date part is considered."
"Registers:"
register-alist
list-size
"e"
(dashboard-get-shortcut 'registers)
(lambda (&rest _ignore) (jump-to-register (car el)))
(format "%c - %s" (car el) (register-describe-oneline (car el)))))

55
lisp/dashboard/dashboard.el
View File

@@ -1,6 +1,8 @@
;;; dashboard.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
;; Copyright (c) 2016-2020 Rakan Al-Hneiti & Contributors
;; Copyright (c) 2016-2020 Rakan Al-Hneiti <rakan.alhneiti@gmail.com>
;; Copyright (c) 2019-2020 Jesús Martínez <jesusmartinez93@gmail.com>
;; Copyright (c) 2020 Shen, Jen-Chieh <jcs090218@gmail.com>
;;
;; Author: Rakan Al-Hneiti
;; URL: https://github.com/emacs-dashboard/emacs-dashboard
@@ -16,12 +18,11 @@
;;; Commentary:
;; An extensible Emacs dashboard, with sections for
;; bookmarks, projectile projects, org-agenda and more.
;; bookmarks, projects (projectile or project.el), org-agenda and more.
;;; Code:
(require 'seq)
(require 'page-break-lines)
(require 'recentf)
(require 'dashboard-widgets)
@@ -39,13 +40,18 @@
(define-key map (kbd "C-i") 'widget-forward)
(define-key map [backtab] 'widget-backward)
(define-key map (kbd "RET") 'dashboard-return)
(define-key map [down-mouse-1] 'widget-button-click)
(define-key map [mouse-1] 'dashboard-mouse-1)
(define-key map (kbd "g") #'dashboard-refresh-buffer)
(define-key map (kbd "}") #'dashboard-next-section)
(define-key map (kbd "{") #'dashboard-previous-section)
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.
\\<dashboard-mode-map>
@@ -59,8 +65,8 @@
(when (>= emacs-major-version 26)
(display-line-numbers-mode -1))
(page-break-lines-mode 1)
(setq inhibit-startup-screen t)
(setq buffer-read-only t
(setq inhibit-startup-screen t
buffer-read-only t
truncate-lines t))
(defgroup dashboard nil
@@ -153,6 +159,13 @@ Optional prefix ARG says how many lines to move; default is one line."
(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))))
(defun dashboard-maximum-section-length ()
"For the just-inserted section, calculate the length of the longest line."
(let ((max-line-length 0))
@@ -162,7 +175,7 @@ Optional prefix ARG says how many lines to move; default is one line."
(setq max-line-length
(max max-line-length
(- (line-end-position) (line-beginning-position))))
(forward-line)))
(forward-line 1)))
max-line-length))
(defun dashboard-insert-startupify-lists ()
@@ -180,8 +193,8 @@ Optional prefix ARG says how many lines to move; default is one line."
;; then restore the orginal list afterwards
;; (this avoids many saves/loads that would result from
;; disabling/enabling recentf-mode)
(if recentf-is-on
(setq recentf-list (seq-take recentf-list dashboard-num-recents)))
(when recentf-is-on
(setq recentf-list (seq-take recentf-list dashboard-num-recents)))
(when (or (not (eq dashboard-buffer-last-width (window-width)))
(not buffer-exists))
(setq dashboard-banner-length (window-width)
@@ -208,16 +221,16 @@ Optional prefix ARG says how many lines to move; default is one line."
(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))))
(let ((margin (floor (/ (max (- (window-width) max-line-length) 0) 2))))
(while (not (eobp))
(and (not (eq ? (char-after)))
(insert (make-string margin ?\ )))
(unless (string-suffix-p (thing-at-point 'line) dashboard-page-separator)
(insert (make-string margin ?\ )))
(forward-line 1))))
(dashboard-insert-footer))
(dashboard-mode)
(goto-char (point-min))))
(if recentf-is-on
(setq recentf-list origial-recentf-list))))
(goto-char (point-min))
(dashboard-mode)))
(when recentf-is-on
(setq recentf-list origial-recentf-list))))
(add-hook 'window-setup-hook
(lambda ()
@@ -227,7 +240,8 @@ Optional prefix ARG says how many lines to move; default is one line."
(defun dashboard-refresh-buffer ()
"Refresh buffer."
(interactive)
(kill-buffer dashboard-buffer-name)
(when (get-buffer dashboard-buffer-name)
(kill-buffer dashboard-buffer-name))
(dashboard-insert-startupify-lists)
(switch-to-buffer dashboard-buffer-name))
@@ -245,14 +259,15 @@ Optional prefix ARG says how many lines to move; default is one line."
"Setup post initialization hooks.
If a command line argument is provided,
assume a filename and skip displaying Dashboard."
(when (< (length command-line-args) 2 )
(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*")
(switch-to-buffer dashboard-buffer-name)
(goto-char (point-min))
(redisplay)))))
(redisplay)
(run-hooks 'dashboard-after-initialize-hook)))))
(provide 'dashboard)
;;; dashboard.el ends here