-
Notifications
You must be signed in to change notification settings - Fork 10
/
syslog-mode.el
2417 lines (2281 loc) · 101 KB
/
syslog-mode.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
;;; syslog-mode.el --- Major-mode for viewing log files & strace output
;; Filename: syslog-mode.el
;; Description: Major-mode for viewing log files & strace output
;; Author: Harley Gorrell <[email protected]>
;; Maintainer: Joe Bloggs <[email protected]>
;; Created: 2003-03-17 18:50:12 Harley Gorrell
;; URL: https://github.com/vapniks/syslog-mode
;; Keywords: unix
;; Compatibility: GNU Emacs 24.3.1
;; Package-Requires: ((hide-lines "20130623") (ov "20150311") (hsluv "20181127"))
;;
;; Features that might be required by this library:
;;
;; hide-lines cl ido dired+ ov thingatpt hi-lock net-utils hsluv
;;
;;; This file is NOT part of GNU Emacs
;;; License
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program; see the file COPYING.
;; If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Commentary:
;; * Handy functions for looking at system logs, and strace output.
;; * Fontifys the date and su messages.
;;; Keybindings
;; "C-down" : syslog-boot-start
;; "R" : revert-buffer
;; "/" : syslog-filter-lines
;; "C-/" : syslog-filter-dates
;; "g" : hide-lines-show-all
;; "k" : hide-lines-kill-hidden
;; "h r" : highlight-regexp
;; "h p" : highlight-phrase
;; "h l" : highlight-lines-matching-regexp
;; "h u" : unhighlight-regexp
;; "h U" : unhiglight all regexps
;; "h q" : highlight-regexp-unique
;; "C-/" : syslog-filter-dates
;; "D" : open dired buffer in log directory (`syslog-log-file-directory')
;; "c" : syslog-count-matches
;; "x" : syslog-extract-matches
;; "j"/"f" : ffap
;; "!" : syslog-shell-command
;; "?" : syslog-show-notes
;; "v" : syslog-view
;; "W" : syslog-whois-reverse-lookup
;; "m" : manual-entry
;; "o" : syslog-open-files
;; "a" : syslog-append-files
;; "p" : syslog-prepend-files
;; "t" : syslog-toggle-filenames
;; "<" : syslog-previous-file
;; ">" : syslog-next-file
;; "<M-up>" : syslog-move-previous-file
;; "<M-down>": syslog-move-next-file
;; "q" : quit-window
;; To update lists of commands & options show below: M-x auto-document
;;; Commands:
;;
;; Below is a complete list of commands:
;;
;; `syslog-shell-command'
;; Execute a shell COMMAND synchronously, with prefix arg (SUDOP) run under sudo.
;; Keybinding: !
;; `syslog-append-files'
;; Append FILES into buffer BUF.
;; Keybinding: a
;; `syslog-prepend-files'
;; Prepend FILES into buffer BUF.
;; Keybinding: M-x syslog-prepend-files
;; `syslog-open-files'
;; Insert log FILES into new buffer, and switch to that buffer.
;; Keybinding: o
;; `syslog-view'
;; Open a view of syslog files with optional filters and highlights applied.
;; Keybinding: v
;; `syslog-previous-file'
;; Open the previous logfile backup, or the next one if a prefix arg is used.
;; Keybinding: <
;; `syslog-next-file'
;; Open the next logfile.
;; Keybinding: >
;; `syslog-move-next-file'
;; Move to the next file in the current `syslog-mode' buffer.
;; Keybinding: <M-down>
;; `syslog-move-previous-file'
;; Move to the next file in the current `syslog-mode' buffer.
;; Keybinding: <M-up>
;; `syslog-toggle-filenames'
;; Toggle the display of filenames before each line.
;; Keybinding: t
;; `syslog-filter-lines'
;; Restrict buffer to blocks of text between matching regexps.
;; Keybinding: /
;; `highlight-regexp-unique'
;; Highlight each unique string matched by REGEXP with a different face.
;; Keybinding: q
;; `syslog-filter-dates'
;; Restrict buffer to lines between times START and END (Emacs time lists).
;; Keybinding: C-/
;; `syslog-mode'
;; Major mode for working with system logs, and strace output.
;; Keybinding: M-x syslog-mode
;; `syslog-count-matches'
;; Count all matches to regexp RX in current buffer.
;; Keybinding: c
;; `syslog-extract-matches'
;; Extract & concatenate strings matching regexp RX (or its match groups).
;; Keybinding: x
;; `syslog-boot-start'
;; Jump forward in the log to when the system booted.
;; Keybinding: <C-down>
;; `syslog-whois-reverse-lookup'
;; This is a wrapper around the `whois' command using symbol at point as default search string.
;; Keybinding: W
;; `syslog-transform-strace'
;; Transform strace output in the current buffer.
;; Keybinding: M-x syslog-transform-strace
;; `syslog-extract-fds-from-strace'
;; Extract strace output lines involving a particular file descriptor(s).
;; Keybinding: X
;; `forward-syslog-token'
;; Move point forward over ARG tokens (backwards if ARG is negative).
;; Keybinding: M-x forward-syslog-token
;; `syslog-show-notes'
;; In the minibuffer display notes associated with the region or WORD at point.
;; Keybinding: ?
;; `syslog-notes-next-match'
;; Search other window for the next match to the word/regexp used by the last call to `syslog-show-notes'.
;; Keybinding: M-n
;; `syslog-notes-prev-match'
;; Search other window for the previous match to the word/regexp used by the last call to `syslog-show-notes'.
;; Keybinding: M-p
;; `syslog-load-notes'
;; Load appropriate notes file for the current buffer.
;; Keybinding: M-x syslog-load-notes
;; `syslog-edit-notes'
;; Edit syslog notes file associated with current buffer.
;; Keybinding: M-x syslog-edit-notes
;;
;;; Customizable Options:
;;
;; Below is a list of customizable options:
;;
;; `syslog-mode-hook'
;; *Hook to setup `syslog-mode'.
;; default = nil
;; `syslog-views'
;; A list of views.
;; default = nil
;; `syslog-datetime-regexp'
;; A regular expression matching the date-time at the beginning of each line in the log file.
;; default = "^\\(?:[^ :]+: \\)?\\(\\(?:\\(?:[[:alpha:]]\\{3\\}\\)?[[:space:]]*[[:alpha:]]\\{3\\}\\s-+[0-9]+\\s-+[0-9:]+\\)\\|\\(?:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\s-+[0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\)\\)"
;; `syslog-log-file-directory'
;; The directory in which log files are stored.
;; default = "/var/log/"
;; `syslog-large-file-size'
;; When `syslog-show-note-from-file-or-buffer' tries to load a file larger than this it prompts the user.
;; default = 500000
;; `syslog-hi-face-defaults'
;; Alist of face sets to use for automatic highlighting.
;; default = (list (quote (bg lambda nil ...)) (quote (fg lambda nil ...)) (quote (light_bg lambda nil ...)) (quote (dark_bg lambda nil ...)) ...)
;; `syslog-notes-files'
;; An alist used by `syslog-load-notes' for choosing a notes file to load.
;; default = (let ((dir ...)) (list (cons ".*\\.strace" ...) (cons "^strace:" ...) (cons "syslog.*" ...)))
;; `syslog-notes-default'
;; List of `syslog-notes' items that are always available.
;; default = nil
;; `syslog-manpage-wait'
;; Amount of time to wait for manpage to finish rendering, when processing manpages.
;; default = 0.2
;; `syslog-note-things'
;; An alist of (REGEX . SYMB) pairs for choosing `syslog-note-thing'.
;; default = nil
;; All of the above can customized by:
;; M-x customize-group RET syslog-mode RET
;;
;;; Installation:
;;
;; Put syslog-mode.el in a directory in your load-path, e.g. ~/.emacs.d/
;; You can add a directory to your load-path with the following line in ~/.emacs
;; (add-to-list 'load-path (expand-file-name "~/elisp"))
;; where ~/elisp is the directory you want to add
;; (you don't need to do this for ~/.emacs.d - it's added by default).
;;
;; Add the following to your ~/.emacs startup file.
;;
;; (require 'syslog-mode)
;;; Change log:
;;
;; This is out of date, please refer to the git commits on github:
;; https://github.com/vapniks/syslog-mode
;; 12-07-2021 Joe Bloggs
;; Many changes: added transform functions to syslog-views option,
;; highlight-regexp-unique, syslog-extract-matches
;; and extra functions and font-locking for strace output files.
;;
;; 21-03-2013 Joe Bloggs
;; Added functions and keybindings for filtering
;; lines by regexps or dates, and for highlighting,
;; and quick key for find-file-at-point
;;
;; 20-03-2013 Christian Giménez
;; Added more keywords for font-lock.
;;
;; 16-03-2003 : Updated URL and contact info.
;;; Acknowledgements:
;;
;; Harley Gorrell (Author)
;; Christian Giménez
;;
;; If anyone wants to make changes please fork the following github repo: https://github.com/vapniks/syslog-mode
;;; TODO: statistical reporting - have a regular expression to match item type, then report counts of each item type.
;; also statistics on number of items per hour/day/week/etc.
;;; Require
(require 'hide-lines)
(eval-when-compile (require 'cl))
(require 'ido)
(require 'hi-lock)
(require 'net-utils)
(require 'ov)
(require 'thingatpt)
(require 'man nil t)
(require 'hsluv)
;;; Code:
;; Setup
;; simple-call-tree-info: DONE
(defgroup syslog nil
"syslog-mode - a major mode for viewing log files"
:link '(url-link "https://github.com/vapniks/syslog-mode"))
;; simple-call-tree-info: DONE
(defcustom syslog-mode-hook nil
"*Hook to setup `syslog-mode'."
:group 'syslog
:type 'hook)
;; simple-call-tree-info: DONE
(defvar syslog-mode-load-hook nil
"*Hook to run when `syslog-mode' is loaded.")
;;;###autoload
;; simple-call-tree-info: DONE
(defvar syslog-setup-on-load nil
"*If not nil setup syslog mode on load by running syslog-add-hooks.")
;; I also use "Alt" as C-c is too much to type for cursor motions.
;; simple-call-tree-info: DONE
(defvar syslog-mode-map
(let ((map (make-sparse-keymap)))
;; Ctrl bindings
(define-key map [C-down] 'syslog-boot-start)
(define-key map "R" 'revert-buffer)
(define-key map "/" 'syslog-filter-lines)
(define-key map "g" 'hide-lines-show-all)
(define-prefix-command 'syslog-highlight-map)
(define-key map "h" 'syslog-highlight-map)
(define-key map (kbd "h r") 'highlight-regexp)
(define-key map (kbd "h p") 'highlight-phrase)
(define-key map (kbd "h l") 'highlight-lines-matching-regexp)
(define-key map (kbd "h u") 'unhighlight-regexp)
(define-key map (kbd "h U") (lambda nil (interactive) (unhighlight-regexp t)))
(define-key map (kbd "h q") 'highlight-regexp-unique)
(define-key map (kbd "C-/") 'syslog-filter-dates)
(define-key map "D" (lambda nil (interactive) (dired syslog-log-file-directory)))
(define-key map "j" 'ffap)
(define-key map "f" 'ffap)
(define-key map "<" 'syslog-previous-file)
(define-key map ">" 'syslog-next-file)
(define-key map "o" 'syslog-open-files)
(define-key map "a" 'syslog-append-files)
(define-key map "p" 'syslog-prepend-files)
(define-key map "v" 'syslog-view)
(define-key map "c" 'syslog-count-matches)
(define-key map "x" 'syslog-extract-matches)
(define-key map "X" 'syslog-extract-fds-from-strace)
(define-key map "k" 'hide-lines-kill-hidden)
(define-key map "W" 'syslog-whois-reverse-lookup)
(define-key map "m" 'manual-entry)
(define-key map "q" 'quit-window)
(define-key map "!" 'syslog-shell-command)
(define-key map "?" 'syslog-show-notes)
(define-key map (kbd "M-n") 'syslog-notes-next-match)
(define-key map (kbd "M-p") 'syslog-notes-prev-match)
(define-key map (kbd "<M-down>") 'syslog-move-next-file)
(define-key map (kbd "<M-up>") 'syslog-move-previous-file)
(define-key map "t" 'syslog-toggle-filenames)
;; XEmacs does not like the Alt bindings
(if (string-match "XEmacs" (emacs-version)) t)
map)
"The local keymap for `syslog-mode'.")
;; simple-call-tree-info: DONE
(defvar syslog-number-suffix-start 1
"The first number used as rotation suffix.")
;; simple-call-tree-info: DONE
(defun syslog-shell-command (command &optional sudop tostrings)
"Execute a shell COMMAND synchronously, with prefix arg (SUDOP) run under sudo.
If TOSTRINGS is non-nil then output will be returned as a list of strings (one per line),
otherwise it will be place in the *Shell Command Output* buffer."
(interactive (list (read-shell-command (if current-prefix-arg
"Shell command (root): "
"Shell command: "))
current-prefix-arg))
(with-temp-buffer
(when sudop
(cd (concat "/sudo::"
(replace-regexp-in-string
"^/sudo[^/]+" "" default-directory))))
(if tostrings
(split-string (shell-command-to-string command) "\n" t)
(shell-command command))))
;; simple-call-tree-info: DONE
(defun syslog-get-basename-and-number (filename)
"Return the basename and number suffix of a log file in FILEPATH.
Return results in a cons cell '(basename . number) where basename is a string,
and number is a number."
(let* ((res (string-match "\\(.*?\\)\\.\\([0-9]+\\)\\(\\.t?gz\\)?" filename))
(basename (if res (match-string 1 filename) filename))
(str (and res (match-string 2 filename)))
(num (or (and str (string-to-number str)) (1- syslog-number-suffix-start))))
(cons basename num)))
;; simple-call-tree-info: DONE
(defun syslog-get-filenames (&optional pairs prompt onlyone)
"Get log files associated with PAIRS argument, or prompt user for files.
The PAIRS argument should be a list of cons cells whose cars are paths to log files,
and whose cdrs are numbers indicating how many previous log files (if positive) or days
(if negative) to include. If PAIRS is missing then the user is prompted for those values.
If ONLYONE is non-nil then the user is only prompted for a single file.
The PROMPT argument is an optional prompt to use for prompting the user for files."
(let* ((continue t)
(num 0)
(pairs
(or pairs
(cl-loop
while continue
do (setq
filename
(ido-read-file-name
(or prompt "Log file: ")
syslog-log-file-directory "syslog" nil)
num (if onlyone 0
(read-number
"Number of previous files (if positive) or days (if negative) to include"
num)))
collect (cons filename num)
if onlyone do (setq continue nil)
else do (setq continue (y-or-n-p "Add more files? "))))))
(cl-remove-duplicates
(cl-loop for pair1 in pairs
for filename = (car pair1)
for num = (cdr pair1)
for pair = (syslog-get-basename-and-number filename)
for basename = (car pair)
for basename2 = (file-name-nondirectory basename)
for curver = (cdr pair)
for num2 = (if (>= num 0) num
(- (let* ((startdate (+ (float-time (nth 5 (file-attributes filename)))
(* num 86400))))
(cl-loop for file2 in (directory-files (file-name-directory filename)
t basename2)
for filedate2 = (float-time (nth 5 (file-attributes file2)))
if (>= filedate2 startdate)
maximize (cdr (syslog-get-basename-and-number file2))))
curver))
for files = (cl-loop for n from (1+ curver) to (+ curver num2)
for numstr = (number-to-string n)
for nextfile = (cl-loop for suffix in '(nil ".gz" ".tgz")
for filename3 = (concat basename "." numstr suffix)
if (file-readable-p filename3)
return filename3)
collect nextfile)
nconc (nconc (list filename) (cl-remove-if 'null files))) :test 'equal)))
;; simple-call-tree-info: DONE
(defun syslog-append-files (files buf &optional replace)
"Append FILES into buffer BUF.
If REPLACE is non-nil then the contents of BUF will be overwritten.
When called interactively the current buffer is used, FILES are prompted for
using `syslog-get-filenames', and REPLACE is set to nil, unless
a prefix argument is used in which case they are prompted for."
(interactive (list (syslog-get-filenames nil "Append log file: ")
(current-buffer)
(if current-prefix-arg
(y-or-n-p "Replace current buffer contents? "))))
(with-current-buffer buf
(let ((inhibit-read-only t))
(set-visited-file-name nil)
(save-excursion
(cl-loop for file in (cl-remove-duplicates files :test 'equal)
do (goto-char (point-max))
(let ((start (point)))
(insert-file-contents file)
(goto-char (point-max))
(put-text-property start (point) 'syslog-filename file)))))))
;; simple-call-tree-info: DONE
(defun syslog-prepend-files (files buf &optional replace)
"Prepend FILES into buffer BUF.
If REPLACE is non-nil then the contents of BUF will be overwritten.
When called interactively the current buffer is used, FILES are prompted for
using `syslog-get-filenames', and REPLACE is set to nil, unless
a prefix argument is used in which case they are prompted for."
(interactive (list (syslog-get-filenames nil "Prepend log file: ")
(current-buffer)
(if current-prefix-arg
(y-or-n-p "Replace current buffer contents? "))))
(with-current-buffer buf
(let ((inhibit-read-only t))
(set-visited-file-name nil)
(cl-loop for file in (cl-remove-duplicates files :test 'equal)
do (let ((start (goto-char (point-min))))
(forward-char (cl-second (insert-file-contents file)))
(put-text-property start (point) 'syslog-filename file))))))
;; simple-call-tree-info: DONE
(defun syslog-create-buffer (filenames)
"Create a new buffer named after the files in FILENAMES."
(let* ((uniquefiles (mapcar 'file-name-nondirectory
(cl-remove-duplicates filenames :test 'equal)))
(basenames (mapcar (lambda (x)
(replace-regexp-in-string
"\\(\\.gz\\|\\.tgz\\)$" ""
(file-name-nondirectory x)))
uniquefiles))
(basenames2 (cl-remove-duplicates
(mapcar (lambda (x) (replace-regexp-in-string "\\.[0-9]+$" "" x)) basenames)
:test 'equal)))
(get-buffer-create
(if (> (length filenames) 1)
(substring (cl-loop for file in basenames2
for files = (cl-remove-if-not
(lambda (x) (string-match-p (regexp-quote file) x))
basenames)
for nums = (mapcar (lambda (x)
(let* ((match (string-match "\\.\\([0-9]+\\)" x))
(n (if match (match-string 1 x) "0")))
(string-to-number n)))
files)
for min = (if nums (apply 'min nums) 0)
for max = (if nums (apply 'max nums) 0)
concat (concat file "." (if (= min max) (number-to-string min)
(concat "{" (number-to-string min)
"-" (number-to-string max) "}"))
","))
0 -1)
(car basenames)))))
;; simple-call-tree-info: DONE
(defun syslog-open-files (files &optional label)
"Insert log FILES into new buffer, and switch to that buffer.
If the optional argument LABEL is non-nil then each new line will be labelled
with the corresponding filename.
When called interactively the FILES are prompted for using `syslog-get-filenames'."
(interactive (list (syslog-get-filenames nil "View log file: ")
(y-or-n-p "Label lines with filenames? ")))
(let ((buf (syslog-create-buffer files)))
(with-current-buffer buf
(let ((inhibit-read-only t))
(set-visited-file-name nil)
(cl-loop for file in (cl-remove-duplicates files :test 'equal)
do (let ((start (goto-char (point-max))))
(insert-file-contents file)
(goto-char (point-max))
(unless (not label)
(forward-line 0)
(goto-char
(apply-on-rectangle
'string-rectangle-line start (point)
(concat (file-name-nondirectory file) ": ") nil)))
(put-text-property
start (point) 'syslog-filename file))))
(syslog-mode)
(setq default-directory (file-name-directory (car files))))
(switch-to-buffer buf)))
;;;###autoload
;; simple-call-tree-info: CHECK
(defun syslog-view (files &optional label treatments rxshowstart rxshowend
rxhidestart rxhideend startdate enddate removedates
highlights bufname)
"Open a view of syslog files with optional filters and highlights applied.
When called interactively the user is prompted for a member of `syslog-views' and the
arguments are determined from the chosen member.
FILES can be either nil in which case the view is applied to the current log file, or
it can be the same as the first argument to `syslog-get-filenames' - a list of cons
cells whose cars are filenames and whose cdrs indicate how many logfiles to include.
LABEL indicates whether or not to label each line with the filename it came from.
RXSHOWSTART, RXSHOWEND and RXHIDESTART, RXHIDEEND are optional regexps which will be
used to filter in/out blocks of buffer lines with `syslog-filter-lines'.
STARTDATE and ENDDATE are optional dates used to filter the lines with `syslog-filter-dates';
they can be either date strings or time lists as returned by `syslog-date-to-time'.
HIGHLIGHTS is a list of cons cells whose cars are regexps and whose cdrs are faces to
highlight those regexps with."
(interactive (cdr (cl-assoc (ido-completing-read "View: " (mapcar 'car syslog-views))
syslog-views :test 'string=)))
(cl-flet ((getstr (str) (and (not (string= str "")) str)))
(let ((rxshowstart (getstr rxshowstart))
(rxshowend (getstr rxshowend))
(rxhidestart (getstr rxhidestart))
(rxhideend (getstr rxhideend))
(startdate (getstr startdate))
(enddate (getstr enddate))
(bufname (getstr bufname)))
(when files (syslog-open-files (syslog-get-filenames files) label))
(if (not (eq major-mode 'syslog-mode))
(error "Not in syslog-mode")
(dolist (trt treatments)
(cond ((and (consp trt)
(functionp (car trt)))
(let* ((args1 (cdadr (interactive-form (car trt))))
(args2 (cdr trt))
(args3 (cl-loop
for i from 0 to (1- (max (length args1) (length args2)))
for arg1 = (nth i args1)
for arg2 = (eval (nth i args2))
collect (if (eq arg2 'interactive)
(eval arg1)
arg2))))
(apply (car trt) args3)))
((and (consp trt)
(stringp (car trt)))
(save-excursion
(goto-char (point-min))
(while (re-search-forward (car trt) nil t)
(replace-match (if (functionp (cdr trt))
(funcall (cdr trt) (match-string 1))
(cdr trt))
t nil nil 1))))
(t (error "Invalid treatments arg"))))
(if rxshowstart
(if rxshowend
(hide-blocks-not-matching rxshowstart rxshowend)
(hide-lines-not-matching rxshowstart)))
(if rxhidestart
(if rxhideend
(hide-blocks-not-matching rxhidestart rxhideend)
(hide-lines-matching rxhidestart)))
(if (or startdate enddate)
(syslog-filter-dates startdate enddate removedates))
(if highlights
(cl-loop for hl in highlights
for (regex . face) = hl
do (highlight-regexp regex face)))
(if bufname (rename-buffer bufname t))))))
;; simple-call-tree-info: DONE
(defun syslog-previous-file (&optional arg)
"Open the previous logfile backup, or the next one if a prefix arg is used.
Unix systems keep backups of log files with numbered suffixes, e.g. syslog.1 syslog.2.gz, etc.
where higher numbers indicate older log files.
This function will load the previous log file to the current one (if it exists), or the next
one if ARG is non-nil."
(interactive "P")
(let* ((pair (syslog-get-basename-and-number
(syslog-get-filename-at-point)))
(basename (car pair))
(curver (cdr pair))
(nextver (if arg (1- curver) (1+ curver)))
(nextfile (if (> nextver (1- syslog-number-suffix-start))
(concat basename "." (number-to-string nextver))
basename)))
(let ((inhibit-read-only t))
(cond ((file-readable-p nextfile)
(find-file nextfile))
((file-readable-p (concat nextfile ".bz2"))
(find-file (concat nextfile ".bz2")))
((file-readable-p (concat nextfile ".gz"))
(find-file (concat nextfile ".gz")))
((file-readable-p (concat nextfile ".tgz"))
(find-file (concat nextfile ".tgz"))))
(put-text-property (point-min) (point-max) 'syslog-filename nextfile))))
;; simple-call-tree-info: DONE
(defun syslog-next-file nil
"Open the next logfile.
This just calls `syslog-previous-file' with non-nil argument, so we can bind it to a key."
(interactive)
(syslog-previous-file t))
;; simple-call-tree-info: DONE
(defun syslog-move-next-file (&optional arg)
"Move to the next file in the current `syslog-mode' buffer.
If ARG is non-nil (or called with numeric prefix arg), move that many
files forward."
(interactive "p")
(cl-loop for i from 1 to arg
do (goto-char (next-single-property-change
(point) 'syslog-filename nil (point-max)))))
;; simple-call-tree-info: DONE
(defun syslog-move-previous-file (&optional arg)
"Move to the next file in the current `syslog-mode' buffer.
If ARG is non-nil (or called with numeric prefix arg), move that many
files forward."
(interactive "p")
(cl-loop for i from 1 to arg
do (goto-char (previous-single-property-change
(point) 'syslog-filename nil (point-min)))))
;; simple-call-tree-info: DONE
(defun syslog-get-filename-at-point nil
"Get the filename associated with the line at point."
(or (get-text-property (point) 'syslog-filename)
buffer-file-name))
;; simple-call-tree-info: DONE
(defun syslog-toggle-filenames (&optional arg)
"Toggle the display of filenames before each line.
If prefix ARG is positive display filenames, and if its negative hide them,
otherwise toggle them."
(interactive "P")
(save-excursion
(ov-set (ov-in) 'invisible nil)
(let* ((start (goto-char (point-min)))
(filename (syslog-get-filename-at-point))
(fileshownp (and filename
(looking-at
(concat "^" (regexp-quote (file-name-nondirectory filename))
": "))))
(hidep (if arg (prefix-numeric-value arg) 0)))
(let ((inhibit-read-only t))
(while (and (goto-char
(next-single-property-change
(point) 'syslog-filename nil (point-max)))
(/= start (point)))
(if fileshownp
(if (<= hidep 0)
(apply-on-rectangle
'delete-rectangle-line
start (+ (line-beginning-position 0)
(length (match-string 0)))
nil))
(unless (< hidep 0)
(apply-on-rectangle
'string-rectangle-line start
(line-beginning-position 0)
(concat (file-name-nondirectory filename) ": ")
nil)
(put-text-property start (point) 'syslog-filename filename)))
(setq start (point)
filename (syslog-get-filename-at-point)
fileshownp (and filename
(looking-at
(concat "^" (regexp-quote (file-name-nondirectory filename))
": ")))))))
(ov-set (ov-in) 'invisible 'hl)))
;;;###autoload
;; simple-call-tree-info: DONE
(defun syslog-filter-lines (&optional arg)
"Restrict buffer to blocks of text between matching regexps.
If the user only enters one regexp then just filter matching lines instead of blocks.
With prefix ARG: remove matching blocks."
(interactive "p")
(let* ((str (if (> arg 1) "to remove" "to keep"))
(startregex (read-regexp
(format "Regexp matching start lines of blocks %s" str)
(symbol-name (symbol-at-point))))
(endregex (read-regexp
(format "Regexp matching end lines of blocks %s (default=filter start lines only)" str)))
(n (length (overlays-in (point-min) (point-max)))))
(unless (string= startregex "")
(if (> arg 1)
(if (string= endregex "")
(hide-lines-matching startregex)
(hide-blocks-matching startregex endregex))
(if (string= endregex "")
(hide-lines-not-matching startregex)
(hide-blocks-not-matching startregex endregex)))
(if (= n (length (overlays-in (point-min) (point-max))))
(message "No matches found")))))
;; simple-call-tree-info: DONE
(defun highlight-regexp-unique (regexp &optional faces)
"Highlight each unique string matched by REGEXP with a different face.
Interactively, prompt for REGEXP using `read-regexp', and prompt for a
set of FACES to use for highlighting (see `syslog-hi-face-defaults').
When called non-interactively, FACES can be either a symbol (the car of one of the
face sets defined in `syslog-hi-face-defaults'), or a list of faces.
If REGEXP contains non-shy match groups, then only those parts of the match will
be treated as unique strings & highlighted (rather than the whole regexp).
In this case overlays will always be used (which can be slow if there are many matches).
If there are no non-shy match groups, and variable `font-lock-mode' is enabled then
that will be used for doing the highlighting."
(interactive
(list (read-regexp "Regexp to highlight" 'regexp-history-last)
(intern-soft (completing-read "Highlight type: "
(mapcar 'car syslog-hi-face-defaults)))))
(hi-lock-regexp-okay regexp)
(when (stringp faces) (hi-lock-regexp-okay faces))
(unless hi-lock-mode (hi-lock-mode 1))
(let* ((faces (cond ((functionp faces) (funcall faces))
((symbolp faces)
(let ((f (cdr (assoc faces syslog-hi-face-defaults))))
(if (functionp f) (funcall f) f)))
((listp faces) faces)
(t (error "Invalid FACES arg: %S" faces))))
(unused-faces (set-difference faces
(mapcar (lambda (p) (eval (cadadr p)))
hi-lock-interactive-patterns)))
(matchrx "[^(]*\\\\(\\(.*?\\)\\\\)")
(matches (syslog-unique-matches regexp))
(nfaces (length unused-faces))
(nmatches (length matches)))
(when (< nfaces nmatches)
(warn "Not enough unused faces (%s) to cover all matches (%s).
%s matches will not be coloured."
nfaces nmatches (- nmatches nfaces)))
(cl-flet ((repmatch (i) (let (ss)
(while (> i 0)
(setq ss (cons matchrx ss))
(setq i (1- i)))
(apply 'concat ss))))
(cl-loop for pair in matches
for face in unused-faces
do (let* ((match (car pair))
(i (cadr pair)))
(hi-lock-set-subpattern
(if (> i 0)
(replace-regexp-in-string
(if (> i 1) (repmatch i) matchrx)
(regexp-quote match) regexp t t i)
(regexp-quote match))
face i))))))
;; simple-call-tree-info: DONE (tweaked version of `hi-lock-set-pattern')
(defun hi-lock-set-subpattern (regexp face subx)
"Highlight the SUBX match group of REGEXP with face FACE."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
(let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))))
;; Refuse to highlight a text that is already highlighted.
(unless (assoc regexp hi-lock-interactive-patterns)
(push pattern hi-lock-interactive-patterns)
(if (and font-lock-mode (font-lock-specified-p major-mode)
(= subx 0))
(progn
(font-lock-add-keywords nil (list pattern) t)
(font-lock-flush))
(let* ((range-min (- (point) (/ hi-lock-highlight-range 2)))
(range-max (+ (point) (/ hi-lock-highlight-range 2)))
(search-start
(max (point-min)
(- range-min (max 0 (- range-max (point-max))))))
(search-end
(min (point-max)
(+ range-max (max 0 (- (point-min) range-min))))))
(save-excursion
(goto-char search-start)
(while (re-search-forward regexp search-end t)
(let ((overlay (make-overlay (match-beginning subx) (match-end subx))))
(overlay-put overlay 'hi-lock-overlay t)
(overlay-put overlay 'hi-lock-overlay-regexp regexp)
(overlay-put overlay 'face face))
(goto-char (match-end 0)))))))))
;;;###autoload
;; simple-call-tree-info: DONE
(defcustom syslog-views nil
"A list of views.
Each view is a list of:
- a name for the view
- a list of files to display; each item in the list is a cons cell whose car is the base log file,
and whose cdr is a number indicating how many previous log files of the same type to include.
If nil then the view will be applied to the currently displayed file.
- a boolean indicating whether or not to label each line with the filename
- an optional list of functions to apply to transform the buffer before filtering & highlighting.
Each element is either:
- a list whose car is a function and whose cdr is a list of arguments for the function. The arglist
may contain the symbol 'interactive which means the value will be prompted for when the view is invoked.
- a cons cell whose car is a regexp containing a match group, and whose cdr is either a replacement
string, or a function that takes the text captured by that match group as its only arg, and returns
some text to replace it. This function/string will be used for replacing all matches in the buffer.
- a regexp matching start lines of blocks to show
- a regexp matching end lines of blocks to show (if blank then lines will be filtered instead of blocks)
- a regexp matching start lines of blocks to hide
- a regexp matching end lines of blocks to hide (if blank then lines will be hidden instead of blocks)
- an optional start date for filtering lines with `syslog-filter-dates'
- an optional end date for filtering lines with `syslog-filter-dates'
- a boolean; if non-nil hide lines matching above dates, otherwise display only those lines
- a list of highlighting info; each element is a cons cell whose car is a regexp to highlight and
whose cdr is a face to use for highlighting
- an optional name to rename the buffer"
:group 'syslog
:type '(repeat (list (string :tag "Name")
(repeat :tag "File(s)"
(cons (string :tag "Base file")
(number :tag "Number of previous files/days")))
(choice (const :tag "No file labels" nil)
(const :tag "Add file labels" t))
(repeat :tag "Treatment(s)"
(choice (cons :tag "Apply function"
(function :tag "Function")
(repeat
:tag "Args"
(choice :tag "Arg"
(sexp)
(const :tag "Prompt user when view is invoked"
'interactive))))
(cons :tag "Replace string"
(regexp
:help-echo "Regexp containing a match group"
:validate
(lambda (w)
(let ((v (widget-value w)))
(when (< (regexp-opt-depth v) 1)
(widget-put
w :error
"Regexp must have at least one match group")
w))))
(choice (function
:help-echo
"Function of one argument (a string captured by regexp match group)")
(string :help-echo "Replacement string")))))
(regexp :tag "Regexp matching start lines of blocks to show")
(regexp :tag "Regexp matching end lines of blocks to show")
(regexp :tag "Regexp matching start lines of blocks to hide")
(regexp :tag "Regexp matching end lines of blocks to hide")
(string :tag "Start date")
(string :tag "End date")
(choice (const :tag "Keep matching dates" nil)
(const :tag "Remove matching dates" t))
(repeat :tag "Highlights"
(cons (regexp :tag "Regexp to highlight")
(face :tag "Face")))
(string :tag "Buffer name"))))
;; simple-call-tree-info: DONE
(defcustom syslog-datetime-regexp
"^\\(?:[^ :]+: \\)?\\(\\(?:\\(?:[[:alpha:]]\\{3\\}\\)?[[:space:]]*[[:alpha:]]\\{3\\}\\s-+[0-9]+\\s-+[0-9:]+\\)\\|\\(?:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\s-+[0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}\\)\\)"
"A regular expression matching the date-time at the beginning of each line in the log file.
It should contain one non-shy subexpression matching the datetime string."
:group 'syslog
:type 'regexp)
;; simple-call-tree-info: DONE
(defcustom syslog-log-file-directory "/var/log/"
"The directory in which log files are stored."
:group 'syslog
:type 'directory)
(defcustom syslog-large-file-size 500000
"When `syslog-show-note-from-file-or-buffer' tries to load a file larger than this it prompts the user."
:group 'syslog
:type 'integer)
;; simple-call-tree-info: CHECK
(cl-defun syslog-spaced-floats (n &optional (min 0.0) (max 1.0))
"Return list of floats optimally circularly spaced between MIN and MAX.
The results are equivalent to sequentially placing points on a circle using
the golden section (which gives an optimal spacing according Tony van Ravenstein),
and then projecting them onto the range [MIN MAX)."
(cl-loop with range = (- max min)
for i from 0 to (1- n)
collect (+ min (mod (* i 0.61803398875 range)
range))))
;; simple-call-tree-info: CHECK
(cl-defmacro syslog-spaced-colours (n &key (h 180) (s 100) (l 50))
"Return list of N optimally spaced hex colour strings.
Keyword args :H, :S & :L indicate the required hue, saturation & lightness
values respectively (see https://www.hsluv.org). Each can be either a single
positive number, or an unquoted list of two numbers indicating a range from
which to select the N values (using `syslog-spaced-floats'). If more than one
of them is a range, then the values will be selected in parallel."
(cl-flet ((getlst (v) (cond ((integerp v) `(make-list ,n ,v))
((and (consp v) (integerp (car v)) (integerp (cadr v)))
`(syslog-spaced-floats ,n ,(car v) ,(cadr v)))
(t (error "Invalid arg: %S" v)))))
`(cl-mapcar (lambda (h s l) (hsluv-hsluv-to-hex (list h s l)))
,(getlst h) ,(getlst s) ,(getlst l))))
;; simple-call-tree-info: CHECK
(defcustom syslog-hi-face-defaults
(list
'(bg . (lambda nil (mapcar (lambda (h) (list :background h))
(syslog-spaced-colours 64 :h (0 360)))))
'(fg . (lambda nil (mapcar (lambda (h) (list :foreground h))
(syslog-spaced-colours 64 :h (0 360)))))
'(light_bg . (lambda nil (mapcar (lambda (h) (list :background h :foreground "black"))
(syslog-spaced-colours 64 :h (0 360) :l 85))))
'(dark_bg . (lambda nil (mapcar (lambda (h) (list :background h :foreground "white"))
(syslog-spaced-colours 64 :h (0 360) :l 15))))
'(light_fg . (lambda nil (mapcar (lambda (h) (list :foreground h))
(syslog-spaced-colours 64 :h (0 360) :l 85))))
'(dark_fg . (lambda nil (mapcar (lambda (h) (list :foreground h))
(syslog-spaced-colours 64 :h (0 360) :l 15))))
'(blue_bg . (lambda nil (mapcar (lambda (h) (list :background h))
(syslog-spaced-colours 64 :h (200 275) :l (70 5)))))
'(blue_fg . (lambda nil (mapcar (lambda (h) (list :foreground h))
(syslog-spaced-colours 64 :h (200 275) :l (70 5)))))
'(red_bg . (lambda nil (mapcar (lambda (h) (list :background h))
(syslog-spaced-colours 64 :h (-15 15) :l (10 60)))))
'(red_fg . (lambda nil (mapcar (lambda (h) (list :foreground h))
(syslog-spaced-colours 64 :h (-15 15) :l (10 60)))))
'(green_bg . (lambda nil (mapcar (lambda (h) (list :background h))
(syslog-spaced-colours 64 :h (90 165) :l (70 10)))))
'(green_fg . (lambda nil (mapcar (lambda (h) (list :foreground h))
(syslog-spaced-colours 64 :h (90 165) :l (70 10))))))
"Alist of face sets to use for automatic highlighting.
The car of each set is a symbol naming the set, and the cdr is either a list of faces,
or a function which returns such a list."
:group 'syslog
:type '(repeat (string :tag "Face")))
;;;###autoload
;; simple-call-tree-info: DONE
(cl-defun syslog-date-to-time (date &optional safe)
"Convert DATE string to time.
If no year is present in the date then the current year is used.
If DATE can't be parsed then if SAFE is non-nil return nil otherwise throw an error."
(if safe
(let ((time (safe-date-to-time (concat date " " (substring (current-time-string) -4)))))
(if (and (= (car time) 0) (= (cdr time) 0))
nil
time))
(date-to-time (concat date " " (substring (current-time-string) -4)))))
;;;###autoload
;; simple-call-tree-info: DONE
(defun syslog-filter-dates (start end &optional arg)
"Restrict buffer to lines between times START and END (Emacs time lists).
With prefix ARG: remove lines between dates.
If either START or END are nil then treat them as the first/last time in the
buffer respectively."
(interactive (let (firstdate lastdate)
(save-excursion
(goto-char (point-min))
(beginning-of-line)
(re-search-forward syslog-datetime-regexp nil t)
(setq firstdate (match-string 1))
(goto-char (point-max))
(beginning-of-line)
(re-search-backward syslog-datetime-regexp nil t)
(setq lastdate (match-string 1)))
(list (syslog-date-to-time (read-string "Start date and time: "
firstdate nil firstdate))
(syslog-date-to-time (read-string "End date and time: "
lastdate nil lastdate))
current-prefix-arg)))
(let ((start (if (stringp start)
(syslog-date-to-time start)
start))
(end (if (stringp end)
(syslog-date-to-time end)
end)))
(set (make-local-variable 'line-move-ignore-invisible) t)
(goto-char (point-min))
(let* ((start-position (point-min))
(pos (re-search-forward syslog-datetime-regexp nil t))
(intime-p (lambda (time)
(let ((isin (and (or (not end) (time-less-p time end))
(or (not start) (not (time-less-p time start))))))
(and time (if arg (not isin) isin)))))
(keeptime (funcall intime-p (syslog-date-to-time (match-string 1) t)))
(dodelete t))
(while pos
(cond ((and keeptime dodelete)
(hide-lines-add-overlay start-position (point-at-bol))