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
2025-02-26 20:16:44 +01:00
parent 59db017445
commit 45d49daef0
291 changed files with 16240 additions and 522600 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,6 +1,6 @@
;;; dashboard-widgets.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
;; Copyright (c) 2016-2023 emacs-dashboard maintainers
;; Copyright (c) 2016-2025 emacs-dashboard maintainers
;; This file is not part of GNU Emacs.
;;
@@ -15,8 +15,13 @@
(require 'cl-lib)
(require 'image)
(require 'mule-util)
(require 'rect)
(require 'subr-x)
;;
;;; Externals
;; 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")
@@ -50,13 +55,13 @@
(declare-function org-get-todo-face "ext:org.el")
(declare-function org-get-todo-state "ext:org.el")
(declare-function org-in-archived-heading-p "ext:org.el")
(declare-function org-link-display-format "ext:org.el")
(declare-function org-map-entries "ext:org.el")
(declare-function org-outline-level "ext:org.el")
(declare-function org-release-buffers "ext:org.el")
(declare-function org-time-string-to-time "ext:org.el")
(declare-function org-today "ext:org.el")
(declare-function recentf-cleanup "ext:recentf.el")
(defalias 'org-time-less-p 'time-less-p)
(defvar org-level-faces)
(defvar org-agenda-new-buffers)
(defvar org-agenda-prefix-format)
@@ -68,9 +73,21 @@
(declare-function string-pixel-width "subr-x.el") ; TODO: remove this after 29.1
(declare-function shr-string-pixel-width "shr.el") ; TODO: remove this after 29.1
(defcustom dashboard-page-separator "\n\n"
(defvar truncate-string-ellipsis)
(declare-function truncate-string-ellipsis "mule-util.el") ; TODO: remove this after 28.1
(defvar recentf-list nil)
(defvar dashboard-buffer-name)
;;
;;; Customization
(defcustom dashboard-page-separator "\n"
"Separator to use between the different pages."
:type 'string
:type '(choice
(const :tag "Default" "\n")
(const :tag "Use Page indicator (requires page-break-lines)"
"\n\f\n")
(string :tag "Use Custom String"))
:group 'dashboard)
(defcustom dashboard-image-banner-max-height 0
@@ -93,6 +110,14 @@ preserved."
:type 'integer
:group 'dashboard)
(defcustom dashboard-image-extra-props nil
"Additional image attributes to assign to the image.
This could be useful for displaying images with transparency,
for example, by setting the `:mask' property to `heuristic'.
See `create-image' and Info node `(elisp)Image Descriptors'."
:type 'plist
:group 'dashboard)
(defcustom dashboard-set-heading-icons nil
"When non nil, heading sections will have icons."
:type 'boolean
@@ -107,16 +132,22 @@ preserved."
"When non nil, a navigator will be displayed under the banner."
:type 'boolean
:group 'dashboard)
(make-obsolete-variable 'dashboard-set-navigator
'dashboard-startupify-list "1.9.0")
(defcustom dashboard-set-init-info t
"When non nil, init info will be displayed under the banner."
:type 'boolean
:group 'dashboard)
(make-obsolete-variable 'dashboard-set-init-info
'dashboard-startupify-list "1.9.0")
(defcustom dashboard-set-footer t
"When non nil, a footer will be displayed at the bottom."
:type 'boolean
:group 'dashboard)
(make-obsolete-variable 'dashboard-set-footer
'dashboard-startupify-list "1.9.0")
(defcustom dashboard-footer-messages
'("The one true editor, Emacs!"
@@ -128,7 +159,7 @@ preserved."
"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
:type '(list string)
:group 'dashboard)
(defcustom dashboard-icon-type (and (or dashboard-set-heading-icons
@@ -166,7 +197,7 @@ The value can be one of: `all-the-icons', `nerd-icons'."
Will be of the form `(list-type . icon-name-string)`.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'"
:type '(repeat (alist :key-type symbol :value-type string))
:type '(alist :key-type symbol :value-type string)
:group 'dashboard)
(defcustom dashboard-heading-icon-height 1.2
@@ -179,6 +210,16 @@ If nil it is disabled. Possible values for list-type are:
:type 'float
:group 'dashboard)
(defcustom dashboard-icon-file-height 1.0
"The height of the file icons."
:type 'float
:group 'dashboard)
(defcustom dashboard-icon-file-v-adjust -0.05
"The v-adjust of the file icons."
:type 'float
:group 'dashboard)
(defcustom dashboard-agenda-item-icon
(pcase dashboard-icon-type
('all-the-icons (all-the-icons-octicon "primitive-dot" :height 1.0 :v-adjust 0.01))
@@ -187,6 +228,11 @@ If nil it is disabled. Possible values for list-type are:
:type 'string
:group 'dashboard)
(defcustom dashboard-agenda-action 'dashboard-agenda--visit-file-other-window
"Function to call when dashboard make an action over agenda item."
:type 'function
:group 'dashboard)
(defcustom dashboard-remote-path-icon
(pcase dashboard-icon-type
('all-the-icons (all-the-icons-octicon "radio-tower" :height 1.0 :v-adjust 0.01))
@@ -230,7 +276,16 @@ The format is: `icon title help action face prefix suffix`.
Example:
`((\"☆\" \"Star\" \"Show stars\" (lambda (&rest _)
(show-stars)) warning \"[\" \"]\"))"
:type '(repeat (repeat (list string string string function symbol string string)))
:type '(repeat (repeat (list string
string
string
function
(choice face
(repeat :tag "Anonymous face" sexp))
(choice string
(const nil))
(choice string
(const nil)))))
:group 'dashboard)
(defcustom dashboard-init-info
@@ -320,26 +375,43 @@ ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties.
:v-adjust -0.05
:face 'dashboard-footer-icon-face)))
(propertize ">" 'face 'dashboard-footer-icon-face))
"Footer's icon."
"Footer's icon.
It can be a string or a string list for display random icons."
:type '(choice string
(repeat string))
:group 'dashboard)
(defcustom dashboard-heading-shorcut-format " (%s)"
"String for display key used in headings."
:type 'string
:group 'dashboard)
(defcustom dashboard-startup-banner 'official
"Specify the startup banner.
Default value is `official', it displays the Emacs logo. `logo' displays Emacs
alternative logo. If set to `ascii', the value of `dashboard-banner-ascii'
will be used as the banner. An integer value is the index of text 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 "no banner" nil)
(const :tag "offical" official)
"Specify the banner type to use.
Value can be
- \\='official displays the official Emacs logo.
- \\='logo displays an alternative Emacs logo.
- an integer which displays one of the text banners.
- a string that specifies the path of an custom banner
supported files types are gif/image/text/xbm.
- a cons of 2 strings which specifies the path of an image to use
and other path of a text file to use if image isn't supported.
- a list that can display an random banner, supported values are:
string (filepath), \\='official, \\='logo and integers."
:type '(choice (const :tag "official" official)
(const :tag "logo" logo)
(const :tag "ascii" ascii)
(integer :tag "index of a text banner")
(string :tag "a path to an image or text banner")
(cons :tag "an image and text banner"
(string :tag "path to an image or text banner")
(cons :tag "image and text banner"
(string :tag "image banner path")
(string :tag "text banner path")))
(string :tag "text banner path"))
(repeat :tag "random banners"
(choice (string :tag "a path to an image or text banner")
(const :tag "official" official)
(const :tag "logo" logo)
(const :tag "ascii" ascii)
(integer :tag "index of a text banner"))))
:group 'dashboard)
(defcustom dashboard-item-generators
@@ -352,10 +424,10 @@ nil then no banner is displayed."
Will be of the form `(list-type . list-function)'.
Possible values for list-type are: `recents', `bookmarks', `projects',
`agenda' ,`registers'."
:type '(repeat (alist :key-type symbol :value-type function))
:type '(alist :key-type symbol :value-type function)
:group 'dashboard)
(defcustom dashboard-projects-backend 'projectile
(defcustom dashboard-projects-backend 'project-el
"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',
@@ -381,7 +453,9 @@ installed."
Will be of the form `(list-type . list-size)'.
If nil it is disabled. Possible values for list-type are:
`recents' `bookmarks' `projects' `agenda' `registers'."
:type '(repeat (alist :key-type symbol :value-type integer))
:type '(repeat (choice
symbol
(cons symbol integer)))
:group 'dashboard)
(defcustom dashboard-item-shortcuts
@@ -393,8 +467,8 @@ If nil it is disabled. Possible values for list-type are:
"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))
shortcut is disabled. See `dashboard-items' for possible values of list-type.'"
:type '(alist :key-type symbol :value-type string)
:group 'dashboard)
(defcustom dashboard-item-names nil
@@ -402,8 +476,12 @@ shortcut is disbaled. See `dashboard-items' for possible values of list-type.'"
When an item is nil or not present, the default name is used.
Will be of the form `(default-name . new-name)'."
:type '(alist :key-type string :value-type string)
:options '("Recent Files:" "Bookmarks:" "Agenda for today:"
"Agenda for the coming week:" "Registers:" "Projects:")
:options '("Recent Files:"
"Bookmarks:"
"Agenda for today:"
"Agenda for the coming week:"
"Registers:"
"Projects:")
:group 'dashboard)
(defcustom dashboard-items-default-length 20
@@ -426,18 +504,9 @@ Set to nil for unbounded."
: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
;;
;;; Faces
(defface dashboard-text-banner
'((t (:inherit font-lock-keyword-face)))
"Face used for text banners."
@@ -486,8 +555,8 @@ Set to nil for unbounded."
'dashboard-heading-face 'dashboard-heading "1.2.6")
;;
;; Util
;;
;;; Util
(defmacro dashboard-mute-apply (&rest body)
"Execute BODY without message."
(declare (indent 0) (debug t))
@@ -515,8 +584,8 @@ Set to nil for unbounded."
(if (zerop (% len width)) 0 1)))) ; add one if exceeed
;;
;; Generic widget helpers
;;
;;; Widget helpers
(defun dashboard-subseq (seq end)
"Return the subsequence of SEQ from 0 to END."
(let ((len (length seq))) (butlast seq (- len (min len end)))))
@@ -548,7 +617,8 @@ Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
`(progn
(eval-when-compile (defvar dashboard-mode-map))
(defun ,sym nil
,(concat "Jump to " name ". This code is dynamically generated in `dashboard-insert-shortcut'.")
,(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))
@@ -573,6 +643,14 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
"Insert a page break line in dashboard buffer."
(dashboard-append dashboard-page-separator))
(defun dashboard-insert-newline (&optional times)
"When called without an argument, insert a newline.
When called with TIMES return a function that insert TIMES number of newlines."
(if times
(lambda ()
(insert (make-string times (string-to-char "\n") t)))
(insert "\n")))
(defun dashboard-insert-heading (heading &optional shortcut icon)
"Insert a widget HEADING in dashboard buffer, adding SHORTCUT, ICON if provided."
(when (and (dashboard-display-icons-p) dashboard-set-heading-icons)
@@ -611,10 +689,10 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(let ((ov (make-overlay (- (point) (length heading)) (point) nil t)))
(overlay-put ov 'display (or (cdr (assoc heading dashboard-item-names)) heading))
(overlay-put ov 'face 'dashboard-heading))
(when shortcut (insert (format " (%s)" shortcut))))
(when shortcut (insert (format dashboard-heading-shorcut-format shortcut))))
(defun dashboard-center-text (start end)
"Center the text between START and END."
(defun dashboard--find-max-width (start end)
"Return the max width within the region START and END."
(save-excursion
(goto-char start)
(let ((width 0))
@@ -623,8 +701,13 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(line-length (dashboard-str-len line-str)))
(setq width (max width line-length)))
(forward-line 1))
(let ((prefix (propertize " " 'display `(space . (:align-to (- center ,(/ width 2)))))))
(add-text-properties start end `(line-prefix ,prefix indent-prefix ,prefix))))))
width)))
(defun dashboard-center-text (start end)
"Center the text between START and END."
(let* ((width (dashboard--find-max-width start end))
(prefix (propertize " " 'display `(space . (:align-to (- center ,(/ (float width) 2)))))))
(add-text-properties start end `(line-prefix ,prefix indent-prefix ,prefix))))
(defun dashboard-insert-center (&rest strings)
"Insert STRINGS in the center of the buffer."
@@ -633,8 +716,7 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
(dashboard-center-text start (point))))
;;
;; BANNER
;;
;;; Banner
(defun dashboard-get-banner-path (index)
"Return the full path to banner with index INDEX."
@@ -647,10 +729,9 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
;; - That function will only look at filenames, this one will inspect the file data itself.
(and (file-exists-p img) (ignore-errors (image-type-available-p (image-type img)))))
(defun dashboard-choose-banner ()
"Return a plist specifying the chosen banner based on `dashboard-startup-banner'."
(pcase dashboard-startup-banner
('nil nil)
(defun dashboard-choose-banner (banner)
"Return a plist specifying the chosen banner based on BANNER."
(pcase banner
('official
(append (when (image-type-available-p 'png)
(list :image dashboard-banner-official-png))
@@ -662,24 +743,29 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
('ascii
(append (list :text dashboard-banner-ascii)))
((pred integerp)
(list :text (dashboard-get-banner-path dashboard-startup-banner)))
(list :text (dashboard-get-banner-path banner)))
((pred stringp)
(pcase dashboard-startup-banner
(pcase banner
((pred (lambda (f) (not (file-exists-p f))))
(message "could not find banner %s, use default instead" dashboard-startup-banner)
(message "could not find banner %s, use default instead" banner)
(list :text (dashboard-get-banner-path 1)))
((pred (string-suffix-p ".txt"))
(list :text (if (file-exists-p dashboard-startup-banner)
dashboard-startup-banner
(message "could not find banner %s, use default instead" dashboard-startup-banner)
(list :text (if (file-exists-p banner)
banner
(message "could not find banner %s, use default instead" banner)
(dashboard-get-banner-path 1))))
((pred dashboard--image-supported-p)
(list :image dashboard-startup-banner
(list :image banner
:text (dashboard-get-banner-path 1)))
(_
(message "unsupported file type %s" (file-name-nondirectory dashboard-startup-banner))
(message "unsupported file type %s" (file-name-nondirectory banner))
(list :text (dashboard-get-banner-path 1)))))
(`(,img . ,txt)
((and
(pred listp)
(pred (lambda (c)
(and (not (proper-list-p c))
(not (null c)))))
`(,img . ,txt))
(list :image (if (dashboard--image-supported-p img)
img
(message "could not find banner %s, use default instead" img)
@@ -688,57 +774,77 @@ If MESSAGEBUF is not nil then MSG is also written in message buffer."
txt
(message "could not find banner %s, use default instead" txt)
(dashboard-get-banner-path 1))))
(_
(message "unsupported banner config %s" dashboard-startup-banner))))
((and
(pred proper-list-p)
(pred (lambda (l) (not (null l)))))
(defun dashboard--type-is-gif-p (image-path)
"Return if image is a gif.
(let* ((max (length banner))
(choose (nth (random max) banner)))
(dashboard-choose-banner choose)))
(_
(user-error "Unsupported banner type: `%s'" banner)
nil)))
(defun dashboard--image-animated-p (image-path)
"Return if image is a gif or webp.
String -> bool.
Argument IMAGE-PATH path to the image."
(eq 'gif (image-type image-path)))
(memq (image-type image-path) '(gif webp)))
(defun dashboard--type-is-xbm-p (image-path)
"Return if image is a xbm.
String -> bool.
Argument IMAGE-PATH path to the image."
(eq 'xbm (image-type image-path)))
(defun dashboard-insert-banner ()
"Insert the banner at the top of the dashboard."
(goto-char (point-max))
(when-let (banner (dashboard-choose-banner))
(when-let* ((banner (dashboard-choose-banner dashboard-startup-banner)))
(insert "\n")
(let ((start (point))
buffer-read-only
text-width
image-spec)
(when (display-graphic-p) (insert "\n"))
image-spec
(graphic-mode (display-graphic-p)))
(when graphic-mode (insert "\n"))
;; If specified, insert a text banner.
(when-let (txt (plist-get banner :text))
(if (eq dashboard-startup-banner 'ascii)
(save-excursion (insert txt))
(insert-file-contents txt))
(put-text-property (point) (point-max) 'face 'dashboard-text-banner)
(when-let* ((txt (plist-get banner :text)))
(if (file-exists-p txt)
(insert-file-contents txt)
(save-excursion (insert txt)))
(unless (text-properties-at 0 txt)
(put-text-property (point) (point-max) 'face 'dashboard-text-banner))
(setq text-width 0)
(while (not (eobp))
(let ((line-length (- (line-end-position) (line-beginning-position))))
(if (< text-width line-length)
(setq text-width line-length)))
(when (< text-width line-length)
(setq text-width line-length)))
(forward-line 1)))
;; If specified, insert an image banner. When displayed in a graphical frame, this will
;; replace the text banner.
(when-let (img (plist-get banner :image))
(let ((size-props
(when-let* ((img (plist-get banner :image)))
(let ((img-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)))))
(list :max-height dashboard-image-banner-max-height))
dashboard-image-extra-props)))
(setq image-spec
(cond ((dashboard--type-is-gif-p img)
(cond ((dashboard--image-animated-p img)
(create-image img))
((dashboard--type-is-xbm-p img)
(create-image img))
((image-type-available-p 'imagemagick)
(apply 'create-image img 'imagemagick nil size-props))
(apply 'create-image img 'imagemagick nil img-props))
(t
(apply 'create-image img nil nil
(when (and (fboundp 'image-transforms-p)
(memq 'scale (funcall 'image-transforms-p)))
size-props))))))
img-props))))))
(add-text-properties start (point) `(display ,image-spec))
(when (dashboard--type-is-gif-p img) (image-animate image-spec 0 t)))
(when (ignore-errors (image-multi-frame-p image-spec)) (image-animate image-spec 0 t)))
;; Finally, center the banner (if any).
(when-let* ((text-align-spec `(space . (:align-to (- center ,(/ text-width 2)))))
(image-align-spec `(space . (:align-to (- center (0.5 . ,image-spec)))))
@@ -757,28 +863,27 @@ Argument IMAGE-PATH path to the image."
(t nil)))
(prefix (propertize " " 'display prop)))
(add-text-properties start (point) `(line-prefix ,prefix wrap-prefix ,prefix)))
(insert "\n\n")
(add-text-properties start (point) '(cursor-intangible t inhibit-isearch t))))
(insert "\n")
(add-text-properties start (point) '(cursor-intangible t inhibit-isearch t)))))
(defun dashboard-insert-banner-title ()
"Insert `dashboard-banner-logo-title' if it's non-nil."
(when dashboard-banner-logo-title
(dashboard-insert-center (propertize dashboard-banner-logo-title 'face 'dashboard-banner-logo-title))
(insert "\n\n"))
(dashboard-insert-navigator)
(dashboard-insert-init-info))
(insert "\n")))
;;
;; INIT INFO
;;
;;; Initialize info
(defun dashboard-insert-init-info ()
"Insert init info when `dashboard-set-init-info' is t."
(when dashboard-set-init-info
(let ((init-info (if (functionp dashboard-init-info)
(funcall dashboard-init-info)
dashboard-init-info)))
(dashboard-insert-center (propertize init-info 'face 'font-lock-comment-face)))))
"Insert init info."
(let ((init-info (if (functionp dashboard-init-info)
(funcall dashboard-init-info)
dashboard-init-info)))
(dashboard-insert-center (propertize init-info 'face 'font-lock-comment-face))))
(defun dashboard-insert-navigator ()
"Insert Navigator of the dashboard."
(when (and dashboard-set-navigator dashboard-navigator-buttons)
(when dashboard-navigator-buttons
(dolist (line dashboard-navigator-buttons)
(dolist (btn line)
(let* ((icon (car btn))
@@ -799,7 +904,8 @@ Argument IMAGE-PATH path to the image."
(when (and icon title
(not (string-equal icon ""))
(not (string-equal title "")))
(propertize " " 'face 'variable-pitch))
(propertize " " 'face `(:inherit (variable-pitch
,face))))
(when title (propertize title 'face face)))
:help-echo help
:action action
@@ -810,8 +916,7 @@ Argument IMAGE-PATH path to the image."
:format "%[%t%]")
(insert " ")))
(dashboard-center-text (line-beginning-position) (line-end-position))
(insert "\n"))
(insert "\n")))
(insert "\n"))))
(defmacro dashboard-insert-section (section-name list list-size shortcut-id shortcut-char action &rest widget-params)
"Add a section with SECTION-NAME and LIST of LIST-SIZE items to the dashboard.
@@ -822,7 +927,10 @@ 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 ,shortcut-char dashboard-show-shortcuts) ,shortcut-char))
(when (and ,list
,shortcut-char
dashboard-show-shortcuts)
,shortcut-char))
(if ,list
(when (and (dashboard-insert-section-list
,section-name
@@ -834,8 +942,8 @@ WIDGET-PARAMS are passed to the \"widget-create\" function."
(insert (propertize "\n --- No items ---" 'face 'dashboard-no-items-face)))))
;;
;; Section list
;;
;;; Section list
(defmacro dashboard-insert-section-list (section-name list action &rest rest)
"Insert into SECTION-NAME a LIST of items, expanding ACTION and passing REST
to widget creation."
@@ -843,14 +951,17 @@ to widget creation."
(mapc
(lambda (el)
(let ((tag ,@rest))
(insert "\n ")
(insert "\n")
(insert (spaces-string (or standard-indent tab-width 4)))
(when (and (dashboard-display-icons-p)
dashboard-set-file-icons)
(let* ((path (car (last (split-string ,@rest " - "))))
(icon (if (and (not (file-remote-p path))
(file-directory-p path))
(dashboard-icon-for-dir path nil "")
(dashboard-icon-for-dir path
:height dashboard-icon-file-height
:v-adjust dashboard-icon-file-v-adjust)
(cond
((or (string-equal ,section-name "Agenda for today:")
(string-equal ,section-name "Agenda for the coming week:"))
@@ -858,7 +969,8 @@ to widget creation."
((file-remote-p path)
dashboard-remote-path-icon)
(t (dashboard-icon-for-file (file-name-nondirectory path)
:v-adjust -0.05))))))
:height dashboard-icon-file-height
:v-adjust dashboard-icon-file-v-adjust))))))
(setq tag (concat icon " " ,@rest))))
(widget-create 'item
@@ -871,16 +983,26 @@ to widget creation."
:format "%[%t%]")))
,list)))
;; Footer
;;
;;; Footer
(defun dashboard-random-footer ()
"Return a random footer from `dashboard-footer-messages'."
(nth (random (length dashboard-footer-messages)) dashboard-footer-messages))
(defun dashboard-footer-icon ()
"Return footer icon or a random icon if `dashboard-footer-messages' is a list."
(if (and (not (null dashboard-footer-icon))
(listp dashboard-footer-icon))
(dashboard-replace-displayable
(nth (random (length dashboard-footer-icon))
dashboard-footer-icon))
(dashboard-replace-displayable dashboard-footer-icon)))
(defun dashboard-insert-footer ()
"Insert footer of dashboard."
(when-let ((footer (and dashboard-set-footer (dashboard-random-footer)))
(footer-icon (dashboard-replace-displayable dashboard-footer-icon)))
(insert "\n")
(when-let* ((footer (dashboard-random-footer))
(footer-icon (dashboard-footer-icon)))
(dashboard-insert-center
(if (string-empty-p footer-icon) footer-icon
(concat footer-icon " "))
@@ -888,8 +1010,8 @@ to widget creation."
"\n")))
;;
;; Truncate
;;
;;; Truncate
(defcustom dashboard-shorten-by-window-width nil
"Shorten path by window edges."
:type 'boolean
@@ -908,22 +1030,29 @@ to widget creation."
"Return directory name from PATH."
(file-name-nondirectory (directory-file-name (file-name-directory path))))
(defun dashboard-truncate-string-ellipsis ()
"Return the string used to indicate truncation."
(if (fboundp 'truncate-string-ellipsis)
(truncate-string-ellipsis)
(or truncate-string-ellipsis
"...")))
(defun dashboard-shorten-path-beginning (path)
"Shorten PATH from beginning if exceeding maximum length."
(let* ((len-path (length path))
(slen-path (dashboard-str-len path))
(len-rep (dashboard-str-len dashboard-path-shorten-string))
(len-rep (dashboard-str-len (dashboard-truncate-string-ellipsis)))
(len-total (- dashboard-path-max-length len-rep))
front)
(if (<= slen-path dashboard-path-max-length) path
(setq front (ignore-errors (substring path (- slen-path len-total) len-path)))
(if front (concat dashboard-path-shorten-string front) ""))))
(if front (concat (dashboard-truncate-string-ellipsis) front) ""))))
(defun dashboard-shorten-path-middle (path)
"Shorten PATH from middle if exceeding maximum length."
(let* ((len-path (length path))
(slen-path (dashboard-str-len path))
(len-rep (dashboard-str-len dashboard-path-shorten-string))
(len-rep (dashboard-str-len (dashboard-truncate-string-ellipsis)))
(len-total (- dashboard-path-max-length len-rep))
(center (/ len-total 2))
(end-back center)
@@ -932,20 +1061,20 @@ to widget creation."
(if (<= slen-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) ""))))
(if front (concat back (dashboard-truncate-string-ellipsis) front) ""))))
(defun dashboard-shorten-path-end (path)
"Shorten PATH from end if exceeding maximum length."
(let* ((len-path (length path))
(slen-path (dashboard-str-len path))
(len-rep (dashboard-str-len dashboard-path-shorten-string))
(len-rep (dashboard-str-len (dashboard-truncate-string-ellipsis)))
(diff (- slen-path len-path))
(len-total (- dashboard-path-max-length len-rep diff))
back)
(if (<= slen-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) ""))))
(concat back (dashboard-truncate-string-ellipsis)) ""))))
(defun dashboard--get-base-length (path type)
"Return the length of the base from the PATH by TYPE."
@@ -1038,8 +1167,8 @@ to widget creation."
align-length))
;;
;; Recentf
;;
;;; Recentf
(defcustom dashboard-recentf-show-base nil
"Show the base file name infront of it's path."
:type '(choice
@@ -1089,8 +1218,8 @@ to widget creation."
(t (format dashboard-recentf-item-format filename path))))))
;;
;; Bookmarks
;;
;;; Bookmarks
(defcustom dashboard-bookmarks-show-base t
"Show the base file name infront of it's path."
:type '(choice
@@ -1133,8 +1262,8 @@ to widget creation."
el)))
;;
;; Projects
;;
;;; Projects
(defcustom dashboard-projects-switch-function
nil
"Custom function to switch to projects from dashboard.
@@ -1230,8 +1359,8 @@ over custom backends."
:error)))))
;;
;; Org Agenda
;;
;;; Org Agenda
(defcustom dashboard-week-agenda t
"Show agenda weekly if its not nil."
:type 'boolean
@@ -1289,7 +1418,9 @@ Any custom function would receives the tags from `org-get-tags'"
(defun dashboard-agenda-entry-format ()
"Format agenda entry to show it on dashboard.
Also,it set text properties that latter are used to sort entries and perform different actions."
Also,it set text properties that latter are used to sort entries and perform
different actions."
(let* ((scheduled-time (org-get-scheduled-time (point)))
(deadline-time (org-get-deadline-time (point)))
(entry-timestamp (dashboard-agenda--entry-timestamp (point)))
@@ -1301,7 +1432,7 @@ Also,it set text properties that latter are used to sort entries and perform dif
(org-get-category)
(dashboard-agenda--formatted-tags)))
(todo-state (org-get-todo-state))
(item-priority (org-get-priority (org-get-heading t t t t)))
(item-priority (org-get-priority (org-get-heading t t nil t)))
(todo-index (and todo-state
(length (member todo-state org-todo-keywords-1))))
(entry-data (list 'dashboard-agenda-file (buffer-file-name)
@@ -1314,12 +1445,12 @@ Also,it set text properties that latter are used to sort entries and perform dif
(defun dashboard-agenda--entry-timestamp (point)
"Get the timestamp from an entry at POINT."
(when-let ((timestamp (org-entry-get point "TIMESTAMP")))
(when-let* ((timestamp (org-entry-get point "TIMESTAMP")))
(org-time-string-to-time timestamp)))
(defun dashboard-agenda--formatted-headline ()
"Set agenda faces to `HEADLINE' when face text property is nil."
(let* ((headline (org-get-heading t t t t))
(let* ((headline (org-link-display-format (org-get-heading t t t t)))
(todo (or (org-get-todo-state) ""))
(org-level-face (nth (- (org-outline-level) 1) org-level-faces))
(todo-state (format org-agenda-todo-keyword-format todo)))
@@ -1335,8 +1466,8 @@ If not height is found on FACE or `dashboard-items-face' use `default'."
(defun dashboard-agenda--formatted-time ()
"Get the scheduled or dead time of an entry. If no time is found return nil."
(when-let ((time (or (org-get-scheduled-time (point)) (org-get-deadline-time (point))
(dashboard-agenda--entry-timestamp (point)))))
(when-let* ((time (or (org-get-scheduled-time (point)) (org-get-deadline-time (point))
(dashboard-agenda--entry-timestamp (point)))))
(format-time-string dashboard-agenda-time-string-format time)))
(defun dashboard-agenda--formatted-tags ()
@@ -1362,12 +1493,12 @@ point."
(unless (and (not (org-entry-is-done-p))
(not (org-in-archived-heading-p))
(or (and scheduled-time
(org-time-less-p scheduled-time due-date))
(time-less-p scheduled-time due-date))
(and deadline-time
(org-time-less-p deadline-time due-date))
(time-less-p deadline-time due-date))
(and entry-timestamp
(org-time-less-p now entry-timestamp)
(org-time-less-p entry-timestamp due-date))))
(time-less-p now entry-timestamp)
(time-less-p entry-timestamp due-date))))
(point))))
(defun dashboard-filter-agenda-by-todo ()
@@ -1385,7 +1516,7 @@ if returns a point."
(defun dashboard-get-agenda ()
"Get agenda items for today or for a week from now."
(if-let ((prefix-format (assoc 'dashboard-agenda org-agenda-prefix-format)))
(if-let* ((prefix-format (assoc 'dashboard-agenda org-agenda-prefix-format)))
(setcdr prefix-format dashboard-agenda-prefix-format)
(push (cons 'dashboard-agenda dashboard-agenda-prefix-format) org-agenda-prefix-format))
(org-compile-prefix-format 'dashboard-agenda)
@@ -1440,8 +1571,8 @@ found for the strategy it uses nil predicate."
(cl-case strategy
(`priority-up '>)
(`priority-down '<)
(`time-up 'org-time-less-p)
(`time-down (lambda (a b) (org-time-less-p b a)))
(`time-up 'time-less-p)
(`time-down (lambda (a b) (time-less-p b a)))
(`todo-state-up '>)
(`todo-state-down '<)))
@@ -1466,6 +1597,19 @@ to compare."
((null arg2) t)
(t (apply predicate (list arg1 arg2))))))
(defun dashboard-agenda--visit-file (file point)
"Action on agenda-entry that visit a FILE at POINT."
(let ((buffer (find-file-noselect file)))
(with-current-buffer buffer
(goto-char point)
(switch-to-buffer buffer)
(recenter-top-bottom))))
(defun dashboard-agenda--visit-file-other-window (file point)
"Visit FILE at POINT of an agenda item in other window."
(let ((buffer (find-file-other-window file)))
(with-current-buffer buffer (goto-char point) (recenter-top-bottom))))
(defun dashboard-insert-agenda (list-size)
"Add the list of LIST-SIZE items of agenda."
(require 'org-agenda)
@@ -1478,15 +1622,14 @@ to compare."
'agenda
(dashboard-get-shortcut 'agenda)
`(lambda (&rest _)
(let ((buffer (find-file-other-window (get-text-property 0 'dashboard-agenda-file ,el))))
(with-current-buffer buffer
(goto-char (get-text-property 0 'dashboard-agenda-loc ,el))
(switch-to-buffer buffer))))
(let ((file (get-text-property 0 'dashboard-agenda-file ,el))
(point (get-text-property 0 'dashboard-agenda-loc ,el)))
(funcall dashboard-agenda-action file point)))
(format "%s" el)))
;;
;; Registers
;;
;;; Registers
(defun dashboard-insert-registers (list-size)
"Add the list of LIST-SIZE items of registers."
(require 'register)