10 changed files with 1923 additions and 1 deletions
-
3custom.el
-
42elpa/hide-lines-20130623.1701/hide-lines-autoloads.el
-
2elpa/hide-lines-20130623.1701/hide-lines-pkg.el
-
204elpa/hide-lines-20130623.1701/hide-lines.el
-
39elpa/ov-20200326.1042/ov-autoloads.el
-
2elpa/ov-20200326.1042/ov-pkg.el
-
686elpa/ov-20200326.1042/ov.el
-
75elpa/syslog-mode-2.3/syslog-mode-autoloads.el
-
2elpa/syslog-mode-2.3/syslog-mode-pkg.el
-
869elpa/syslog-mode-2.3/syslog-mode.el
@ -0,0 +1,42 @@ |
|||||
|
;;; hide-lines-autoloads.el --- automatically extracted autoloads |
||||
|
;; |
||||
|
;;; Code: |
||||
|
|
||||
|
(add-to-list 'load-path (directory-file-name |
||||
|
(or (file-name-directory #$) (car load-path)))) |
||||
|
|
||||
|
|
||||
|
;;;### (autoloads nil "hide-lines" "hide-lines.el" (0 0 0 0)) |
||||
|
;;; Generated autoloads from hide-lines.el |
||||
|
|
||||
|
(autoload 'hide-lines "hide-lines" "\ |
||||
|
Hide lines matching the specified regexp. |
||||
|
With prefix arg of 4 (C-u) hide lines that do not match the specified regexp. |
||||
|
With any other prefix arg, reveal all hidden lines. |
||||
|
|
||||
|
\(fn &optional ARG)" t nil) |
||||
|
|
||||
|
(autoload 'hide-lines-not-matching "hide-lines" "\ |
||||
|
Hide lines that don't match the specified regexp. |
||||
|
|
||||
|
\(fn SEARCH-TEXT)" t nil) |
||||
|
|
||||
|
(autoload 'hide-lines-matching "hide-lines" "\ |
||||
|
Hide lines matching the specified regexp. |
||||
|
|
||||
|
\(fn SEARCH-TEXT)" t nil) |
||||
|
|
||||
|
(autoload 'hide-lines-show-all "hide-lines" "\ |
||||
|
Show all areas hidden by the filter-buffer command." t nil) |
||||
|
|
||||
|
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "hide-lines" '("hide-lines-"))) |
||||
|
|
||||
|
;;;*** |
||||
|
|
||||
|
;; Local Variables: |
||||
|
;; version-control: never |
||||
|
;; no-byte-compile: t |
||||
|
;; no-update-autoloads: t |
||||
|
;; coding: utf-8 |
||||
|
;; End: |
||||
|
;;; hide-lines-autoloads.el ends here |
||||
@ -0,0 +1,2 @@ |
|||||
|
;;; Generated package description from hide-lines.el -*- no-byte-compile: t -*- |
||||
|
(define-package "hide-lines" "20130623.1701" "Commands for hiding lines based on a regexp" 'nil :commit "4bfb4c6f4769bd6c637e4c18bbf65506832fc9f0" :authors '(("Mark Hulme-Jones <ture at plig cucumber dot net>")) :maintainer '("Joe Bloggs" . "vapniks@yahoo.com") :keywords '("convenience") :url "https://github.com/vapniks/hide-lines") |
||||
@ -0,0 +1,204 @@ |
|||||
|
;;; hide-lines.el --- Commands for hiding lines based on a regexp |
||||
|
|
||||
|
;; Filename: hide-lines.el |
||||
|
;; Description: Commands for hiding lines based on a regexp |
||||
|
;; Author: Mark Hulme-Jones <ture at plig cucumber dot net> |
||||
|
;; Maintainer: Joe Bloggs <vapniks@yahoo.com> |
||||
|
;; Version: 20130623.1701 |
||||
|
;; Package-Version: 20130623.1701 |
||||
|
;; Package-Commit: 4bfb4c6f4769bd6c637e4c18bbf65506832fc9f0 |
||||
|
;; Last-Updated: 2013-06-23 16:42:00 |
||||
|
;; By: Joe Bloggs |
||||
|
;; URL: https://github.com/vapniks/hide-lines |
||||
|
;; Keywords: convenience |
||||
|
;; Compatibility: GNU Emacs 24.3.1 |
||||
|
;; Package-Requires: |
||||
|
;; |
||||
|
;; Features that might be required by this library: |
||||
|
;; |
||||
|
;; |
||||
|
;; |
||||
|
|
||||
|
;;; 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, 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 |
||||
|
;; |
||||
|
;; The simplest way to make hide-lines work is to add the following |
||||
|
;; lines to your .emacs file: |
||||
|
;; |
||||
|
;; (autoload 'hide-lines "hide-lines" "Hide lines based on a regexp" t) |
||||
|
;; (global-set-key (kbd "C-c /") 'hide-lines) |
||||
|
;; |
||||
|
;; Now, when you type C-c /, you will be prompted for a regexp |
||||
|
;; (regular expression). All lines matching this regexp will be |
||||
|
;; hidden in the buffer. |
||||
|
;; |
||||
|
;; Alternatively, you can type C-u C-c / (ie. provide a prefix |
||||
|
;; argument to the hide-lines command) to hide all lines that *do not* |
||||
|
;; match the specified regexp. If you want to reveal previously hidden |
||||
|
;; lines you can use any other prefix, e.g. C-u C-u C-c / |
||||
|
;; |
||||
|
|
||||
|
;;; Commands: |
||||
|
;; |
||||
|
;; Below are complete command list: |
||||
|
;; |
||||
|
;; `hide-lines' |
||||
|
;; Hide lines matching the specified regexp. |
||||
|
;; `hide-lines-not-matching' |
||||
|
;; Hide lines that don't match the specified regexp. |
||||
|
;; `hide-lines-matching' |
||||
|
;; Hide lines matching the specified regexp. |
||||
|
;; `hide-lines-show-all' |
||||
|
;; Show all areas hidden by the filter-buffer command. |
||||
|
;; |
||||
|
;;; Customizable Options: |
||||
|
;; |
||||
|
;; Below are customizable option list: |
||||
|
;; |
||||
|
;; `hide-lines-reverse-prefix' |
||||
|
;; If non-nil then `hide-lines' will call `hide-lines-matching' by default, and `hide-lines-not-matching' with a single prefix. |
||||
|
;; default = nil. This variable is buffer local so you can use different values for different buffers. |
||||
|
|
||||
|
;;; Installation: |
||||
|
;; |
||||
|
;; Put hide-lines.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 'hide-lines) |
||||
|
|
||||
|
;;; Change log: |
||||
|
;; |
||||
|
;; 2013/06/22 - Add namespace prefixes to functions and variables. |
||||
|
;; Add licence and add to Marmalade repo. |
||||
|
;; Alter hide-lines so that it can also show all lines |
||||
|
;; |
||||
|
;; 24/03/2004 - Incorporate fix for infinite loop bug from David Hansen. |
||||
|
;; |
||||
|
|
||||
|
;;; Acknowledgements: |
||||
|
;; |
||||
|
;; David Hansen. |
||||
|
;; |
||||
|
|
||||
|
;;; TODO |
||||
|
;; |
||||
|
;; |
||||
|
;; |
||||
|
|
||||
|
;;; Require |
||||
|
|
||||
|
|
||||
|
;;; Code: |
||||
|
|
||||
|
(defgroup hide-lines nil |
||||
|
"Commands for hiding lines based on a regexp.") |
||||
|
|
||||
|
(defvar hide-lines-invisible-areas () |
||||
|
"List of invisible overlays used by hidelines") |
||||
|
|
||||
|
(defcustom hide-lines-reverse-prefix nil |
||||
|
"If non-nil then `hide-lines' will call `hide-lines-matching' by default, and `hide-lines-not-matching' with a single prefix. |
||||
|
Otherwise it's the other way round. |
||||
|
In either case a prefix arg with any value apart from 1 or 4 will call `hide-lines-show-all'." |
||||
|
:type 'boolean |
||||
|
:group 'hide-lines) |
||||
|
|
||||
|
(make-variable-buffer-local 'hide-lines-reverse-prefix) |
||||
|
|
||||
|
(add-to-invisibility-spec 'hl) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(defun hide-lines (&optional arg) |
||||
|
"Hide lines matching the specified regexp. |
||||
|
With prefix arg of 4 (C-u) hide lines that do not match the specified regexp. |
||||
|
With any other prefix arg, reveal all hidden lines." |
||||
|
(interactive "p") |
||||
|
(cond ((= arg 4) (call-interactively |
||||
|
(if hide-lines-reverse-prefix 'hide-lines-matching |
||||
|
'hide-lines-not-matching))) |
||||
|
((= arg 1) (call-interactively |
||||
|
(if hide-lines-reverse-prefix 'hide-lines-not-matching |
||||
|
'hide-lines-matching))) |
||||
|
(t (call-interactively 'hide-lines-show-all)))) |
||||
|
|
||||
|
(defun hide-lines-add-overlay (start end) |
||||
|
"Add an overlay from `start' to `end' in the current buffer. Push the |
||||
|
overlay onto the hide-lines-invisible-areas list" |
||||
|
(let ((overlay (make-overlay start end))) |
||||
|
(setq hide-lines-invisible-areas (cons overlay hide-lines-invisible-areas)) |
||||
|
(overlay-put overlay 'invisible 'hl))) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(defun hide-lines-not-matching (search-text) |
||||
|
"Hide lines that don't match the specified regexp." |
||||
|
(interactive "MHide lines not matched by regexp: ") |
||||
|
(set (make-local-variable 'line-move-ignore-invisible) t) |
||||
|
(save-excursion |
||||
|
(goto-char (point-min)) |
||||
|
(let ((start-position (point-min)) |
||||
|
(pos (re-search-forward search-text nil t))) |
||||
|
(while pos |
||||
|
(beginning-of-line) |
||||
|
(hide-lines-add-overlay start-position (point)) |
||||
|
(forward-line 1) |
||||
|
(setq start-position (point)) |
||||
|
(if (eq (point) (point-max)) |
||||
|
(setq pos nil) |
||||
|
(setq pos (re-search-forward search-text nil t)))) |
||||
|
(hide-lines-add-overlay start-position (point-max))))) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(defun hide-lines-matching (search-text) |
||||
|
"Hide lines matching the specified regexp." |
||||
|
(interactive "MHide lines matching regexp: ") |
||||
|
(set (make-local-variable 'line-move-ignore-invisible) t) |
||||
|
(save-excursion |
||||
|
(goto-char (point-min)) |
||||
|
(let ((pos (re-search-forward search-text nil t)) |
||||
|
start-position) |
||||
|
(while pos |
||||
|
(beginning-of-line) |
||||
|
(setq start-position (point)) |
||||
|
(end-of-line) |
||||
|
(hide-lines-add-overlay start-position (+ 1 (point))) |
||||
|
(forward-line 1) |
||||
|
(if (eq (point) (point-max)) |
||||
|
(setq pos nil) |
||||
|
(setq pos (re-search-forward search-text nil t))))))) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(defun hide-lines-show-all () |
||||
|
"Show all areas hidden by the filter-buffer command." |
||||
|
(interactive) |
||||
|
(mapc (lambda (overlay) (delete-overlay overlay)) |
||||
|
hide-lines-invisible-areas) |
||||
|
(setq hide-lines-invisible-areas ())) |
||||
|
|
||||
|
(provide 'hide-lines) |
||||
|
|
||||
|
;; (magit-push) |
||||
|
;; (yaoddmuse-post "EmacsWiki" "hide-lines.el" (buffer-name) (buffer-string) "update") |
||||
|
|
||||
|
;;; hide-lines.el ends here |
||||
@ -0,0 +1,39 @@ |
|||||
|
;;; ov-autoloads.el --- automatically extracted autoloads |
||||
|
;; |
||||
|
;;; Code: |
||||
|
|
||||
|
(add-to-list 'load-path (directory-file-name |
||||
|
(or (file-name-directory #$) (car load-path)))) |
||||
|
|
||||
|
|
||||
|
;;;### (autoloads nil "ov" "ov.el" (0 0 0 0)) |
||||
|
;;; Generated autoloads from ov.el |
||||
|
|
||||
|
(autoload 'ov-clear "ov" "\ |
||||
|
Clear overlays satisfying a condition. |
||||
|
|
||||
|
If PROP-OR-BEG is a symbol, clear overlays with this property set to non-nil. |
||||
|
|
||||
|
If VAL-OR-END is non-nil, the specified property's value should |
||||
|
`equal' to this value. |
||||
|
|
||||
|
If both of these are numbers, clear the overlays between these points. |
||||
|
|
||||
|
If BEG and END are numbers, clear the overlays with specified |
||||
|
property and value between these points. |
||||
|
|
||||
|
With no arguments, clear all overlays in the buffer. |
||||
|
|
||||
|
\(fn &optional PROP-OR-BEG (VAL-OR-END \\='any) BEG END)" t nil) |
||||
|
|
||||
|
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ov" 'nil)) |
||||
|
|
||||
|
;;;*** |
||||
|
|
||||
|
;; Local Variables: |
||||
|
;; version-control: never |
||||
|
;; no-byte-compile: t |
||||
|
;; no-update-autoloads: t |
||||
|
;; coding: utf-8 |
||||
|
;; End: |
||||
|
;;; ov-autoloads.el ends here |
||||
@ -0,0 +1,2 @@ |
|||||
|
;;; Generated package description from ov.el -*- no-byte-compile: t -*- |
||||
|
(define-package "ov" "20200326.1042" "Overlay library for Emacs Lisp" '((emacs "24.3")) :commit "c5b9aa4e1b00d702eb2caedd61c69a22a5fa1fab" :authors '(("Shingo Fukuyama - http://fukuyama.co")) :maintainer '("Shingo Fukuyama - http://fukuyama.co") :keywords '("convenience" "overlay") :url "https://github.com/ShingoFukuyama/ov.el") |
||||
@ -0,0 +1,686 @@ |
|||||
|
;;; ov.el --- Overlay library for Emacs Lisp -*- lexical-binding: t -*- |
||||
|
|
||||
|
;; Copyright (C) 2014 by Shingo Fukuyama |
||||
|
|
||||
|
;; Version: 1.0.6 |
||||
|
;; Package-Version: 20200326.1042 |
||||
|
;; Package-Commit: c5b9aa4e1b00d702eb2caedd61c69a22a5fa1fab |
||||
|
;; Author: Shingo Fukuyama - http://fukuyama.co |
||||
|
;; URL: https://github.com/ShingoFukuyama/ov.el |
||||
|
;; Created: Mar 20 2014 |
||||
|
;; Keywords: convenience overlay |
||||
|
;; Package-Requires: ((emacs "24.3")) |
||||
|
|
||||
|
;; 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 2 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. |
||||
|
|
||||
|
;;; Commentary: |
||||
|
|
||||
|
;; Simple way to manipulate overlay for Emacs. |
||||
|
;; More information is in README.md or https://github.com/ShingoFukuyama/ov.el |
||||
|
|
||||
|
;;; Code: |
||||
|
|
||||
|
(require 'cl-lib) |
||||
|
|
||||
|
(defgroup ov nil |
||||
|
"Group for ov.el" |
||||
|
:prefix "ov-" :group 'development) |
||||
|
|
||||
|
(defvar ov-sticky-front nil) |
||||
|
(defvar ov-sticky-rear nil) |
||||
|
|
||||
|
;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Overlay-Properties.html |
||||
|
(defvar ov-prop-list '(priority |
||||
|
window |
||||
|
category |
||||
|
face |
||||
|
mouse-face |
||||
|
display |
||||
|
help-echo |
||||
|
field |
||||
|
modification-hooks |
||||
|
insert-in-front-hooks |
||||
|
insert-behind-hooks |
||||
|
invisible |
||||
|
intangible |
||||
|
isearch-open-invisible |
||||
|
isearch-open-invisible-temporary |
||||
|
before-string |
||||
|
after-string |
||||
|
line-prefix |
||||
|
wrap-prefix |
||||
|
evaporate |
||||
|
local-map |
||||
|
keymap)) |
||||
|
|
||||
|
;; Make overlay / Set properties ----------------------------------------------- |
||||
|
;; Just make an overlay from `beg' and `end'. |
||||
|
;; Alias ;; Argument |
||||
|
(defalias 'ov-create 'make-overlay) ;; (beg end) |
||||
|
(defalias 'ov-make 'make-overlay) ;; (beg end) |
||||
|
|
||||
|
(defun ov (beg end &rest properties) |
||||
|
"Make an overlay from BEG to END. |
||||
|
|
||||
|
If PROPERTIES are specified, set them for the created overlay." |
||||
|
(if properties |
||||
|
(progn |
||||
|
;; To pass properties to `ov-set' |
||||
|
(when (listp (car-safe properties)) |
||||
|
(setq properties (car properties))) |
||||
|
(let ((o (ov-make beg end nil (not ov-sticky-front) ov-sticky-rear))) |
||||
|
(ov-set o properties) |
||||
|
o)) |
||||
|
(ov-make beg end nil (not ov-sticky-front) ov-sticky-rear))) |
||||
|
|
||||
|
(defun ov-line (&optional point) |
||||
|
"Make an overlay from the beginning of the line to the beginning of the next line, which include POINT." |
||||
|
(let (o) |
||||
|
(save-excursion |
||||
|
(goto-char (or point (point))) |
||||
|
(setq o (ov-make (point-at-bol) (min (1+ (point-at-eol)) (point-max)) |
||||
|
nil (not ov-sticky-front) ov-sticky-rear))) |
||||
|
o)) |
||||
|
|
||||
|
(defun ov-match (string &optional beg end) |
||||
|
"Make overlays spanning the regions that match STRING. |
||||
|
|
||||
|
If BEG and END are numbers, they specify the bounds of the search." |
||||
|
(save-excursion |
||||
|
(goto-char (or beg (point-min))) |
||||
|
(let (ov-or-ovs) |
||||
|
(ov-recenter (point-max)) |
||||
|
(while (search-forward string end t) |
||||
|
(setq ov-or-ovs (cons (ov-make (match-beginning 0) |
||||
|
(match-end 0) |
||||
|
nil (not ov-sticky-front) ov-sticky-rear) |
||||
|
ov-or-ovs))) |
||||
|
ov-or-ovs))) |
||||
|
|
||||
|
(defun ov-regexp (regexp &optional beg end) |
||||
|
"Make overlays spanning the regions that match REGEXP. |
||||
|
|
||||
|
If BEG and END are numbers, they specify the bounds of the search." |
||||
|
(save-excursion |
||||
|
(goto-char (or beg (point-min))) |
||||
|
(let (ov-or-ovs finish) |
||||
|
(ov-recenter (point-max)) |
||||
|
(while (and (not finish) (re-search-forward regexp end t)) |
||||
|
(setq ov-or-ovs (cons (ov-make (match-beginning 0) |
||||
|
(match-end 0) |
||||
|
nil (not ov-sticky-front) ov-sticky-rear) |
||||
|
ov-or-ovs)) |
||||
|
(when (= (match-beginning 0) (match-end 0)) |
||||
|
(if (eobp) |
||||
|
(setq finish t) |
||||
|
(forward-char 1)))) |
||||
|
ov-or-ovs))) |
||||
|
|
||||
|
(defun ov-region () |
||||
|
"Make an overlay from a region if region is active." |
||||
|
(if (use-region-p) |
||||
|
(let ((o (ov-make (region-beginning) (region-end) |
||||
|
nil (not ov-sticky-front) ov-sticky-rear))) |
||||
|
(deactivate-mark t) |
||||
|
o) |
||||
|
(error "Need to make region"))) |
||||
|
|
||||
|
(defun ov-set (ov-or-ovs-or-regexp &rest properties) |
||||
|
"Set overlay properties and values. |
||||
|
OV-OR-OVS-OR-REGEXP can be an overlay, overlays or a regexp. |
||||
|
|
||||
|
If an overlay or list of overlays, PROPERTIES are set for these. |
||||
|
|
||||
|
If a regexp, first overlays are created on the matching |
||||
|
regions (see `ov-regexp'), then the properties are set." |
||||
|
(when ov-or-ovs-or-regexp |
||||
|
(unless (and ov-or-ovs-or-regexp properties) |
||||
|
(error "Arguments are OV and PROPERTIES")) |
||||
|
(when (listp (car-safe properties)) |
||||
|
(setq properties (car properties))) |
||||
|
(let ((len (length properties)) |
||||
|
(i 0) |
||||
|
return-type) |
||||
|
(cond ((stringp ov-or-ovs-or-regexp) |
||||
|
(setq ov-or-ovs-or-regexp (ov-regexp ov-or-ovs-or-regexp)) |
||||
|
(setq return-type 'ov-list)) |
||||
|
((ov-p ov-or-ovs-or-regexp) |
||||
|
(setq ov-or-ovs-or-regexp (cons ov-or-ovs-or-regexp nil)) |
||||
|
(setq return-type 'ov)) |
||||
|
((listp ov-or-ovs-or-regexp) |
||||
|
(setq return-type 'ov-list))) |
||||
|
(unless (eq (logand len 1) 0) |
||||
|
(error "Invalid properties pairs")) |
||||
|
(mapc (lambda (ov) |
||||
|
(while (< i len) |
||||
|
(overlay-put |
||||
|
ov |
||||
|
(nth i properties) (nth (setq i (1+ i)) properties)) |
||||
|
(setq i (1+ i))) |
||||
|
(setq i 0)) |
||||
|
ov-or-ovs-or-regexp) |
||||
|
(if (eq 'ov return-type) |
||||
|
(car ov-or-ovs-or-regexp) |
||||
|
ov-or-ovs-or-regexp)))) |
||||
|
(defalias 'ov-put 'ov-set) |
||||
|
|
||||
|
(defun ov-insert (any) |
||||
|
"Insert ANY (string, number, list, etc) covered with an empty overlay." |
||||
|
(or (stringp any) (setq any (format "%s" any))) |
||||
|
(let* ((beg (point)) |
||||
|
(len (length any)) |
||||
|
(end (+ beg len))) |
||||
|
(insert any) |
||||
|
(ov-make beg end nil (not ov-sticky-front) ov-sticky-rear))) |
||||
|
|
||||
|
|
||||
|
;; Delete overlay -------------------------------------------------------------- |
||||
|
;;;###autoload |
||||
|
(cl-defun ov-clear (&optional prop-or-beg (val-or-end 'any) beg end) |
||||
|
"Clear overlays satisfying a condition. |
||||
|
|
||||
|
If PROP-OR-BEG is a symbol, clear overlays with this property set to non-nil. |
||||
|
|
||||
|
If VAL-OR-END is non-nil, the specified property's value should |
||||
|
`equal' to this value. |
||||
|
|
||||
|
If both of these are numbers, clear the overlays between these points. |
||||
|
|
||||
|
If BEG and END are numbers, clear the overlays with specified |
||||
|
property and value between these points. |
||||
|
|
||||
|
With no arguments, clear all overlays in the buffer." |
||||
|
(interactive) |
||||
|
(cl-labels ((clear |
||||
|
(con beg end) |
||||
|
(ov-recenter (or end (point-max))) |
||||
|
(mapc (lambda (ov) |
||||
|
(when (and (memq prop-or-beg (ov-prop ov)) |
||||
|
(if con |
||||
|
t (equal val-or-end (ov-val ov prop-or-beg)))) |
||||
|
(delete-overlay ov))) |
||||
|
(overlays-in beg end)))) |
||||
|
(cond |
||||
|
;; (ov-clear) |
||||
|
((and (not prop-or-beg) (eq 'any val-or-end) (not beg) (not end)) |
||||
|
(ov-recenter (point-max)) |
||||
|
(remove-overlays (point-min) (point-max))) |
||||
|
;; (ov-clear 10 500) |
||||
|
((and (numberp prop-or-beg) (numberp val-or-end)) |
||||
|
(ov-recenter val-or-end) |
||||
|
(remove-overlays prop-or-beg val-or-end)) |
||||
|
;; (ov-clear 'face 'warning) |
||||
|
((and (symbolp prop-or-beg) (not (eq 'any val-or-end)) (not beg) (not end)) |
||||
|
(clear nil (point-min) (point-max))) |
||||
|
;; (ov-clear 'face) or (ov-clear 'face 'any) |
||||
|
((and (symbolp prop-or-beg) (eq 'any val-or-end) (not beg) (not end)) |
||||
|
(clear t (point-min) (point-max))) |
||||
|
;; (ov-clear 'face 'worning 10 500) |
||||
|
((and (symbolp prop-or-beg) (not (eq 'any val-or-end)) (numberp beg) (numberp end)) |
||||
|
(clear nil beg end)) |
||||
|
;; (ov-clear 'face 'any 10 500) |
||||
|
((and (symbolp prop-or-beg) (eq 'any val-or-end) (numberp beg) (numberp end)) |
||||
|
(clear t beg end)) |
||||
|
(t nil))) |
||||
|
nil) |
||||
|
|
||||
|
(defmacro ov-reset (ov-or-ovs-variable) |
||||
|
"Clear overlays in OV-OR-OVS-VARIABLE. |
||||
|
|
||||
|
OV-OR-OVS-VARIABLE should be a symbol whose value is an overlay |
||||
|
or a list of overlays. |
||||
|
|
||||
|
Finally, the variable is set to nil." |
||||
|
`(progn |
||||
|
(mapc (lambda (ov) |
||||
|
(delete-overlay ov)) |
||||
|
(if (listp ,ov-or-ovs-variable) |
||||
|
,ov-or-ovs-variable |
||||
|
(cons ,ov-or-ovs-variable nil))) |
||||
|
(setq ,ov-or-ovs-variable nil))) |
||||
|
|
||||
|
|
||||
|
;; Look up overlay parameters, etc --------------------------------------------- |
||||
|
;; Alias ;; Argument |
||||
|
;; Check whether `ov' is overlay or not. |
||||
|
(defalias 'ov-p 'overlayp) ;; (ov) |
||||
|
(defalias 'ov? 'overlayp) ;; (ov) |
||||
|
(defalias 'ov-val 'overlay-get) ;; (ov property) |
||||
|
;; Get the boundary position of an overlay. |
||||
|
(defalias 'ov-beg 'overlay-start) ;; (ov) |
||||
|
(defalias 'ov-end 'overlay-end) ;; (ov) |
||||
|
;; Get the buffer object of an overlay. |
||||
|
(defalias 'ov-buf 'overlay-buffer) ;; (ov) |
||||
|
;; Get the properties from an overlay. |
||||
|
(defalias 'ov-prop 'overlay-properties) ;; (ov) |
||||
|
|
||||
|
(defun ov-length (overlay) |
||||
|
"Return the length of the region spanned by OVERLAY." |
||||
|
(- (ov-end overlay) (ov-beg overlay))) |
||||
|
|
||||
|
(defun ov-spec (ov-or-ovs) |
||||
|
"Make an overlay specification list. |
||||
|
This is of the form: |
||||
|
|
||||
|
(beginning end buffer &rest properties). |
||||
|
|
||||
|
OV-OR-OVS should be an overlay or a list of overlays." |
||||
|
(or (listp ov-or-ovs) (setq ov-or-ovs (cons ov-or-ovs nil))) |
||||
|
(mapcar (lambda (ov) |
||||
|
(list (ov-beg ov) (ov-end ov) |
||||
|
(ov-buf ov) (overlay-properties ov))) |
||||
|
ov-or-ovs)) |
||||
|
|
||||
|
|
||||
|
;; Get present overlay object -------------------------------------------------- |
||||
|
(defun ov-at (&optional point) |
||||
|
"Get an overlay at POINT. |
||||
|
POINT defaults to the current `point'." |
||||
|
(or point (setq point (point))) |
||||
|
(car (overlays-at point))) |
||||
|
|
||||
|
;; Get overlays between `beg' and `end'. |
||||
|
(cl-defun ov-in (&optional prop-or-beg (val-or-end 'any) beg end) |
||||
|
"Get overlays satisfying a condition. |
||||
|
|
||||
|
If PROP-OR-BEG is a symbol, get overlays with this property set to non-nil. |
||||
|
|
||||
|
If VAL-OR-END is non-nil, the specified property's value should |
||||
|
`equal' to this value. |
||||
|
|
||||
|
If both of these are numbers, get the overlays between these points. |
||||
|
|
||||
|
If BEG and END are numbers, get the overlays with specified |
||||
|
property and value between these points. |
||||
|
|
||||
|
With no arguments, get all overlays in the buffer." |
||||
|
(cl-labels ((in (con beg end) |
||||
|
(delq nil |
||||
|
(mapcar |
||||
|
(lambda ($ov) |
||||
|
(when (and (memq prop-or-beg (ov-prop $ov)) |
||||
|
(if con |
||||
|
t (equal val-or-end (ov-val $ov prop-or-beg)))) |
||||
|
$ov)) |
||||
|
(overlays-in beg end))))) |
||||
|
(cond |
||||
|
;; (ov-in) |
||||
|
((and (not prop-or-beg) (eq 'any val-or-end) (not beg) (not end)) |
||||
|
(overlays-in (point-min) (point-max))) |
||||
|
;; (ov-in 10 500) |
||||
|
((and (numberp prop-or-beg) (numberp val-or-end)) |
||||
|
(overlays-in prop-or-beg val-or-end)) |
||||
|
;; (ov-in 'face 'warning) |
||||
|
((and (symbolp prop-or-beg) (not (eq 'any val-or-end)) (not beg) (not end)) |
||||
|
(in nil (point-min) (point-max))) |
||||
|
;; (ov-in 'face) or (ov-in 'face 'any) |
||||
|
((and (symbolp prop-or-beg) (eq 'any val-or-end) (not beg) (not end)) |
||||
|
(in t (point-min) (point-max))) |
||||
|
;; (ov-in 'face 'worning 10 500) |
||||
|
((and (symbolp prop-or-beg) (not (eq 'any val-or-end)) (numberp beg) (numberp end)) |
||||
|
(in nil beg end)) |
||||
|
;; (ov-in 'face 'any 10 500) |
||||
|
((and (symbolp prop-or-beg) (eq 'any val-or-end) (numberp beg) (numberp end)) |
||||
|
(in t beg end)) |
||||
|
(t nil)))) |
||||
|
|
||||
|
(defun ov-all () |
||||
|
"Get all the overlays in the entire buffer." |
||||
|
(overlays-in (point-min) (point-max))) |
||||
|
|
||||
|
(defun ov-backwards (&optional point) |
||||
|
"Get all the overlays from the beginning of the buffer to POINT." |
||||
|
(ov-in (point-min) (or point (point)))) |
||||
|
|
||||
|
(defun ov-forwards (&optional point) |
||||
|
"Get all the overlays from POINT to the end of the buffer." |
||||
|
(ov-in (or point (point)) (point-max))) |
||||
|
|
||||
|
|
||||
|
;; Overlay manipulation -------------------------------------------------------- |
||||
|
;; Alias ;; Argument |
||||
|
(defalias 'ov-recenter 'overlay-recenter) ;; (point) |
||||
|
;; Move an existing overlay position to another position. |
||||
|
(defalias 'ov-move 'move-overlay) ;; (ov beg end &optional buffer) |
||||
|
|
||||
|
(defmacro ov-timeout (time func func-after) |
||||
|
"Execute FUNC-AFTER after TIME seconds passed since FUNC finished." |
||||
|
(declare (indent 1)) |
||||
|
(if (symbolp func-after) |
||||
|
(run-with-timer time nil `(lambda () (funcall ',func-after))) |
||||
|
(run-with-timer time nil `(lambda () ,(funcall `(lambda () ,func-after))))) |
||||
|
(if (symbolp func) |
||||
|
(funcall func) |
||||
|
(funcall (lambda () (eval func))))) |
||||
|
|
||||
|
(cl-defun ov-next (&optional point-or-prop prop-or-val (val 'any)) |
||||
|
"Get the next overlay satisfying a condition. |
||||
|
|
||||
|
If POINT-OR-PROP is a symbol, get the next overlay with this |
||||
|
property being non-nil. |
||||
|
|
||||
|
If PROP-OR-VAL is non-nil, the property should have this value. |
||||
|
|
||||
|
If POINT-OR-PROP is a number, get the next overlay after this |
||||
|
point. |
||||
|
|
||||
|
If PROP-OR-VAL and VAL are also specified, get the next overlay |
||||
|
after POINT-OR-PROP having property PROP-OR-VAL set to VAL (with |
||||
|
VAL unspecified, only the presence of property is tested)." |
||||
|
(cl-labels ((next |
||||
|
(po pr va) |
||||
|
(save-excursion |
||||
|
(goto-char (next-overlay-change po)) |
||||
|
(let (ov) |
||||
|
(while (and (not (if (setq ov (ov-at (point))) |
||||
|
(and (memq pr (ov-prop ov)) |
||||
|
(if (eq 'any va) |
||||
|
t (equal va (ov-val ov pr)))))) |
||||
|
(not (if (eobp) (progn (setq ov nil) t)))) |
||||
|
(goto-char (next-overlay-change (point)))) |
||||
|
ov)))) |
||||
|
(cond |
||||
|
;; (ov-next) or (ov-next 300) |
||||
|
((and (or (numberp point-or-prop) (not point-or-prop)) |
||||
|
(not prop-or-val) (eq 'any val)) |
||||
|
(let* ((po (next-overlay-change (or point-or-prop (point)))) |
||||
|
(ov (ov-at po))) |
||||
|
(if (ov? ov) |
||||
|
ov |
||||
|
(ov-at (next-overlay-change po))))) |
||||
|
;; (ov-next 'face) |
||||
|
((and point-or-prop (symbolp point-or-prop) (not prop-or-val) (eq 'any val)) |
||||
|
(next (point) point-or-prop 'any)) |
||||
|
;; (ov-next 'face 'warning) |
||||
|
((and point-or-prop (symbolp point-or-prop) prop-or-val (eq 'any val)) |
||||
|
(next (point) point-or-prop prop-or-val)) |
||||
|
;; (ov-next 300 'face 'warning) |
||||
|
((and (or (not point-or-prop) (numberp point-or-prop)) |
||||
|
(symbolp prop-or-val) (not (eq 'any val))) |
||||
|
(next (or point-or-prop (point)) prop-or-val val)) |
||||
|
;; (ov-next 300 'face) |
||||
|
((and (or (numberp point-or-prop) (not point-or-prop)) (symbolp prop-or-val)) |
||||
|
(next (or point-or-prop (point)) prop-or-val val)) |
||||
|
(t nil)))) |
||||
|
|
||||
|
(cl-defun ov-prev (&optional point-or-prop prop-or-val (val 'any)) |
||||
|
"Get the previous overlay satisfying a condition. |
||||
|
|
||||
|
If POINT-OR-PROP is a symbol, get the previous overlay with this |
||||
|
property being non-nil. |
||||
|
|
||||
|
If PROP-OR-VAL is non-nil, the property should have this value. |
||||
|
|
||||
|
If POINT-OR-PROP is a number, get the previous overlay after this |
||||
|
point. |
||||
|
|
||||
|
If PROP-OR-VAL and VAL are also specified, get the previous |
||||
|
overlay after POINT-OR-PROP having property PROP-OR-VAL set to |
||||
|
VAL (with VAL unspecified, only the presence of property is |
||||
|
tested)." |
||||
|
(cl-labels ((prev |
||||
|
(po pr va) |
||||
|
(save-excursion |
||||
|
(goto-char (previous-overlay-change po)) |
||||
|
(let (ov) |
||||
|
(while (and (not (if (setq ov (ov-at (1- (point)))) |
||||
|
(and (memq pr (ov-prop ov)) |
||||
|
(if (eq 'any va) |
||||
|
t (equal va (ov-val ov pr)))))) |
||||
|
(not (if (bobp) (progn (setq ov nil) t)))) |
||||
|
(goto-char (previous-overlay-change (point)))) |
||||
|
ov)))) |
||||
|
(cond |
||||
|
((and (or (numberp point-or-prop) (not point-or-prop)) |
||||
|
(not prop-or-val) (eq 'any val)) |
||||
|
(let* ((po1 (previous-overlay-change (point))) |
||||
|
(po2 (previous-overlay-change po1)) |
||||
|
(ov (or (ov-at po2) (ov-at (1- po2))))) |
||||
|
(if (ov? ov) ov))) |
||||
|
;; (ov-prev 'face) |
||||
|
((and point-or-prop (symbolp point-or-prop) (not prop-or-val) (eq 'any val)) |
||||
|
(prev (point) point-or-prop 'any)) |
||||
|
;; (ov-prev 'face 'warning) |
||||
|
((and point-or-prop (symbolp point-or-prop) prop-or-val (eq 'any val)) |
||||
|
(prev (point) point-or-prop prop-or-val)) |
||||
|
;; (ov-prev 300 'face 'warning) |
||||
|
((and (or (not point-or-prop) (numberp point-or-prop)) |
||||
|
(symbolp prop-or-val) (not (eq 'any val))) |
||||
|
(prev (or point-or-prop (point)) prop-or-val val)) |
||||
|
;; (ov-prev 300 'face) |
||||
|
((and (or (numberp point-or-prop) (not point-or-prop)) (symbolp prop-or-val)) |
||||
|
(prev (or point-or-prop (point)) prop-or-val val)) |
||||
|
(t nil)))) |
||||
|
|
||||
|
(cl-defun ov-goto-next (&optional point-or-prop prop-or-val (val 'any)) |
||||
|
"Move cursor to the end of the next overlay. |
||||
|
The arguments are the same as for `ov-next'." |
||||
|
(interactive) |
||||
|
(let ((o (ov-next point-or-prop prop-or-val val))) |
||||
|
(if o (goto-char (ov-end o))))) |
||||
|
|
||||
|
(cl-defun ov-goto-prev (&optional point-or-prop prop-or-val (val 'any)) |
||||
|
"Move cursor to the beginning of previous overlay. |
||||
|
The arguments are the same as for `ov-prev'." |
||||
|
(interactive) |
||||
|
(let ((o (ov-prev point-or-prop prop-or-val val))) |
||||
|
(if o (goto-char (ov-beg o))))) |
||||
|
|
||||
|
(defun ov-keymap (ov-or-ovs-or-id &rest keybinds) |
||||
|
"Set KEYBINDS to an overlay or a list of overlays. |
||||
|
|
||||
|
If OV-OR-OVS-OR-ID is a symbol, the KEYBINDS will be enabled for |
||||
|
the entire buffer and the property represented by the symbol to t. |
||||
|
|
||||
|
The overlay is expanded if new inputs are inserted at the |
||||
|
beginning or end of the buffer." |
||||
|
(let ((map (make-sparse-keymap))) |
||||
|
(when (cl-evenp (length keybinds)) |
||||
|
(while keybinds |
||||
|
(let* ((key (pop keybinds)) |
||||
|
(fn (pop keybinds)) |
||||
|
(command (cl-typecase fn |
||||
|
(command fn) |
||||
|
(cons `(lambda () (interactive) ,fn)) |
||||
|
(t (error "Invalid function"))))) |
||||
|
(cl-typecase key |
||||
|
(vector (define-key map key command)) |
||||
|
(string (define-key map (kbd key) command)) |
||||
|
(list (mapc (lambda (k) |
||||
|
(define-key map (cl-typecase k |
||||
|
(vector k) |
||||
|
(string (kbd k))) command)) |
||||
|
key)) |
||||
|
(t (error "Invalid key")))))) |
||||
|
(if (symbolp ov-or-ovs-or-id) |
||||
|
(let ((ov-sticky-front t) |
||||
|
(ov-sticky-rear t)) |
||||
|
(ov (point-min) (point-max) 'keymap map ov-or-ovs-or-id t)) |
||||
|
(ov-set ov-or-ovs-or-id 'keymap map)))) |
||||
|
|
||||
|
|
||||
|
;; Implement pseudo read-only overlay function --------------------------------- |
||||
|
(defun ov-read-only (ov-or-ovs &optional insert-in-front insert-behind) |
||||
|
"Implement a read-only like feature for an overlay or a list of overlays. |
||||
|
|
||||
|
If INSERT-IN-FRONT is non-nil, inserting in front of each overlay is prevented. |
||||
|
|
||||
|
If INSERT-BEHIND is non-nil, inserting behind of each overlay is prevented. |
||||
|
|
||||
|
Note that it allows modifications from out of range of a read-only overlay. |
||||
|
|
||||
|
OV-OR-OVS can be an overlay or list of overlay." |
||||
|
(cond ((not (and insert-in-front insert-behind)) |
||||
|
(ov-set ov-or-ovs |
||||
|
'modification-hooks '(ov--read-only))) |
||||
|
((and insert-in-front insert-behind) |
||||
|
(ov-set ov-or-ovs |
||||
|
'modification-hooks '(ov--read-only) |
||||
|
'insert-in-front-hooks '(ov--read-only) |
||||
|
'insert-behind-hooks '(ov--read-only))) |
||||
|
(insert-in-front |
||||
|
(ov-set ov-or-ovs |
||||
|
'modification-hooks '(ov--read-only) |
||||
|
'insert-in-front-hooks '(ov--read-only))) |
||||
|
(t ;; Should be insert-behind |
||||
|
(ov-set ov-or-ovs |
||||
|
'modification-hooks '(ov--read-only) |
||||
|
'insert-behind-hooks '(ov--read-only))))) |
||||
|
|
||||
|
(defun ov--read-only (ov after beg end &optional _length) |
||||
|
(when (and (not (or after |
||||
|
undo-in-progress |
||||
|
(eq this-command 'undo) |
||||
|
(eq this-command 'redo))) |
||||
|
;; Modification within range of a text |
||||
|
(or (< (ov-beg ov) beg) |
||||
|
(> (ov-end ov) end))) |
||||
|
(error "Text is read-only"))) |
||||
|
|
||||
|
|
||||
|
;; Special overlay ------------------------------------------------------------- |
||||
|
(defun ov-placeholder (ov-or-ovs) |
||||
|
"Set a placeholder feature for an overlay or a list of overlays. |
||||
|
|
||||
|
Each overlay deletes its string and overlay, when it is modified. |
||||
|
|
||||
|
OV-OR-OVS can be an overlay or list of overlay." |
||||
|
(ov-set ov-or-ovs |
||||
|
'evaporate t |
||||
|
'modification-hooks '(ov--placeholder) |
||||
|
'insert-in-front-hooks '(ov--placeholder) |
||||
|
'insert-behind-hooks '(ov--placeholder))) |
||||
|
|
||||
|
(defun ov--placeholder (ov after beg end &optional length) |
||||
|
(let ((inhibit-modification-hooks t)) |
||||
|
(when (not (or undo-in-progress |
||||
|
(eq this-command 'undo) |
||||
|
(eq this-command 'redo))) |
||||
|
(cond ((and (not after) (eq beg end)) |
||||
|
(delete-region (ov-beg ov) (ov-end ov))) |
||||
|
((and after (> length 0)) |
||||
|
(if (ov-beg ov) |
||||
|
(delete-region (ov-beg ov) (ov-end ov)))))))) |
||||
|
|
||||
|
|
||||
|
;; Smear background ------------------------------------------------------------ |
||||
|
(defun ov--parse-hex-color (hex) |
||||
|
"Convert a HEX color code to a RGB list. |
||||
|
i.e. |
||||
|
#99ccff => (153 204 255) |
||||
|
#33a => (51 51 170)" |
||||
|
(let (result) |
||||
|
|
||||
|
(when (string-match |
||||
|
"^\\s-*\\#\\([0-9a-fA-F]\\)\\([0-9a-fA-F]\\)\\([0-9a-fA-F]\\)\\s-*$" |
||||
|
hex) |
||||
|
(let ((m1 (match-string 1 hex)) |
||||
|
(m2 (match-string 2 hex)) |
||||
|
(m3 (match-string 3 hex))) |
||||
|
(setq result (list (read (format "#x%s%s" m1 m1)) |
||||
|
(read (format "#x%s%s" m2 m2)) |
||||
|
(read (format "#x%s%s" m3 m3)))))) |
||||
|
(when (string-match |
||||
|
"^\\s-*\\#\\([0-9a-fA-F]\\{2\\}\\)\\([0-9a-fA-F]\\{2\\}\\)\\([0-9a-fA-F]\\{2\\}\\)\\s-*$" |
||||
|
hex) |
||||
|
(setq result (list (read (format "#x%s" (match-string 1 hex))) |
||||
|
(read (format "#x%s" (match-string 2 hex))) |
||||
|
(read (format "#x%s" (match-string 3 hex)))))) |
||||
|
result)) |
||||
|
|
||||
|
(defun ov--random-color (&optional base-color range) |
||||
|
"Generate random color based on BASE-COLOR and RANGE. |
||||
|
Default background color is used when BASE-COLOR is nil." |
||||
|
(or range (setq range 50)) |
||||
|
(let ((default-background-color (ignore-errors (face-attribute 'default :background)))) |
||||
|
(or base-color |
||||
|
(setq base-color |
||||
|
(cond ((eq 'unspecified default-background-color) |
||||
|
"#fff") |
||||
|
((string-match "^#[0-9a-fA-F]\\{3,6\\}" default-background-color) |
||||
|
default-background-color) |
||||
|
((color-name-to-rgb default-background-color) ;; yellow, LightBlue, etc... |
||||
|
default-background-color) |
||||
|
(t "#fff"))))) |
||||
|
(if (color-name-to-rgb base-color) |
||||
|
(let ((rgb) (hex "#")) |
||||
|
(mapc (lambda (x) |
||||
|
(setq rgb (cons (round (* x 255)) rgb))) |
||||
|
(color-name-to-rgb base-color)) |
||||
|
(setq rgb (nreverse rgb)) |
||||
|
(mapc (lambda (x) |
||||
|
(setq hex (concat hex (format "%02x" x)))) |
||||
|
rgb) |
||||
|
(setq base-color hex))) |
||||
|
(let* ((rgb (ov--parse-hex-color base-color)) |
||||
|
(half-range (/ range 2)) |
||||
|
(fn (lambda (n) |
||||
|
(let* ((base (nth n rgb)) |
||||
|
(min half-range) |
||||
|
(max (- 255 half-range)) |
||||
|
result) |
||||
|
(if (< base min) (setq base min)) |
||||
|
(if (> base max) (setq base max)) |
||||
|
(setq result (+ (- (cl-random range) half-range) base)) |
||||
|
(if (< result 0) (setq result 0)) |
||||
|
(if (> result 255) (setq result 255)) |
||||
|
result))) |
||||
|
(r (funcall fn 0)) |
||||
|
(g (funcall fn 1)) |
||||
|
(b (funcall fn 2))) |
||||
|
(format "#%02x%02x%02x" r g b))) |
||||
|
|
||||
|
(defun ov-smear (regexp-or-list &optional match-end base-color color-range) |
||||
|
"Set background color overlays to the current buffer. |
||||
|
Each background color is randomly determined based on BASE-COLOR |
||||
|
or the default background color. |
||||
|
|
||||
|
If REGEXP-OR-LIST is regexp |
||||
|
Set overlays between matches of a regexp. |
||||
|
If REGEXP-OR-LIST is list |
||||
|
Set overlays between point pairs in a list. |
||||
|
i.e. (ov-smear '((1 . 30) (30 . 90)))" |
||||
|
(interactive "sSplitter: ") |
||||
|
(ov-clear 'ov-smear) |
||||
|
(let (points area length (counter 0) ov-list) |
||||
|
(cl-typecase regexp-or-list |
||||
|
(string (save-excursion |
||||
|
(goto-char (point-min)) |
||||
|
(while (re-search-forward regexp-or-list nil t) |
||||
|
(setq points (cons |
||||
|
(if match-end |
||||
|
(match-end 0) |
||||
|
(match-beginning 0)) |
||||
|
points)))) |
||||
|
(setq points (nreverse points)) |
||||
|
(setq length (length points)) |
||||
|
(while (< counter (1- length)) |
||||
|
(setq area (cons |
||||
|
(cons |
||||
|
(nth counter points) |
||||
|
(nth (1+ counter) points)) |
||||
|
area)) |
||||
|
(setq counter (1+ counter)))) |
||||
|
(list (setq area regexp-or-list))) |
||||
|
(mapc (lambda (a) |
||||
|
(let ((ov (ov (car a) (cdr a)))) |
||||
|
(ov-set ov |
||||
|
'face `(:background ,(ov--random-color base-color color-range)) |
||||
|
'ov-smear t) |
||||
|
(setq ov-list (cons ov ov-list)))) |
||||
|
area) |
||||
|
ov-list)) |
||||
|
|
||||
|
|
||||
|
|
||||
|
|
||||
|
(provide 'ov) |
||||
|
;;; ov.el ends here |
||||
@ -0,0 +1,75 @@ |
|||||
|
;;; syslog-mode-autoloads.el --- automatically extracted autoloads |
||||
|
;; |
||||
|
;;; Code: |
||||
|
|
||||
|
(add-to-list 'load-path (directory-file-name |
||||
|
(or (file-name-directory #$) (car load-path)))) |
||||
|
|
||||
|
|
||||
|
;;;### (autoloads nil "syslog-mode" "syslog-mode.el" (0 0 0 0)) |
||||
|
;;; Generated autoloads from syslog-mode.el |
||||
|
|
||||
|
(defvar syslog-setup-on-load nil "\ |
||||
|
*If not nil setup syslog mode on load by running syslog-add-hooks.") |
||||
|
|
||||
|
(autoload 'syslog-view "syslog-mode" "\ |
||||
|
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. |
||||
|
|
||||
|
\(fn FILES &optional LABEL RXSHOWSTART RXSHOWEND RXHIDESTART RXHIDEEND STARTDATE ENDDATE REMOVEDATES HIGHLIGHTS BUFNAME)" t nil) |
||||
|
|
||||
|
(autoload 'syslog-filter-lines "syslog-mode" "\ |
||||
|
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. |
||||
|
|
||||
|
\(fn &optional ARG)" t nil) |
||||
|
|
||||
|
(defvar syslog-views nil "\ |
||||
|
A list of views. |
||||
|
If regexps matching end lines are left blank then lines will be filtered instead of blocks (see `syslog-filter-lines').") |
||||
|
|
||||
|
(custom-autoload 'syslog-views "syslog-mode" t) |
||||
|
|
||||
|
(autoload 'syslog-date-to-time "syslog-mode" "\ |
||||
|
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. |
||||
|
|
||||
|
\(fn DATE &optional SAFE)" nil nil) |
||||
|
|
||||
|
(autoload 'syslog-filter-dates "syslog-mode" "\ |
||||
|
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. |
||||
|
|
||||
|
\(fn START END &optional ARG)" t nil) |
||||
|
|
||||
|
(autoload 'syslog-mode "syslog-mode" "\ |
||||
|
Major mode for working with system logs. |
||||
|
|
||||
|
\\{syslog-mode-map}" t nil) |
||||
|
|
||||
|
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "syslog-mode" '("syslog-"))) |
||||
|
|
||||
|
;;;*** |
||||
|
|
||||
|
;; Local Variables: |
||||
|
;; version-control: never |
||||
|
;; no-byte-compile: t |
||||
|
;; no-update-autoloads: t |
||||
|
;; coding: utf-8 |
||||
|
;; End: |
||||
|
;;; syslog-mode-autoloads.el ends here |
||||
@ -0,0 +1,2 @@ |
|||||
|
;;; Generated package description from syslog-mode.el -*- no-byte-compile: t -*- |
||||
|
(define-package "syslog-mode" "2.3" "Major-mode for viewing log files" '((hide-lines "20130623") (ov "20150311")) :commit "18f441bf57dd70cdd48a71f1f4566ab35facdb35" :authors '(("Harley Gorrell" . "harley@panix.com")) :maintainer '("Joe Bloggs" . "vapniks@yahoo.com") :keywords '("unix") :url "https://github.com/vapniks/syslog-mode") |
||||
@ -0,0 +1,869 @@ |
|||||
|
;;; syslog-mode.el --- Major-mode for viewing log files |
||||
|
|
||||
|
;; Filename: syslog-mode.el |
||||
|
;; Description: Major-mode for viewing log files |
||||
|
;; Author: Harley Gorrell <harley@panix.com> |
||||
|
;; Maintainer: Joe Bloggs <vapniks@yahoo.com> |
||||
|
;; Created: 2003-03-17 18:50:12 Harley Gorrell |
||||
|
;; URL: https://github.com/vapniks/syslog-mode |
||||
|
;; Package-Version: 2.3 |
||||
|
;; Package-Commit: 18f441bf57dd70cdd48a71f1f4566ab35facdb35 |
||||
|
;; Keywords: unix |
||||
|
;; Compatibility: GNU Emacs 24.3.1 |
||||
|
;; Package-Requires: ((hide-lines "20130623") (ov "20150311")) |
||||
|
;; |
||||
|
;; Features that might be required by this library: |
||||
|
;; |
||||
|
;; hide-lines cl ido dash dired+ ov |
||||
|
;; |
||||
|
|
||||
|
;;; 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. |
||||
|
;; * Fontifys the date and su messages. |
||||
|
|
||||
|
;;; Keybindings |
||||
|
;; "C-down" : syslog-boot-start |
||||
|
;; "R" : revert-buffer |
||||
|
;; "/" : syslog-filter-lines |
||||
|
;; "g" : hide-lines-show-all |
||||
|
;; "h r" : highlight-regexp |
||||
|
;; "h p" : highlight-phrase |
||||
|
;; "h l" : highlight-lines-matching-regexp |
||||
|
;; "h u" : unhighlight-regexp |
||||
|
;; "C-/" : syslog-filter-dates |
||||
|
;; "D" : open dired buffer in log directory (`syslog-log-file-directory') |
||||
|
;; "j" : ffap |
||||
|
;; "<" : syslog-previous-file |
||||
|
;; ">" : syslog-next-file |
||||
|
;; "o" : syslog-open-files |
||||
|
;; "q" : quit-window |
||||
|
|
||||
|
;;; 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. |
||||
|
;; 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: / |
||||
|
;; `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. |
||||
|
;; Keybinding: M-x syslog-mode |
||||
|
;; `syslog-count-matches' |
||||
|
;; Count strings which match the given pattern. |
||||
|
;; Keybinding: c |
||||
|
;; `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 |
||||
|
;; |
||||
|
;;; 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. |
||||
|
;; `syslog-log-file-directory' |
||||
|
;; The directory in which log files are stored. |
||||
|
;; default = "/var/log/" |
||||
|
|
||||
|
;; 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: |
||||
|
;; |
||||
|
;; 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) |
||||
|
|
||||
|
;;; Code: |
||||
|
|
||||
|
;; Setup |
||||
|
(defgroup syslog nil |
||||
|
"syslog-mode - a major mode for viewing log files" |
||||
|
:link '(url-link "https://github.com/vapniks/syslog-mode")) |
||||
|
|
||||
|
(defcustom syslog-mode-hook nil |
||||
|
"*Hook to setup `syslog-mode'." |
||||
|
:group 'syslog |
||||
|
:type 'hook) |
||||
|
|
||||
|
(defvar syslog-mode-load-hook nil |
||||
|
"*Hook to run when `syslog-mode' is loaded.") |
||||
|
|
||||
|
;;;###autoload |
||||
|
(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. |
||||
|
(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 "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 "k" 'hide-lines-kill-hidden) |
||||
|
(define-key map "W" 'syslog-whois-reverse-lookup) |
||||
|
(define-key map "q" 'quit-window) |
||||
|
(define-key map "!" 'syslog-shell-command) |
||||
|
(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'.") |
||||
|
|
||||
|
(defvar syslog-number-suffix-start 1 |
||||
|
"The first number used as rotation suffix.") |
||||
|
|
||||
|
(defun syslog-shell-command (command &optional sudop) |
||||
|
"Execute a shell COMMAND synchronously, with prefix arg (SUDOP) run under sudo." |
||||
|
(interactive (list (read-shell-command (if current-prefix-arg |
||||
|
"Shell command (root): " |
||||
|
"Shell command: ")) |
||||
|
current-prefix-arg)) |
||||
|
(if sudop |
||||
|
(with-temp-buffer |
||||
|
(cd (concat "/sudo::" |
||||
|
(replace-regexp-in-string |
||||
|
"^/sudo[^/]+" "" default-directory))) |
||||
|
(shell-command command)) |
||||
|
(shell-command command))) |
||||
|
|
||||
|
(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))) |
||||
|
|
||||
|
(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))) |
||||
|
|
||||
|
(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))))))) |
||||
|
|
||||
|
(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)))))) |
||||
|
|
||||
|
(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 |
||||
|
(substring (cl-loop for file in basenames2 |
||||
|
for files = (cl-remove-if-not |
||||
|
(lambda (x) (string-match-p (regexp-opt (list 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)))) |
||||
|
|
||||
|
(defun syslog-open-files (files &optional label) |
||||
|
"Insert log FILES into new 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 |
||||
|
(defun syslog-view (files &optional label 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))) |
||||
|
(if files (syslog-open-files (syslog-get-filenames files) label)) |
||||
|
(if (not (eq major-mode 'syslog-mode)) |
||||
|
(error "Not in syslog-mode") |
||||
|
(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)))))) |
||||
|
|
||||
|
(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)))) |
||||
|
|
||||
|
(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)) |
||||
|
|
||||
|
(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))))) |
||||
|
|
||||
|
(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))))) |
||||
|
|
||||
|
(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)) |
||||
|
|
||||
|
(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 |
||||
|
(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"))))) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(defcustom syslog-views nil |
||||
|
"A list of views. |
||||
|
If regexps matching end lines are left blank then lines will be filtered instead of blocks (see `syslog-filter-lines')." |
||||
|
:group 'syslog |
||||
|
:type '(repeat (list (string :tag "Name") |
||||
|
(repeat (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)) |
||||
|
(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 (cons (regexp :tag "Regexp to highlight") |
||||
|
(face :tag "Face"))) |
||||
|
(string :tag "Buffer name")))) |
||||
|
|
||||
|
(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) |
||||
|
|
||||
|
(defcustom syslog-log-file-directory "/var/log/" |
||||
|
"The directory in which log files are stored." |
||||
|
:group 'syslog |
||||
|
:type 'directory) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(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 |
||||
|
(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)) |
||||
|
(setq dodelete nil)) |
||||
|
((not (or keeptime dodelete)) |
||||
|
(setq dodelete t start-position (point-at-bol)))) |
||||
|
(setq pos (re-search-forward syslog-datetime-regexp nil t) |
||||
|
keeptime (funcall intime-p (syslog-date-to-time (match-string 1) t)))) |
||||
|
(if dodelete (hide-lines-add-overlay start-position (point-max)))))) |
||||
|
|
||||
|
;;;###autoload |
||||
|
(defun syslog-mode () |
||||
|
"Major mode for working with system logs. |
||||
|
|
||||
|
\\{syslog-mode-map}" |
||||
|
(interactive) |
||||
|
(kill-all-local-variables) |
||||
|
(setq mode-name "syslog") |
||||
|
(setq major-mode 'syslog-mode) |
||||
|
(use-local-map syslog-mode-map) |
||||
|
;; Menu definition |
||||
|
(easy-menu-define nil syslog-mode-map "test" |
||||
|
`("Syslog" |
||||
|
["Quit" quit-window :help "Quit and bury this buffer" :key "q"] |
||||
|
["Revert buffer" revert-buffer :help "View the function at point" :key "R"] |
||||
|
["Show all" hide-lines-show-all :help "Show all hidden lines/blocks" :key "g"] |
||||
|
["Filter lines..." syslog-filter-lines :help "Show/hide blocks of text between matching regexps" :key "/"] |
||||
|
["Filter dates..." syslog-filter-dates :help "Show/hide lines between start and end dates" :key "C-/"] |
||||
|
["Kill hidden" hide-lines-kill-hidden :help "Kill (with prefix delete) hidden lines" :key "k"] |
||||
|
["Jump to boot start" syslog-boot-start :help "Jump forward in the log to when the system booted" :key "<C-down>"] |
||||
|
["Open previous log file" syslog-previous-file :help "Open previous logfile backup" :key "<"] |
||||
|
["Open next log file" syslog-next-file :help "Open next logfile backup" :key ">"] |
||||
|
["Move to previous log file" syslog-move-previous-file :help "Move to previous logfile in buffer" :key "<M-up>"] |
||||
|
["Move to next log file" syslog-move-next-file :help "Move to next logfile in buffer" :key "<M-down>"] |
||||
|
["Open log files..." syslog-open-files :help "Insert log files into new buffer" :key "o"] |
||||
|
["Append files..." syslog-append-files :help "Append files into current buffer" :key "a"] |
||||
|
["Prepend files..." syslog-prepend-files :help "Prepend files into current buffer" :key "p"] |
||||
|
["Toggle filenames" syslog-toggle-filenames :help "Toggle display of filenames" :key "t"] |
||||
|
["Find file at point" ffap :help "Find file at point" :key "f"] |
||||
|
["Whois" syslog-whois-reverse-lookup :help "Perform whois lookup on hostname at point" :key "W"] |
||||
|
["Count matches" syslog-count-matches :help "Count strings which match the given pattern" :key "c"] |
||||
|
["Dired" (lambda nil (interactive) (dired syslog-log-file-directory)) :help "Enter logfiles directory" :keys "D"] |
||||
|
["Shell command" syslog-shell-command :help "Execute shell command (as root if prefix arg used)" :key "!"] |
||||
|
["Highlight..." (keymap "Highlight" |
||||
|
(regexp menu-item "Regexp" highlight-regexp |
||||
|
:help "Highlight each match of regexp" |
||||
|
:keys "h r") |
||||
|
(phrase menu-item "Phrase" highlight-phrase |
||||
|
:help "Highlight each match of phrase" |
||||
|
:keys "h p") |
||||
|
(lines menu-item "Lines matching regexp" highlight-lines-matching-regexp |
||||
|
:help "Highlight lines containing match of regexp" |
||||
|
:keys "h l") |
||||
|
(unhighlight menu-item "Unhighlight regexp" unhighlight-regexp |
||||
|
:help "Remove highlighting" |
||||
|
:keys "h u"))] |
||||
|
["Open stored view..." syslog-view :help "Open a stored view of syslog files" :key "v"] |
||||
|
["Edit stored views..." (lambda nil (interactive) (customize-variable 'syslog-views)) :help "Customize `syslog-views'"] |
||||
|
["---" "---"])) |
||||
|
;; font locking |
||||
|
(make-local-variable 'font-lock-defaults) |
||||
|
(setq font-lock-defaults '(syslog-font-lock-keywords t t nil )) |
||||
|
(buffer-disable-undo) |
||||
|
(toggle-read-only 1) |
||||
|
(run-hooks 'syslog-mode-hook)) |
||||
|
|
||||
|
(defvar syslog-boot-start-regexp "unix: SunOS" |
||||
|
"Regexp to match the first line of boot sequence.") |
||||
|
|
||||
|
(defun syslog-count-matches (regexp) |
||||
|
"Count strings which match the given pattern." |
||||
|
(interactive (list (read-regexp "How many matches for regexp" |
||||
|
(symbol-name (symbol-at-point))))) |
||||
|
(message "%s occurrences" (count-matches regexp |
||||
|
(point-min) |
||||
|
(point-max) nil))) |
||||
|
|
||||
|
(defun syslog-boot-start () |
||||
|
"Jump forward in the log to when the system booted." |
||||
|
(interactive) |
||||
|
(search-forward-regexp syslog-boot-start-regexp (point-max) t) |
||||
|
(beginning-of-line)) |
||||
|
|
||||
|
(defun syslog-whois-reverse-lookup (arg search-string) |
||||
|
"This is a wrapper around the `whois' command using symbol at point as default search string. |
||||
|
Also `whois-server-name' is set to `whois-reverse-lookup-server'. |
||||
|
The ARG and SEARCH-STRING arguments are the same as for `whois'." |
||||
|
(interactive (list current-prefix-arg |
||||
|
(let* ((symb (symbol-at-point)) |
||||
|
(default (replace-regexp-in-string ":[0-9]+$" "" (symbol-name symb)))) |
||||
|
(read-string (if symb (concat "Whois (default " default "): ") |
||||
|
"Whois: ") nil nil default)))) |
||||
|
(let ((whois-server-name whois-reverse-lookup-server)) |
||||
|
(whois arg search-string))) |
||||
|
|
||||
|
(defface syslog-ip |
||||
|
'((t :underline t :slant italic :weight bold)) |
||||
|
"Face for IPs" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-file |
||||
|
(list (list t :weight 'bold |
||||
|
:inherit (if (facep 'diredp-file-name) |
||||
|
'diredp-file-name |
||||
|
'dired-ignored))) |
||||
|
"Face for filenames" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-hour |
||||
|
'((t :weight bold :inherit font-lock-type-face)) |
||||
|
"Face for hours" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-error |
||||
|
'((t :weight bold :foreground "red")) |
||||
|
"Face for errors" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-warn |
||||
|
'((t :weight bold :foreground "goldenrod")) |
||||
|
"Face for warnings" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-info |
||||
|
'((t :weight bold :foreground "deep sky blue")) |
||||
|
"Face for info lines" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-debug |
||||
|
'((t :weight bold :foreground "medium spring green")) |
||||
|
"Face for debug lines" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-su |
||||
|
'((t :weight bold :foreground "firebrick")) |
||||
|
"Face for su and sudo" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
(defface syslog-hide |
||||
|
'((t :foreground "black" :background "black")) |
||||
|
"Face for hiding text" |
||||
|
:group 'syslog) |
||||
|
|
||||
|
;; Keywords |
||||
|
;; TODO: Seperate the keywords into a list for each format, rather than one for all. |
||||
|
;; Better matching of dates (even when not at beginning of line). |
||||
|
(defvar syslog-font-lock-keywords |
||||
|
'(("\"[^\"]*\"" . 'font-lock-string-face) |
||||
|
("'[^']*'" . 'font-lock-string-face) |
||||
|
;; Filename at beginning of line |
||||
|
("^\\([^ :]+\\): " 1 'syslog-file append) |
||||
|
;; Hours: 17:36:00 |
||||
|
("\\(?:^\\|[[:space:]]\\)\\([[:digit:]]\\{1,2\\}:[[:digit:]]\\{1,2\\}\\(:[[:digit:]]\\{1,2\\}\\)?\\)\\(?:$\\|[[:space:]]\\)" 1 'syslog-hour append) |
||||
|
;; Date |
||||
|
("\\(?:^\\|[[:space:]]\\)\\([[:digit:]]\\{1,2\\}/[[:digit:]]\\{1,2\\}/[[:digit:]]\\{2,4\\}\\)\\(?:$\\|[[:space:]]\\)" 1 'syslog-hour append) |
||||
|
;; Dates: May 9 15:52:34 |
||||
|
("^\\(?:[^ :]+: \\)?\\(\\(?:[[:alpha:]]\\{3\\}\\)?[[:space:]]*[[:alpha:]]\\{3\\}\\s-+[0-9]+\\s-+[0-9:]+\\)" 1 'font-lock-type-face t) |
||||
|
;; Su events |
||||
|
("\\(su:.*$\\)" 1 'syslog-su t) |
||||
|
("\\(sudo:.*$\\)" 1 'syslog-su t) |
||||
|
("\\[[^]]*\\]" . 'font-lock-comment-face) |
||||
|
;; IPs |
||||
|
("[[:digit:]]\\{1,3\\}\\.[[:digit:]]\\{1,3\\}\\.[[:digit:]]\\{1,3\\}\\.[[:digit:]]\\{1,3\\}" 0 'syslog-ip append) |
||||
|
("\\<[Ee][Rr][Rr]\\(?:[Oo][Rr][Ss]?\\)?\\>" 0 'syslog-error append) |
||||
|
("\\<[Ii][Nn][Ff][Oo]\\>" 0 'syslog-info append) |
||||
|
("\\<[Cc][Rr][Ii][Tt][Ii][Cc][Aa][Ll]\\>" 0 'syslog-error append) |
||||
|
("STARTUP" 0 'syslog-info append) |
||||
|
("CMD" 0 'syslog-info append) |
||||
|
("\\<[Ww][Aa][Rr][Nn]\\(?:[Ii][Nn][Gg]\\)?\\>" 0 'syslog-warn append) |
||||
|
("\\<[Dd][Ee][Bb][Uu][Gg]\\>" 0 'syslog-debug append) |
||||
|
("(EE)" 0 'syslog-error append) |
||||
|
("(WW)" 0 'syslog-warn append) |
||||
|
("(II)" 0 'syslog-info append) |
||||
|
("(NI)" 0 'syslog-warn append) |
||||
|
("(!!)" 0 'syslog-debug append) |
||||
|
("(--)" 0 'syslog-debug append) |
||||
|
("(\\*\\*)" 0 'syslog-debug append) |
||||
|
("(==)" 0 'syslog-debug append) |
||||
|
("(\\+\\+)" 0 'syslog-debug append)) |
||||
|
"Expressions to hilight in `syslog-mode'.") |
||||
|
|
||||
|
;;; Setup functions |
||||
|
(defun syslog-find-file-func () |
||||
|
"Invoke `syslog-mode' if the buffer appears to be a system logfile. |
||||
|
and another mode is not active. |
||||
|
This function is added to `find-file-hooks'." |
||||
|
(if (and (eq major-mode 'fundamental-mode) |
||||
|
(looking-at syslog-sequence-start-regexp)) |
||||
|
(syslog-mode))) |
||||
|
|
||||
|
(defun syslog-add-hooks () |
||||
|
"Add a default set of syslog-hooks. |
||||
|
These hooks will activate `syslog-mode' when visiting a file |
||||
|
which has a syslog-like name (.fasta or .gb) or whose contents |
||||
|
looks like syslog. It will also turn enable fontification for `syslog-mode'." |
||||
|
;; (add-hook 'find-file-hooks 'syslog-find-file-func) |
||||
|
(add-to-list 'auto-mode-alist |
||||
|
'("\\(messages\\(\\.[0-9]\\)?\\|SYSLOG\\)\\'" . syslog-mode))) |
||||
|
|
||||
|
;; Setup hooks on request when this mode is loaded. |
||||
|
(if syslog-setup-on-load (syslog-add-hooks)) |
||||
|
|
||||
|
;; done loading |
||||
|
(run-hooks 'syslog-mode-load-hook) |
||||
|
|
||||
|
(provide 'syslog-mode) |
||||
|
|
||||
|
;;; syslog-mode.el ends here |
||||
|
|
||||
|
;;; (magit-push) |
||||
|
;;; (yaoddmuse-post "EmacsWiki" "syslog-mode.el" (buffer-name) (buffer-string) "update") |
||||
Write
Preview
Loading…
Cancel
Save
Reference in new issue