forked from emacs-dashboard/emacs-dashboard
-
Notifications
You must be signed in to change notification settings - Fork 0
/
dashboard-widgets.el
1631 lines (1447 loc) · 64 KB
/
dashboard-widgets.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; dashboard-widgets.el --- A startup screen extracted from Spacemacs -*- lexical-binding: t -*-
;; Copyright (c) 2016-2025 emacs-dashboard maintainers
;; This file is not part of GNU Emacs.
;;
;;; License: GPLv3
;;
;;; Commentary:
;; An extensible Emacs dashboard, with sections for
;; bookmarks, projects (projectile or project.el), org-agenda and more.
;;; Code:
(require 'cl-lib)
(require 'image)
(require 'mule-util)
(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")
(declare-function all-the-icons-fileicon "ext:data-fileicons.el")
(declare-function all-the-icons-octicon "ext:data-octicons.el")
(declare-function nerd-icons-icon-for-dir "ext:nerd-icons.el")
(declare-function nerd-icons-icon-for-file "ext:nerd-icons.el")
(declare-function nerd-icons-sucicon "ext:nerd-icons.el")
(declare-function nerd-icons-octicon "ext:nerd-icons.el")
(declare-function nerd-icons-codicon "ext:nerd-icons.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")
(declare-function projectile-cleanup-known-projects "ext:projectile.el")
(declare-function projectile-load-known-projects "ext:projectile.el")
(declare-function projectile-mode "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 project-forget-zombie-projects "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-get "ext:org.el")
(declare-function org-entry-is-done-p "ext:org.el")
(declare-function org-entry-is-todo-p "ext:org.el")
(declare-function org-get-category "ext:org.el")
(declare-function org-get-deadline-time "ext:org.el")
(declare-function org-get-heading "ext:org.el")
(declare-function org-get-priority "ext:org.el")
(declare-function org-get-scheduled-time "ext:org.el")
(declare-function org-get-tags "ext:org.el")
(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")
(defvar org-level-faces)
(defvar org-agenda-new-buffers)
(defvar org-agenda-prefix-format)
(defvar org-agenda-todo-keyword-format)
(defvar org-todo-keywords-1)
(defvar all-the-icons-dir-icon-alist)
(defvar package-activated-list)
(defvar elpaca-after-init-time)
(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
(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 '(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
"Maximum height of banner image.
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 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)
(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
:group 'dashboard)
(defcustom dashboard-set-file-icons nil
"When non nil, file lists will have icons."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-set-navigator nil
"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!"
"Who the hell uses VIM anyway? Go Evil!"
"Free as free speech, free as free Beer"
"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")
"A list of messages, one of which dashboard chooses to display."
:type '(list string)
:group 'dashboard)
(defcustom dashboard-icon-type (and (or dashboard-set-heading-icons
dashboard-set-file-icons)
(or (require 'nerd-icons nil t)
(require 'all-the-icons nil t)))
"Icon type used for dashboard.
The value can be one of: `all-the-icons', `nerd-icons'."
:type 'symbol
:group 'dashboard
:set
(lambda (k v)
(pcase v
('all-the-icons
(unless (require 'all-the-icons nil t)
(setq v nil)))
('nerd-icons
(unless (require 'nerd-icons nil t)
(setq v nil))))
(set k v)))
(defcustom dashboard-heading-icons
(pcase dashboard-icon-type
('all-the-icons '((recents . "history")
(bookmarks . "bookmark")
(agenda . "calendar")
(projects . "rocket")
(registers . "database")))
('nerd-icons '((recents . "nf-oct-history")
(bookmarks . "nf-oct-bookmark")
(agenda . "nf-oct-calendar")
(projects . "nf-oct-rocket")
(registers . "nf-oct-database"))))
"Association list for the icons of the heading sections.
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 '(alist :key-type symbol :value-type string)
:group 'dashboard)
(defcustom dashboard-heading-icon-height 1.2
"The height of the heading icon."
:type 'float
:group 'dashboard)
(defcustom dashboard-heading-icon-v-adjust 0.0
"The v-adjust of the heading icon."
: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))
('nerd-icons (nerd-icons-octicon "nf-oct-dot_fill" :height 1.0 :v-adjust 0.01)))
"Agenda item icon."
: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))
('nerd-icons (nerd-icons-codicon "nf-cod-radio_tower" :height 1.0 :v-adjust 0.01)))
"Remote path icon."
:type 'string
:group 'dashboard)
(defcustom dashboard-show-shortcuts t
"Whether to show shortcut keys for each section."
:type 'boolean
:group 'dashboard)
(defconst dashboard-banners-directory
(concat (file-name-directory (locate-library "dashboard")) "banners/")
"Default banner directory.")
(defconst dashboard-banner-official-png
(concat dashboard-banners-directory "emacs.png")
"Emacs banner image.")
(defconst dashboard-banner-logo-png
(concat dashboard-banners-directory "logo.png")
"Emacs banner image.")
(defcustom dashboard-banner-logo-title "Welcome to Emacs!"
"Specify the startup banner."
:type 'string
:group 'dashboard)
(defcustom dashboard-banner-ascii "EMACS"
"String to be shown in place of the startup banner
if `dashboard-startup-banner' is set to `ascii'."
:type 'string
:group 'dashboard)
(defcustom dashboard-navigator-buttons nil
"Specify the navigator buttons.
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
(choice face
(repeat :tag "Anonymous face" sexp))
(choice string
(const nil))
(choice string
(const nil)))))
:group 'dashboard)
(defcustom dashboard-init-info
(lambda ()
(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-count straight--profile-cache) package-count)))
(when (fboundp 'elpaca--queued)
(setq time (format "%f seconds" (float-time (time-subtract elpaca-after-init-time
before-init-time))))
(setq package-count (length (elpaca--queued))))
(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 '(function string)
:group 'dashboard)
(defcustom dashboard-display-icons-p #'display-graphic-p
"Predicate to determine whether dashboard should show icons.
Can be nil to not show icons and any truthy value to show them. When set to a
function the result of the function will be interpreted as the predicate value."
:type '(choice (function :tag "Predicate function")
(boolean :tag "Predicate value"))
:group 'dashboard)
(defun dashboard-replace-displayable (str &optional rep)
"Replace non-displayable character from STR.
Optional argument REP is the replacement string of non-displayable character."
(if (stringp str)
(let ((rep (or rep ""))
(results (list)))
(dolist (string (split-string str ""))
(let* ((char (string-to-char string))
(string (if (char-displayable-p char)
string
rep)))
(push string results)))
(string-join (reverse results)))
""))
(defun dashboard-display-icons-p ()
"Assert whether to show icons based on the `dashboard-display-icons-p' variable."
(if (functionp dashboard-display-icons-p)
(funcall dashboard-display-icons-p)
dashboard-display-icons-p))
(defun dashboard-icon-for-dir (dir &rest args)
"Get the formatted icon for DIR.
ARGS should be a plist containing `:height', `:v-adjust',
or `:face' properties."
(dashboard-replace-displayable
(pcase dashboard-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-dir dir args))
('nerd-icons (apply #'nerd-icons-icon-for-dir dir args)))))
(defun dashboard-icon-for-file (file &rest args)
"Get the formatted icon for FILE.
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
(dashboard-replace-displayable
(pcase dashboard-icon-type
('all-the-icons (apply #'all-the-icons-icon-for-file file args))
('nerd-icons (apply #'nerd-icons-icon-for-file file args)))))
(defun dashboard-octicon (name &rest args)
"Get the formatted octicon by NAME.
ARGS should be a plist containing `:height', `:v-adjust', or `:face' properties."
(dashboard-replace-displayable
(pcase dashboard-icon-type
('all-the-icons (apply #'all-the-icons-octicon name args))
('nerd-icons (apply #'nerd-icons-octicon name args)))))
(defcustom dashboard-footer-icon
(if (dashboard-display-icons-p)
(pcase dashboard-icon-type
('all-the-icons
(all-the-icons-fileicon "emacs"
:height 1.1
:v-adjust -0.05
:face 'dashboard-footer-icon-face))
('nerd-icons
(nerd-icons-sucicon "nf-custom-emacs"
:height 1.1
:v-adjust -0.05
:face 'dashboard-footer-icon-face)))
(propertize ">" 'face 'dashboard-footer-icon-face))
"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 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 "path to an image or text banner")
(cons :tag "image and text banner"
(string :tag "image 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
'((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',
`agenda' ,`registers'."
:type '(alist :key-type symbol :value-type function)
:group 'dashboard)
(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',
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-remove-missing-entry nil
"If non-nil, try to remove missing entries."
:type 'boolean
:group 'dashboard)
(defcustom dashboard-items
'((recents . 5)
(bookmarks . 5)
(agenda . 5))
"Association list of items to show in the startup buffer.
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 (choice
symbol
(cons symbol 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 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
"Association list of item heading names.
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:")
:group 'dashboard)
(defcustom dashboard-items-default-length 20
"Length used for startup lists with otherwise unspecified bounds.
Set to nil for unbounded."
:type 'integer
: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)
;;
;;; Faces
(defface dashboard-text-banner
'((t (:inherit font-lock-keyword-face)))
"Face used for text banners."
:group 'dashboard)
(defface dashboard-banner-logo-title
'((t :inherit default))
"Face used for the banner title."
:group 'dashboard)
(defface dashboard-navigator
'((t (:inherit font-lock-keyword-face)))
"Face used for the navigator."
:group 'dashboard)
(defface dashboard-heading
'((t (:inherit font-lock-keyword-face)))
"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-face
'((t (:inherit font-lock-doc-face)))
"Face used for footer text."
:group 'dashboard)
(defface dashboard-footer-icon-face
'((t (:inherit dashboard-footer-face)))
"Face used for icon in footer."
:group 'dashboard)
(define-obsolete-face-alias
'dashboard-text-banner-face 'dashboard-text-banner "1.2.6")
(define-obsolete-face-alias
'dashboard-banner-logo-title-face 'dashboard-banner-logo-title "1.2.6")
(define-obsolete-face-alias
'dashboard-heading-face 'dashboard-heading "1.2.6")
;;
;;; Util
(defmacro dashboard-mute-apply (&rest body)
"Execute BODY without message."
(declare (indent 0) (debug t))
`(let (message-log-max)
(with-temp-message (or (current-message) nil)
(let ((inhibit-message t)) ,@body))))
(defun dashboard-funcall-fboundp (fnc &rest args)
"Call FNC with ARGS if exists."
(when (fboundp fnc) (if args (funcall fnc args) (funcall fnc))))
;; TODO: Use function `string-pixel-width' after 29.1
(defun dashboard-string-pixel-width (str)
"Return the width of STR in pixels."
(if (fboundp #'string-pixel-width)
(string-pixel-width str)
(require 'shr)
(shr-string-pixel-width str)))
(defun dashboard-str-len (str)
"Calculate STR in pixel width."
(let ((width (frame-char-width))
(len (dashboard-string-pixel-width str)))
(+ (/ len width)
(if (zerop (% len width)) 0 1)))) ; add one if exceeed
;;
;;; 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)))))
(defun dashboard-get-shortcut-name (item)
"Get the shortcut name to be used for ITEM."
(let ((elem (rassoc item dashboard-item-shortcuts)))
(and elem (car elem))))
(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-id
shortcut-char
search-label
&optional no-next-line)
"Insert a shortcut SHORTCUT-CHAR for a given SEARCH-LABEL.
SHORTCUT-ID is the section identifier.
Optionally, provide NO-NEXT-LINE to move the cursor forward a line."
(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))))
;; remove symbol quote
(sym (intern (replace-regexp-in-string "'" "" (format "dashboard-jump-to-%s" shortcut-id)))))
`(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)))))
(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-buffer-name)
(goto-char (point-max))
(let ((inhibit-read-only t)) (insert msg))))
(defun dashboard-modify-heading-icons (alist)
"Append ALIST items to `dashboard-heading-icons' to modify icons."
(dolist (icon alist)
(add-to-list 'dashboard-heading-icons icon)))
(defun dashboard-insert-page-break ()
"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)
(let ((args `( :height ,dashboard-heading-icon-height
:v-adjust ,dashboard-heading-icon-v-adjust
:face dashboard-heading)))
(insert
(pcase heading
("Recent Files:"
(apply #'dashboard-octicon (cdr (assoc 'recents dashboard-heading-icons)) args))
("Bookmarks:"
(apply #'dashboard-octicon (cdr (assoc 'bookmarks dashboard-heading-icons)) args))
((or "Agenda for today:"
"Agenda for the coming week:")
(apply #'dashboard-octicon (cdr (assoc 'agenda dashboard-heading-icons)) args))
("Registers:"
(apply #'dashboard-octicon (cdr (assoc 'registers dashboard-heading-icons)) args))
("Projects:"
(apply #'dashboard-octicon (cdr (assoc 'projects dashboard-heading-icons)) args))
("List Directories:"
(apply #'dashboard-octicon (cdr (assoc 'ls-directories dashboard-heading-icons)) args))
("List Files:"
(apply #'dashboard-octicon (cdr (assoc 'ls-files dashboard-heading-icons)) args))
(_
(if (null icon) " " icon))))
(insert " ")))
(insert (propertize heading 'face 'dashboard-heading))
;; Turn the inserted heading into an overlay, so that we may freely change
;; its name without breaking any of the functions that expect the default name.
;; If there isn't a suitable entry in `dashboard-item-names',
;; we fallback to using HEADING. In that case we still want it to be an
;; overlay to maintain consistent behavior (such as the point movement)
;; between modified and default headings.
(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 dashboard-heading-shorcut-format shortcut))))
(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))
(while (< (point) end)
(let* ((line-str (buffer-substring (line-beginning-position) (line-end-position)))
(line-length (dashboard-str-len line-str)))
(setq width (max width line-length)))
(forward-line 1))
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."
(let ((start (point)))
(apply #'insert strings)
(dashboard-center-text start (point))))
;;
;;; Banner
(defun dashboard-get-banner-path (index)
"Return the full path to banner with index INDEX."
(concat dashboard-banners-directory (format "%d.txt" index)))
(defun dashboard--image-supported-p (img)
"Return non-nil if IMG exists and is a supported image type."
;; In Emacs 29.1 we could use `image-supported-file-p'. However:
;; - We need to support Emacs 26.
;; - 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 (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))
(list :text (dashboard-get-banner-path 1))))
('logo
(append (when (image-type-available-p 'png)
(list :image dashboard-banner-logo-png))
(list :text (dashboard-get-banner-path 1))))
('ascii
(append (list :text dashboard-banner-ascii)))
((pred integerp)
(list :text (dashboard-get-banner-path banner)))
((pred stringp)
(pcase banner
((pred (lambda (f) (not (file-exists-p f))))
(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 banner)
banner
(message "could not find banner %s, use default instead" banner)
(dashboard-get-banner-path 1))))
((pred dashboard--image-supported-p)
(list :image banner
:text (dashboard-get-banner-path 1)))
(_
(message "unsupported file type %s" (file-name-nondirectory banner))
(list :text (dashboard-get-banner-path 1)))))
((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)
dashboard-banner-official-png)
:text (if (and (file-exists-p txt) (string-suffix-p ".txt" txt))
txt
(message "could not find banner %s, use default instead" txt)
(dashboard-get-banner-path 1))))
((and
(pred proper-list-p)
(pred (lambda (l) (not (null l)))))
(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."
(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 dashboard-startup-banner)))
(insert "\n")
(let ((start (point))
buffer-read-only
text-width
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 (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))))
(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 ((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))
dashboard-image-extra-props)))
(setq image-spec
(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 img-props))
(t
(apply 'create-image img nil nil
(when (and (fboundp 'image-transforms-p)
(memq 'scale (funcall 'image-transforms-p)))
img-props))))))
(add-text-properties start (point) `(display ,image-spec))
(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)))))
(prop
(cond
;; Both an image & text banner.
((and image-spec text-width)
;; The quoting is intentional. This is a conditional display spec that will
;; align the banner at redisplay time.
`((when (display-graphic-p) . ,image-align-spec)
(when (not (display-graphic-p)) . ,text-align-spec)))
;; One or the other.
(text-width text-align-spec)
(image-spec image-align-spec)
;; No banner.
(t nil)))
(prefix (propertize " " 'display prop)))
(add-text-properties start (point) `(line-prefix ,prefix wrap-prefix ,prefix)))
(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")))
;;
;;; Initialize info
(defun dashboard-insert-init-info ()
"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 dashboard-navigator-buttons
(dolist (line dashboard-navigator-buttons)
(dolist (btn line)
(let* ((icon (car btn))
(title (cadr btn))
(help (or (cadr (cdr btn)) ""))
(action (or (cadr (cddr btn)) #'ignore))
(face (or (cadr (cddr (cdr btn))) 'dashboard-navigator))
(prefix (or (cadr (cddr (cddr btn))) (propertize "[" 'face face)))
(suffix (or (cadr (cddr (cddr (cdr btn)))) (propertize "]" 'face face))))
(widget-create 'item
:tag (concat
(when icon
(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 "")))
(propertize " " 'face `(:inherit (variable-pitch
,face))))
(when title (propertize title 'face face)))
:help-echo help
:action action
:button-face 'dashboard-items-face
:mouse-face 'highlight
:button-prefix prefix
:button-suffix suffix
:format "%[%t%]")
(insert " ")))
(dashboard-center-text (line-beginning-position) (line-end-position))
(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.
SHORTCUT-ID is the section identifier.
SHORTCUT-CHAR is the keyboard shortcut used to access the section.
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
(when (and ,list
,shortcut-char
dashboard-show-shortcuts)
,shortcut-char))
(if ,list
(when (and (dashboard-insert-section-list
,section-name
(dashboard-subseq ,list ,list-size)
,action
,@widget-params)
,shortcut-id ,shortcut-char)
(dashboard-insert-shortcut ,shortcut-id ,shortcut-char ,section-name))
(insert (propertize "\n --- No items ---" 'face 'dashboard-no-items-face)))))
;;
;;; 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."
`(when (car ,list)
(mapc
(lambda (el)
(let ((tag ,@rest))
(insert "\n ")
(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 "")
(cond
((or (string-equal ,section-name "Agenda for today:")
(string-equal ,section-name "Agenda for the coming week:"))
dashboard-agenda-item-icon)
((file-remote-p path)
dashboard-remote-path-icon)
(t (dashboard-icon-for-file (file-name-nondirectory path)
:v-adjust -0.05))))))
(setq tag (concat icon " " ,@rest))))
(widget-create 'item
:tag tag
:action ,action
:button-face 'dashboard-items-face
:mouse-face 'highlight
:button-prefix ""
:button-suffix ""
:format "%[%t%]")))
,list)))
;;
;;; 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 (dashboard-random-footer))
(footer-icon (dashboard-footer-icon)))
(dashboard-insert-center
(if (string-empty-p footer-icon) footer-icon
(concat footer-icon " "))
(propertize footer 'face 'dashboard-footer-face)
"\n")))
;;
;;; Truncate
(defcustom dashboard-shorten-by-window-width nil