branch: elpa/logview
commit 619dee5c9766490bd2389c1dedbd35fb7c173e3c
Author: Paul Pogonyshev <pogonys...@gmail.com>
Commit: Paul Pogonyshev <pogonys...@gmail.com>
Initial commit.
---
.gitignore | 1 +
README.md | 105 +++++
logview.el | 1422 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 1528 insertions(+)
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..c531d9867f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.elc
diff --git a/README.md b/README.md
new file mode 100644
index 0000000000..834cb8642e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,105 @@
+# Logview mode
+
+Logview major mode for Emacs provides syntax highlighting, filtering
+and other features for various log files. The main target are files
+similar to ones generated by Log4j, Logback and other Java logging
+libraries, but there is really nothing Java-specific in the mode and
+it should work just fine with any log that follows similar structure,
+probably after some configuration.
+
+The mode is meant to be operated in read-only buffer, so all the
+command bindings lack modifiers.
+
+Out-of-the-box the mode should be able to parse standard SLF4J (Log4j,
+Logback) files as long as they use ISO 8601 timestamps.
+
+
+### Submodes
+
+Since there is no standard log file format, Logview mode has to try
+and guess how the log file it operates on is formatted. It does so by
+trying to parse the very first line of the file against various
+submodes it has.
+
+If it succeeds in guessing, you will see major mode specifed as
+‘Logview/...’ in the modeline, where the second part is the submode
+name. In case it fails, you will see it complain in the echo area and
+the buffer will not be highlighted.
+
+#### What to do if Logview mode fails to guess format
+
+Currently your only option is to customize the mode. You will want to
+add some entries to either ‘Additional Level Mappings’, ‘Additional
+Submodes’, ‘Additional Timestamp Formats’, or maybe to all three.
+
+All these variables are well-documented in customization interface.
+
+
+### Commands
+
+Nearly all commands have some use for prefix argument. It can be
+usually just guessed, but you can always check individual command
+documentation within Emacs.
+
+#### Movement
+
+* All standard Emacs commands
+* Move to the beginning of entry’s message: `TAB`
+* Move to next / previous entry: `n` / `p`
+* Move to next / previous ‘as important’ [*] entry: `N` / `P`
+* Move to first / last entry: `<` / `>`
+
+[*] ‘As important’ means entries with the same or higher level. For
+ example, if the current entry is a warning, ‘as important’ include
+ errors and warnings.
+
+#### Narrowing and widening
+
+* Narrow from / up to current entry: `[` / `]`
+* Widen: `w`
+* Widen upwards / downwards only: `{` / `}`
+
+#### Filtering by entry level
+
+* Show only errors: `l 1` or `l e`
+* Show errors and warnings: `l 2` or `l w`
+* Show errors, warnings and information: `l 3` or `l i`
+* Show all levels except trace: `l 4` or `l d`
+* Show entries of all levels: `l 5` or `l t`
+* Show entries ‘as important’ as current one: `+` or `l +`
+
+#### Filtering by entry’s logger name or thread
+
+* Add name include / exclude filter: `a` / `A`
+* Add thread include / exclude filter: `t` / `T`
+
+#### Resetting filters
+
+* Reset level filter: `r l`
+* Reset name filters: `r a`
+* Reset thread filters: `r t`
+* Reset all filters: `R`
+* Reset all filters, widen and show all explicitly hidden entries: `r e`
+
+#### Explicitly hide or show individual entries
+
+* Hide one entry: `h`
+* Hide entries in the region: `H`
+* Show some explicitly hidden entries: `s`
+* Show explicitly hidden entries in the region: `S`
+
+In Transient Mark mode `h` and `s` operate on region when mark is
+active.
+
+#### Change options for current buffer
+
+This options can be customized globally and additionally temporarily
+changed in each individual buffer.
+
+* Toggle ‘copy only visible text’: `o v`
+* Toggle ‘show ellipses’: `o e`
+
+#### Miscellaneous
+
+* Bury buffer: `q`
+* Universal prefix commands are bound within modifiers: `u`, `-`, `0`..`9`
diff --git a/logview.el b/logview.el
new file mode 100644
index 0000000000..781d24b3b5
--- /dev/null
+++ b/logview.el
@@ -0,0 +1,1422 @@
+;;; logview.el --- Major mode for viewing log files -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Paul Pogonyshev
+
+;; Author: Paul Pogonyshev <pogonys...@gmail.com>
+;; Maintainer: Paul Pogonyshev <pogonys...@gmail.com>
+;; Version: 0.1
+;; Keywords: files, tools
+;; Homepage: https://github.com/doublep/logview
+;; Package-Requires: ((emacs "24.5"))
+
+;; 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. If not, see http://www.gnu.org/licenses.
+
+
+;;; Commentary:
+
+;; Logview mode provides syntax highlighting, filtering and other
+;; features for various log files. The main target are files similar
+;; to ones generated by Log4j, Logback and other Java logging
+;; libraries, but there is really nothing Java-specific in the mode
+;; and it should work just fine with any log that follows similar
+;; structure, probably after some configuration.
+
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+;;;###autoload
+(add-to-list 'auto-mode-alist '("\\.log\\(?:\\.[0-9]+\\)?\\'" . logview-mode))
+
+
+
+;;; Customization.
+
+(defgroup logview nil
+ "Log viewing mode."
+ :group 'text)
+
+
+(defcustom logview-additional-submodes nil
+ "Association list of log submodes (file parsing rules).
+
+A few common submodes are already defined by the mode in variable
+`logview-std-submodes', but the ones you add here always take
+precedence.
+
+Submode definition has one required and several optional fields:
+
+format
+
+ The only mandatory and the most important field that defines
+ how log entries are built from pieces. There are currently
+ four such supported pieces: \"TIMESTAMP\", \"LEVEL\", \"NAME\"
+ and \"THREAD\". All four are optional. For example, Log4j,
+ by default formats entries according to this pattern:
+
+ TIMESTAMP [THREAD] LEVEL NAME -
+
+levels [may be optional]
+
+ Level mapping (see `logview-additional-level-mappings') used
+ for this submode. This field is optional only if the submode
+ lacks levels altogether.
+
+ There are some predefined values valid for this field:
+ \"SLF4J\" (and its alises \"Log4j\", \"Log4j2\", \"Logback\"
+ and \"JUL\". See variable `logview-std-level-mappings' for
+ details.
+
+timestamp [optional]
+
+ If set, must be a list of timestamp format names to try (see
+ `logview-additional-timestamp-formats'). If not set or
+ empty, all defined timestamp formats will be tried.
+
+aliases [optional]
+
+ Submode can have any number of optional aliases, which work just
+ as the name."
+ :group 'logview
+ :type '(repeat (cons (string :tag "Name")
+ (list :tag "Definition"
+ (cons :tag "" (const :tag "Format:" format)
string)
+ (set :inline t
+ (cons :tag "" (const :tag "Level map:"
levels) string)
+ (cons :tag "" (const :tag "Timestamp:"
timestamp) (repeat string))
+ (cons :tag "" (const :tag "Aliases:"
aliases) (repeat string)))))))
+
+(defcustom logview-additional-level-mappings nil
+ "Association list of log level mappings.
+
+A few common maps are already defined by the mode in variable
+`logview-std-level-mappings', but the ones you add here always
+take precedence.
+
+Each mapping has a name, by which it is referred from submode
+definition. Mapping itself consists of five lists of strings:
+error levels, warning levels, information levels, debug levels
+and trace levels. In these lists you should add all possible
+real levels that can appear in log file, in descending order of
+severity.
+
+For example, for Java SLF4J (Log4j, Logback, etc.) the mapping
+looks like this:
+
+ Error levels: ERROR
+ Warning levels: WARN
+ Information levels: INFO
+ Trace levels: TRACE
+ Debug levels: DEBUG
+
+This is not a coincidence, as the mode is primarily targeted at
+SLF4J log files.
+
+However, mapping for JUL (java.util.logging) framework looks more
+complicated:
+
+ Error levels: SEVERE
+ Warning levels: WARNING
+ Information levels: INFO
+ Trace levels: CONFIG, FINE
+ Debug levels: FINER, FINEST
+
+JUL has seven severity levels and we need to map them to five the
+mode supports. So the last two lists contain two levels each.
+It is also legal to have empty lists, usually if there are less
+than five levels.
+
+Mapping can have any number of optional aliases, which work just
+as the name."
+ :group 'logview
+ :type '(repeat (cons (string :tag "Name")
+ (list :tag "Definition"
+ (cons :tag "" (const :tag "Error levels:"
error) (repeat string))
+ (cons :tag "" (const :tag "Warning levels:"
warning) (repeat string))
+ (cons :tag "" (const :tag "Information levels:"
information) (repeat string))
+ (cons :tag "" (const :tag "Debug levels:"
debug) (repeat string))
+ (cons :tag "" (const :tag "Trace levels:"
trace) (repeat string))
+ (set :inline t
+ (cons :tag "" (const :tag "Aliases:"
aliases) (repeat string)))))))
+
+(defcustom logview-additional-timestamp-formats nil
+ "Association list of additional timestamp formats.
+
+A few common formats are already defined by the mode in variable
+`logview-std-timestamp-formats', but the ones you add here always
+take precedence.
+
+Each format has a name, by which it can be referred from submode
+definition. A format is defined simply by a regular expression
+timestamp must match. It is strongly recommended to make the
+expression as strict as possible to avoid false positives. For
+example, if you entered something like \"\\w+\" as an expression,
+this would often lead to Logview mode autoselecting wrong submode
+and thus parsing log files incorrectly.
+
+Timestamp format can have any number of optional aliases, which
+work just as the name."
+ :group 'logview
+ :type '(repeat (cons (string :tag "Name")
+ (list :tag "Definition"
+ (cons :tag "" (const :tag "Format:" regexp)
regexp)
+ (set :inline t
+ (cons :tag "" (const :tag "Aliases:"
aliases) (repeat string)))))))
+
+
+(defcustom logview-copy-visible-text-only t
+ "Whether to copy, kill, etc. only visible selected text.
+Standard Emacs behavior is to copy even invisible text, but that
+typically doesn't make much sense with filtering.
+
+You can temporarily change this on per-buffer basis using
+`logview-toggle-copy-visible-text-only' command (normally bound
+to o v)."
+ :group 'logview
+ :type 'boolean)
+
+(defcustom logview-show-ellipses t
+ "Whether to show ellipses to indicate hidden log entries.
+
+You can temporarily change this on per-buffer basis using
+`logview-toggle-show-ellipses' command (normally bound to o e)."
+ :group 'logview
+ :type 'boolean)
+
+
+(defgroup logview-faces nil
+ "Faces for Logview mode."
+ :group 'logview)
+
+(defface logview-level-error
+ '((t :inherit error))
+ "Face to use for error level strings.")
+
+(defface logview-error-entry
+ '((((background dark))
+ :background "#600000")
+ (t
+ :background "#ffe0e0"))
+ "Face to use for error log entries."
+ :group 'logview-faces)
+
+(defface logview-level-warning
+ '((t :inherit warning))
+ "Face to use for warning level strings."
+ :group 'logview-faces)
+
+(defface logview-warning-entry
+ '((((background dark))
+ :background "#606000")
+ (t
+ :background "#ffffe0"))
+ "Face to use for warning log entries."
+ :group 'logview-faces)
+
+(defface logview-level-information
+ '((t :inherit success))
+ "Face to use for information level strings."
+ :group 'logview-faces)
+
+(defface logview-information-entry
+ '((((background dark))
+ :background "#004000")
+ (t
+ :background "#f8fff8"))
+ "Face to use for information log entries."
+ :group 'logview-faces)
+
+(defface logview-level-debug
+ nil
+ "Face to use for debug level strings."
+ :group 'logview-faces)
+
+(defface logview-debug-entry
+ nil
+ "Face to use for debug log entries."
+ :group 'logview-faces)
+
+(defface logview-level-trace
+ '((t :inherit shadow))
+ "Face to use for trace level strings."
+ :group 'logview-faces)
+
+(defface logview-trace-entry
+ '((((background dark))
+ :background "#404040")
+ (t
+ :background "#f4f4f4"))
+ "Face to use for trace log entries."
+ :group 'logview-faces)
+
+(defface logview-timestamp
+ '((t :inherit font-lock-builtin-face))
+ "Face to use for log entry timestamp."
+ :group 'logview-faces)
+
+(defface logview-name
+ '((t :inherit font-lock-string-face))
+ "Face to use for logger name."
+ :group 'logview-faces)
+
+(defface logview-thread
+ '((t :inherit font-lock-variable-name-face))
+ "Face to use for logger thread."
+ :group 'logview-faces)
+
+
+
+;;; Public variables.
+
+(defvar logview-std-submodes
+ '(("SLF4J" . ((format . "TIMESTAMP [THREAD] LEVEL NAME - ")
+ (levels . "SLF4J")
+ (aliases . ("Log4j" "Log4j2" "Logback")))))
+ "Alist of standard submodes. This value is used as the
+fallback for customizable `logview-additional-submodes'.")
+
+(defvar logview-std-level-mappings
+ '(("SLF4J" . ((error "ERROR")
+ (warning "WARN")
+ (information "INFO")
+ (debug "DEBUG")
+ (trace "TRACE")
+ (aliases "Log4j" "Log4j2" "Logback")))
+ ("JUL" . ((error "ERROR")
+ (warning "WARNING")
+ (information "INFO")
+ (debug "CONFIG" "FINE")
+ (trace "FINER" "FINEST"))))
+ "Alist of standard mappings of actual log levels to mode's
+final levels. This value is used as the fallback for
+customizable `logview-additional-level-mappings'.")
+
+(defvar logview-std-timestamp-formats
+ '(("ISO 8601 datetime + millis" . (; Silently handle both common decimal
separators (dot and comma).
+ (regexp .
"[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}
[0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}[.,][0-9]\\{3\\}")
+ (aliases . ("yyyy-MM-dd HH:mm:ss.SSS"))))
+ ("ISO 8601 datetime" . ((regexp .
"[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}")
+ (aliases . ("yyyy-MM-dd HH:mm:ss"))))
+ ("ISO 8601 time only + millis" . (; Silently handle both common decimal
separators (dot and comma).
+ (regexp .
"[0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}[.,][0-9]\\{3\\}")
+ (aliases . ("HH:mm:ss.SSS"))))
+ ("ISO 8601 time only" . ((regexp .
"[0-9]\\{2\\}:[0-9]\\{2\\}:[0-9]\\{2\\}")
+ (aliases . ("HH:mm:ss")))))
+ "Alist of standard timestamp formats. This is the fallback for
+customizable `logview-additional-timestamp-formats'.")
+
+
+
+;;; Internal variables and constants.
+
+(defconst logview--timestamp-group 1)
+(defconst logview--level-group 2)
+(defconst logview--name-group 3)
+(defconst logview--thread-group 4)
+
+(defconst logview--final-levels '(error warning information debug trace))
+
+(defconst logview--entry-parts '("TIMESTAMP" "LEVEL" "NAME" "THREAD"))
+(defconst logview--entry-part-regexp (rx (or (group bow "TIMESTAMP" eow)
+ (group bow "LEVEL" eow)
+ (group bow "NAME" eow)
+ (group bow "THREAD" eow))))
+
+
+(defvar logview--entry-regexp)
+(make-variable-buffer-local 'logview--entry-regexp)
+
+(defvar logview--submode-features)
+(make-variable-buffer-local 'logview--submode-features)
+
+(defvar logview--submode-level-alist nil
+ "Submode levels, least to most important, mapped to final
+levels.")
+(make-variable-buffer-local 'logview--submode-level-alist)
+
+(defvar logview--submode-level-data nil
+ "An alist of level string to the following lists:
+- level symbol (for quick filtering);
+- level entry face;
+- level string face.")
+(make-variable-buffer-local 'logview--submode-level-data)
+
+(defvar logview--min-shown-level)
+(make-variable-buffer-local 'logview--min-shown-level)
+
+(defvar logview--as-important-levels)
+(make-variable-buffer-local 'logview--as-important-levels)
+
+(defvar logview--applied-filters '(nil nil nil nil))
+(make-variable-buffer-local 'logview--applied-filters)
+
+(defvar logview--include-name-regexps)
+(make-variable-buffer-local 'logview--include-name-regexps)
+
+(defvar logview--exclude-name-regexps)
+(make-variable-buffer-local 'logview--exclude-name-regexps)
+
+(defvar logview--include-thread-regexps)
+(make-variable-buffer-local 'logview--include-thread-regexps)
+
+(defvar logview--exclude-thread-regexps)
+(make-variable-buffer-local 'logview--exclude-thread-regexps)
+
+(defvar logview--name-regexp-history)
+(defvar logview--thread-regexp-history)
+
+(defvar logview--process-buffer-changes)
+(make-variable-buffer-local 'logview--process-buffer-changes)
+
+
+
+;;; The mode.
+
+(defvar logview-mode-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (binding '(;; Movement commands.
+ ("TAB" logview-go-to-message-beginning)
+ ("n" logview-next-entry)
+ ("p" logview-previous-entry)
+ ("N" logview-next-as-important-entry)
+ ("P" logview-previous-as-important-entry)
+ ("<" logview-first-entry)
+ (">" logview-last-entry)
+ ;; Narrowing/widening commands.
+ ("[" logview-narrow-from-this-entry)
+ ("]" logview-narrow-up-to-this-entry)
+ ("w" widen)
+ ("{" logview-widen-upwards)
+ ("}" logview-widen-downwards)
+ ;; Filtering by level commands.
+ ("l 1" logview-show-only-errors)
+ ("l e" logview-show-only-errors)
+ ("l 2" logview-show-errors-and-warnings)
+ ("l w" logview-show-errors-and-warnings)
+ ("l 3" logview-show-errors-warnings-and-information)
+ ("l i" logview-show-errors-warnings-and-information)
+ ("l 4"
logview-show-errors-warnings-information-and-debug)
+ ("l d"
logview-show-errors-warnings-information-and-debug)
+ ("l 5" logview-show-all-levels)
+ ("l t" logview-show-all-levels)
+ ("+" logview-show-only-as-important)
+ ("l +" logview-show-only-as-important)
+ ;; Filtering by name/thread commands.
+ ("a" logview-add-include-name-filter)
+ ("A" logview-add-exclude-name-filter)
+ ("t" logview-add-include-thread-filter)
+ ("T" logview-add-exclude-thread-filter)
+ ;; Filter resetting commands.
+ ("r l" logview-reset-level-filters)
+ ("r a" logview-reset-name-filters)
+ ("r t" logview-reset-thread-filters)
+ ("R" logview-reset-all-filters)
+ ("r e"
logview-reset-all-filters-restrictions-and-hidings)
+ ;; Explicit entry hiding/showing commands.
+ ("h" logview-hide-entry)
+ ("H" logview-hide-region-entries)
+ ("s" logview-show-entries)
+ ("S" logview-show-region-entries)
+ ;; Option changing commands.
+ ("o v" logview-toggle-copy-visible-text-only)
+ ("o e" logview-toggle-show-ellipses)
+ ;; Miscellaneous commands.
+ ("?" logview-mode-help)
+ ("q" bury-buffer)
+ ;; Simplified universal argument command rebindings.
+ ("u" universal-argument)
+ ("-" negative-argument)
+ ("0" digit-argument)
+ ("1" digit-argument)
+ ("2" digit-argument)
+ ("3" digit-argument)
+ ("4" digit-argument)
+ ("5" digit-argument)
+ ("6" digit-argument)
+ ("7" digit-argument)
+ ("8" digit-argument)
+ ("9" digit-argument)))
+ (define-key map (kbd (car binding)) (cadr binding)))
+ map))
+
+
+;;;###autoload
+(define-derived-mode logview-mode nil "Logview"
+ "Major mode for viewing and filtering various log files."
+ (logview--update-invisibility-spec)
+ (logview--guess-submode)
+ (logview--split-region-into-entries (point-min) (point-max) 'report-progress)
+ (add-hook 'after-change-functions 'logview--split-region-into-entries t t)
+ (read-only-mode 1)
+ (set (make-local-variable 'filter-buffer-substring-function)
'logview--buffer-substring-filter)
+ (add-hook 'change-major-mode-hook 'logview--exiting-mode nil t))
+
+(defun logview--exiting-mode ()
+ ;; Remove custom invisibility property values, as otherwise other
+ ;; modes will show empty buffers. Also remove face property, as we
+ ;; set it ourselves, not through font-lock.
+ (logview--std-matching-and-altering
+ (remove-text-properties 1 (1+ (buffer-size)) '(face nil invisible nil))))
+
+(defun logview--guess-submode ()
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char 1)
+ (end-of-line)
+ (let ((first-line (buffer-substring 1 (point))))
+ (catch 'success
+ (logview--iterate-split-alists (lambda (name definition)
+ (condition-case error
+ (logview--initialize-submode
name definition first-line)
+ (error (warn
(error-message-string error)))))
+ logview-additional-submodes
logview-std-submodes)
+ (message "Logview mode was unable to determine log format; please
consult documentation"))))))
+
+
+
+;;; Movement commands.
+
+(defun logview-go-to-message-beginning (&optional select-message)
+ "Put point at the beginning of the current entry's message.
+
+With prefix argument, additionally put mark at the end of the
+message, which is especially useful for multiline messages. In
+Transient Mark mode also activate the region."
+ (interactive "P")
+ (logview--assert)
+ (let ((case-fold-search nil))
+ (when (logview--match-current-entry)
+ (goto-char (match-end 0))
+ (when select-message
+ (save-excursion
+ (push-mark (logview--linefeed-back (if (equal
(logview--match-successive-entries 1) 0)
+ (match-beginning 0)
+ (point-max)))
+ t t))))))
+
+(defun logview-next-entry (&optional n)
+ "Move point vertically down N (1 by default) log entries.
+
+Point is positioned at the beginning of the message of the
+resulting entry. If log entries are single-line, this is almost
+equal to `next-line'. However, if messages span several lines,
+the function will have significantly different effect."
+ (interactive "p")
+ (logview--assert)
+ (when (/= n 0)
+ (let ((case-fold-search nil)
+ (original-point (point))
+ (remaining (logview--match-successive-entries n t)))
+ (goto-char (if remaining (match-end 0) original-point))
+ (logview--maybe-complain-about-movement n remaining))))
+
+(defun logview-previous-entry (&optional n)
+ "Move point vertically up N (1 by default) log entries.
+
+Point is positioned at the beginning of the message of the
+resulting entry. If log entries are single-line, this is almost
+equal to `next-line'. However, if messages span several lines,
+the function will have significantly different effect."
+ (interactive "p")
+ (logview-next-entry (if n (- n) -1)))
+
+(defun logview-next-as-important-entry (&optional n)
+ "Move point vertically down N 'as important' entries.
+
+Here 'as important' means any entry of level equal or higher than
+that of the current entry. For example, if you start moving from
+a warning, the function will stop on all warnings and errors in
+the buffer, but skip all other 'less important' entries. If the
+last used command is either `logview-next-as-important-entry' or
+`logview-previous-as-important-entry', list of what is considered
+'as important' is kept, otherwise it is recomputed anew.
+
+Point is positioned at the beginning of the message of the
+resulting entry."
+ (interactive "p")
+ (logview--assert 'level)
+ (when (/= n 0)
+ (let ((case-fold-search nil)
+ (original-point (point)))
+ (unless (memq last-command '(logview-next-as-important-entry
logview-previous-as-important-entry))
+ (setq logview--as-important-levels nil)
+ (logview--match-current-entry)
+ (let ((this-level (match-string logview--level-group))
+ (found))
+ (dolist (level-pair logview--submode-level-alist)
+ (unless found
+ (setq found (equal (car level-pair) this-level)))
+ (when found
+ (push (car level-pair) logview--as-important-levels)))))
+ (let ((remaining (logview--match-successive-entries
+ n t (lambda ()
+ (member (match-string logview--level-group)
logview--as-important-levels)))))
+ (goto-char (if remaining (match-end 0) original-point))
+ (logview--maybe-complain-about-movement n remaining t)))))
+
+(defun logview-previous-as-important-entry (&optional n)
+ "Move point vertically up N 'as important' entries.
+
+See function `logview-next-as-important-entry' for definition of
+'as important'.
+
+Point is positioned at the beginning of the message of the
+resulting entry."
+ (interactive "p")
+ (logview-next-as-important-entry (if n (- n) -1)))
+
+(defun logview-first-entry ()
+ "Move point to the first log entry.
+
+Point is positioned at the beginning of the message of the entry.
+Otherwise this function is similar to `beginning-of-buffer'."
+ (interactive)
+ (logview--assert)
+ (unless (region-active-p)
+ (push-mark))
+ (goto-char (point-min))
+ (let ((case-fold-search nil))
+ (when (logview--match-current-entry)
+ (goto-char (match-end 0)))))
+
+(defun logview-last-entry ()
+ "Move point to the last log entry.
+
+Point is positioned at the beginning of the message of the entry.
+If the last entry is multiline, this makes the function quite
+different from `end-of-buffer'."
+ (interactive)
+ (logview--assert)
+ (unless (region-active-p)
+ (push-mark))
+ (goto-char (point-max))
+ (let ((case-fold-search nil))
+ (when (logview--match-current-entry)
+ (goto-char (match-end 0)))))
+
+
+
+;;; Narrowing/widening commands.
+
+(defun logview-narrow-from-this-entry (&optional n)
+ "Narrow the buffer so that previous log entries are hidden.
+
+If invoked interactively with a prefix argument, leave that many
+entries above the current visible after narrowing. Note that as
+an exception to standard numeric prefix value rules, here no
+prefix means zero."
+ (interactive (list (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))))
+ (logview--do-narrow-one-side t n))
+
+(defun logview-narrow-up-to-this-entry (&optional n)
+ "Narrow the buffer so that following log entries are hidden.
+
+If invoked interactively with a prefix argument, leave that many
+entries under the current visible after narrowing. Note that as
+an exception to standard numeric prefix value rules, here no
+prefix means zero."
+ (interactive (list (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))))
+ (logview--do-narrow-one-side nil n))
+
+(defun logview--do-narrow-one-side (upwards n)
+ (logview--assert)
+ (let ((from (point-min))
+ (to (point-max)))
+ (widen)
+ (logview--std-matching
+ (narrow-to-region (if (and upwards (equal
(logview--match-successive-entries (if n (- n) 0) t) 0))
+ (match-beginning 0)
+ from)
+ (if (and (not upwards) (equal
(logview--match-successive-entries (if n (1+ n) 1) t) 0))
+ (match-beginning 0)
+ to)))))
+
+(defun logview-widen-upwards ()
+ "Widen the buffer only upwards, i.e. keep the bottom restriction."
+ (interactive)
+ (let ((to (point-max)))
+ (widen)
+ (narrow-to-region (point-min) to)))
+
+(defun logview-widen-downwards ()
+ "Widen the buffer only downwards, i.e. keep the top restriction."
+ (interactive)
+ (let ((from (point-min)))
+ (widen)
+ (narrow-to-region from (point-max))))
+
+
+
+;;; Filtering by level commands.
+
+(defun logview-show-only-errors ()
+ "Show only error entries."
+ (interactive)
+ (logview--set-min-level (logview--find-min-level 'error)))
+
+(defun logview-show-errors-and-warnings ()
+ "Show only error and warning entries."
+ (interactive)
+ (logview--set-min-level (logview--find-min-level 'warning)))
+
+(defun logview-show-errors-warnings-and-information ()
+ "Show error, warning and information entries."
+ (interactive)
+ (logview--set-min-level (logview--find-min-level 'information)))
+
+(defun logview-show-errors-warnings-information-and-debug ()
+ "Show error, warning, information and debug entries. I.e. all
+entries other than traces."
+ (interactive)
+ (logview--set-min-level (logview--find-min-level 'debug)))
+
+(defun logview-show-all-levels ()
+ "Show entries of all levels. This doesn't cancel other filters
+that might be in effect though."
+ (interactive)
+ (logview--set-min-level (logview--find-min-level 'trace)))
+
+(defun logview-show-only-as-important ()
+ "Show entries 'as important' as the current.
+
+Here 'as important' means any entry of level equal or higher.
+For example, if you invoke this function while current entry is a
+warning, all entries other than warnings and errors will be
+hidden."
+ (interactive)
+ (logview--assert 'level)
+ (logview--std-matching
+ (when (logview--match-current-entry)
+ (logview--set-min-level (match-string logview--level-group)))))
+
+(defun logview--find-min-level (final-level)
+ "Find minimal submode level that maps to given FINAL-LEVEL or higher."
+ (logview--assert 'level)
+ (let ((result)
+ (final-level-index (cl-position final-level logview--final-levels)))
+ (dolist (level-pair logview--submode-level-alist)
+ (when (and (null result) (<= (cl-position (cdr level-pair)
logview--final-levels :test 'equal) final-level-index))
+ (setq result (car level-pair))))
+ result))
+
+(defun logview--set-min-level (min-level)
+ (setq logview--min-shown-level min-level)
+ (logview--update-invisibility-spec))
+
+
+
+;;; Filtering by name/thread commands.
+
+(defun logview-add-include-name-filter ()
+ "Show only log entries with name matching entered regular
+expression. If this command is invoked multiple times, show
+entries with name matching at least one of entered expression."
+ (interactive)
+ (logview--prompt-for-new-filter "Logger name regexp to show entries" 'name
'logview--include-name-regexps))
+
+(defun logview-add-exclude-name-filter ()
+ "Show only log entries with name that doesn't match entered
+regular expression. If this command is invoked multiple times,
+show entries with name that doesn't match any of entered
+expression."
+ (interactive)
+ (logview--prompt-for-new-filter "Logger name regexp to hide entries" 'name
'logview--exclude-name-regexps))
+
+(defun logview-add-include-thread-filter ()
+ "Show only log entries with thread name matching entered
+regular expression. If this command is invoked multiple times,
+show entries with thread name matching at least one of entered
+expression."
+ (interactive)
+ (logview--prompt-for-new-filter "Thread regexp to show entries" 'thread
'logview--include-thread-regexps))
+
+(defun logview-add-exclude-thread-filter ()
+ "Show only log entries with thread name that doesn't match
+entered regular expression. If this command is invoked multiple
+times, show entries with thread name that doesn't match any of
+entered expression."
+ (interactive)
+ (logview--prompt-for-new-filter "Thread regexp to hide entries" 'thread
'logview--exclude-thread-regexps))
+
+(defun logview--prompt-for-new-filter (prompt type filter-list)
+ (logview--assert type)
+ (logview--std-matching
+ (let* ((default-value (when (logview--match-current-entry)
+ (let ((base (regexp-quote (match-string (cdr (assq
type (list (cons 'name logview--name-group)
+
(cons 'thread logview--thread-group))))))))
+ (list base (format "^%s$" base)))))
+ (regexp (read-regexp prompt default-value (cdr (assq type
'((name . logview--name-regexp-history)
+
(thread . logview--thread-regexp-history)))))))
+ (unless (logview--valid-regexp-p regexp)
+ (error "Invalid regular expression"))
+ (set filter-list (cons regexp (symbol-value filter-list)))
+ (logview--apply-filters))))
+
+;; This must have been a standard function.
+(defun logview--valid-regexp-p (regexp)
+ (ignore-errors
+ (string-match regexp "")
+ t))
+
+
+
+;;; Filters resetting commands.
+
+(defun logview-reset-level-filters ()
+ "Reset all level filters.
+
+This is actually the same as `logview-show-all-levels'."
+ (interactive)
+ (logview--assert 'level)
+ (logview-show-all-levels))
+
+(defun logview-reset-name-filters ()
+ "Reset all name filters."
+ (interactive)
+ (logview--assert 'name)
+ (setq logview--include-name-regexps nil
+ logview--exclude-name-regexps nil)
+ (logview--apply-filters))
+
+(defun logview-reset-thread-filters ()
+ "Reset all thread filters."
+ (interactive)
+ (logview--assert 'thread)
+ (setq logview--include-thread-regexps nil
+ logview--exclude-thread-regexps nil)
+ (logview--apply-filters))
+
+(defun logview-reset-all-filters ()
+ "Reset all filters (level, name, thread). After this command
+only explictly hidden entries remain invisible."
+ (interactive)
+ (logview--do-reset-all-filters nil))
+
+(defun logview-reset-all-filters-restrictions-and-hidings ()
+ "Reset all filters, show all explictly hidden entries and
+cancel any narrowing restrictions."
+ (interactive)
+ (widen)
+ (logview--do-reset-all-filters t))
+
+(defun logview--do-reset-all-filters (also-cancel-explicit-hiding)
+ (logview--assert)
+ (when (memq 'level logview--submode-features)
+ (logview-reset-level-filters))
+ (when (or (memq 'name logview--submode-features) (memq 'thread
logview--submode-features) also-cancel-explicit-hiding)
+ (setq logview--include-name-regexps nil
+ logview--exclude-name-regexps nil
+ logview--include-thread-regexps nil
+ logview--exclude-thread-regexps nil)
+ (logview--apply-filters also-cancel-explicit-hiding)))
+
+
+
+;;; Explicit entry hiding/showing commands.
+
+(defun logview-hide-entry (&optional n)
+ "Explicitly hide N currently visible entries starting at point.
+If N is negative, hide -N previous entries instead, not including
+the current.
+
+In Transient Mark mode, if the region is active and this command
+is invoked without prefix argument, hide all entries in the
+region instead (i.e. just like `logview-hide-region-entries')."
+ (interactive (list (if (or current-prefix-arg (not (use-region-p)))
+ (prefix-numeric-value current-prefix-arg)
+ 'use-region)))
+ (if (eq n 'use-region)
+ (logview-hide-region-entries (point) (mark))
+ (logview--assert)
+ (logview--std-matching-and-altering
+ (logview--maybe-complain-about-movement
+ n (logview--iterate-successive-entries n (logview--hide-entry-callback
'logview-hidden-entry) t) 0))))
+
+(defun logview-hide-region-entries (begin end)
+ "Explicitly hide all log entries that are fully or partially in
+the region.
+
+Note that this includes entries that are currently hidden due to
+filtering too. If you later cancel filtering, all entries in the
+region will remain hidden until you also cancel the explicit
+hiding."
+ (interactive "r")
+ (logview--assert)
+ (logview--std-matching-and-altering
+ (logview--iterate-entries-in-region begin end
(logview--hide-entry-callback 'logview-hidden-entry))) )
+
+(defun logview-show-entries (&optional n)
+ "Show explicitly hidden entries between the current entry and
+N'th after it (or before it if N is negative).
+
+In Transient Mark mode, if the region is active and this command
+is invoked without prefix argument, show explicitly hidden
+entries in the region instead (i.e. work just like
+`logview-show-region-entries')."
+ (interactive (list (if (or current-prefix-arg (not (use-region-p)))
+ (prefix-numeric-value current-prefix-arg)
+ 'use-region)))
+ (if (eq n 'use-region)
+ (logview-show-region-entries (point) (mark))
+ (logview--assert)
+ ;; Much like 'logview--iterate-successive-entries', but because of
+ ;; peculiar semantics, not broken out into its own function.
+ (when (/= n 0)
+ (save-excursion
+ (logview--std-matching-and-altering
+ (let ((direction (cl-signum n))
+ (shower (logview--show-entry-callback
'logview-hidden-entry)))
+ (funcall (if (< n 0)
+ 'logview--iterate-entries-backward
+ ;; To "not count" the current entry.
+ (setq n (1+ n))
+ 'logview--iterate-entries-forward)
+ (lambda (begin after-first-line entry-end)
+ (if (invisible-p begin)
+ (progn
+ (funcall shower begin after-first-line entry-end)
+ t)
+ (/= (setq n (- n direction)) 0))))))))
+ (logview--maybe-complain-about-movement n n)))
+
+(defun logview-show-region-entries (begin end)
+ (interactive "r")
+ (logview--assert)
+ (logview--std-matching-and-altering
+ (logview--iterate-entries-in-region begin end
(logview--show-entry-callback 'logview-hidden-entry))) )
+
+
+
+;;; Option changing commands.
+
+(defun logview-toggle-copy-visible-text-only (&optional arg)
+ "Toggle `logview-copy-visible-text-only' just for this buffer.
+
+If invoked with prefix argument, enable the option if the
+argument is positive, disable it otherwise."
+ (interactive (list (or current-prefix-arg 'toggle)))
+ (logview--toggle-option-locally 'logview-copy-visible-text-only arg
(called-interactively-p 'interactive)
+ "Will copy only visible text now"
+ "Copying commands will behave as in the rest
of Emacs"))
+
+(defun logview-toggle-show-ellipses (&optional arg)
+ "Toggle `logview-show-ellipses' just for this buffer.
+
+If invoked with prefix argument, enable the option if the
+argument is positive, disable it otherwise."
+ (interactive (list (or current-prefix-arg 'toggle)))
+ (logview--toggle-option-locally 'logview-show-ellipses arg
(called-interactively-p 'interactive)
+ "Showing ellipses to indicate hidden log
entries"
+ "Hidden log entries are completely
invisible")
+ (logview--update-invisibility-spec))
+
+(defun logview--toggle-option-locally (variable arg &optional show-message
message-if-true message-if-false)
+ (set (make-local-variable variable)
+ (if (eq arg 'toggle)
+ (not (symbol-value variable))
+ (> (prefix-numeric-value arg) 0)))
+ (when show-message
+ (message (if (symbol-value variable) message-if-true message-if-false))))
+
+
+
+;;; Miscellaneous commands.
+
+(defun logview-mode-help ()
+ (interactive)
+ )
+
+
+
+;;; Internal functions (except helpers for specific command groups).
+
+(defun logview--initialize-submode (name definition test-line)
+ (let* ((format (cdr (assq 'format definition)))
+ (timestamp (cdr (assq 'timestamp definition))))
+ (unless (and (stringp format) (> (length format) 0))
+ (error "Invalid submode '%s': no format string" name))
+ (catch 'failed
+ (if timestamp
+ (dolist (name timestamp)
+ (logview--try-initialize-submode name definition format
+ (logview--get-split-alists name
"timestamp format"
+
logview-additional-timestamp-formats logview-std-timestamp-formats)
+ test-line))
+ (logview--iterate-split-alists (lambda (_timestamp-name timestamp)
+ (logview--try-initialize-submode name
definition format timestamp test-line))
+ logview-additional-timestamp-formats
logview-std-timestamp-formats)))))
+
+(defun logview--try-initialize-submode (name submode format timestamp
test-line)
+ (let* ((search-from 0)
+ (next)
+ (end)
+ (terminator)
+ (levels)
+ (parts '("^"))
+ (features)
+ (add-text-part (lambda (from to)
+ (push (replace-regexp-in-string "[ \t]+" "[ \t]+"
(regexp-quote (substring format from to))) parts))))
+ (while (setq next (string-match logview--entry-part-regexp format
search-from))
+ (when (> next search-from)
+ (funcall add-text-part search-from next))
+ (setq end (match-end 0)
+ terminator (when (< end (length format))
+ (aref format end)))
+ (cond ((match-beginning logview--timestamp-group)
+ (push (format "\\(?%d:%s\\)" logview--timestamp-group (cdr (assq
'regexp timestamp))) parts)
+ (push 'timestamp features))
+ ((match-beginning logview--level-group)
+ (setq levels (logview--get-split-alists (cdr (assq 'levels
submode)) "level mapping"
+
logview-additional-level-mappings logview-std-level-mappings))
+ (push (format "\\(?%d:%s\\)" logview--level-group
+ (regexp-opt (apply 'append (mapcar (lambda
(final-level) (cdr (assq final-level levels)))
+
logview--final-levels))))
+ parts)
+ (push 'level features))
+ (t
+ (dolist (k (list logview--name-group logview--thread-group))
+ (when (match-beginning k)
+ (push (format "\\(?%d:%s*\\)" k (cond ((and terminator (/=
terminator ? ))
+ (format "[^%c]*"
terminator))
+ (terminator
+ "[^ \t]+")
+ (t
+ ".+")))
+ parts)
+ (push (if (= k logview--name-group) 'name 'thread)
features)))))
+ (setq search-from end))
+ (when (< search-from (length format))
+ (funcall add-text-part search-from nil))
+ (let ((regexp (apply 'concat (reverse parts))))
+ (if (string-match regexp test-line)
+ (progn
+ (setq logview--process-buffer-changes t
+ logview--entry-regexp regexp
+ logview--submode-features features
+ logview--submode-level-alist nil
+ mode-name (format "Logview/%s" name))
+ (when (memq 'level features)
+ (dolist (final-level logview--final-levels)
+ (dolist (level (cdr (assoc final-level levels)))
+ (setq logview--submode-level-alist (cons (cons level
final-level) logview--submode-level-alist))
+ (push (cons level (list (make-symbol level)
+ (intern (format "logview-%s-entry"
(symbol-name final-level)))
+ (intern (format "logview-level-%s"
(symbol-name final-level)))))
+ logview--submode-level-data))))
+ (throw 'success nil))
+ (when (not (memq 'timestamp features))
+ ;; Else we will maybe retry with different timestamp formats.
+ (throw 'failed nil))))))
+
+
+(defun logview--assert (&rest assertions)
+ (unless logview--entry-regexp
+ (error "Logview mode was unable to determine log format; please consult
documentation"))
+ (dolist (assertion assertions)
+ (unless (memq assertion logview--submode-features)
+ (error (cdr (assq assertion '((level . "Log lacks entry levels")
+ (name . "Log lacks logger names")
+ (thread . "Log doesn't include thread
names"))))))))
+
+
+(defun logview--maybe-complain-about-movement (direction remaining &optional
as-important-entries)
+ ;; Using 'equal' since 'remaining' may also be nil.
+ (unless (equal remaining 0)
+ (error (if as-important-entries
+ (if (> direction 0) "No next (visible) as important entry" "No
previous (visible) as important entry")
+ (if (> direction 0) "No next (visible) entry" "No previous
(visible) entry")))))
+
+
+(defmacro logview--std-matching (&rest body)
+ (declare (indent 0) (debug t))
+ `(save-excursion
+ (let ((case-fold-search nil))
+ ,@body)))
+
+(defmacro logview--std-matching-and-altering (&rest body)
+ (declare (indent 0) (debug t))
+ `(save-excursion
+ (let ((logview--process-buffer-changes nil)
+ (case-fold-search nil)
+ (inhibit-read-only t))
+ (with-silent-modifications
+ ,@body))))
+
+
+(defun logview--match-current-entry ()
+ "Match the header of the log entry where the point currently is.
+
+Return value is non-nil on success. Point is either before or
+after the header, i.e. still in the same log entry, but there are
+no more guarantees. Match data is set appropriately for the
+header."
+ (forward-line 0)
+ (or (looking-at logview--entry-regexp)
+ (re-search-backward logview--entry-regexp nil t)
+ (re-search-forward logview--entry-regexp nil t)))
+
+(defun logview--match-successive-entries (n &optional only-visible validator)
+ "Match N entries after (if N is positive) or before (negative)
+the current one. If N is zero, match just the current entry.
+
+If ONLY-VISIBLE is non-nil, hidden entries are skipped. If
+VALIDATOR is non-nil, entries for which the function returns nil
+are skipped too.
+
+Returns the remaining number, i.e. zero if there are enough valid
+entries. If it never found any valid entries, returns nil.
+There is no guarantees about point location after the call, but
+match data will be set for the last valid matched header."
+ (let* ((forward (> n 0))
+ (direction (cl-signum n))
+ (successful-match '(nil)))
+ (when (logview--match-current-entry)
+ (when (or (null validator) (funcall validator))
+ (match-data t successful-match))
+ (when (/= n 0)
+ (while (and (= (forward-line direction) 0)
+ (if forward
+ (re-search-forward logview--entry-regexp nil t)
+ (or (looking-at logview--entry-regexp)
+ (re-search-backward logview--entry-regexp nil t)))
+ (if (or (and only-visible (invisible-p (match-beginning
0)))
+ (and validator (not (funcall validator))))
+ t
+ (match-data t successful-match)
+ (/= (setq n (- n direction)) 0))))))
+ (if (equal successful-match '(nil))
+ nil
+ (set-match-data successful-match)
+ n)))
+
+
+(defun logview--iterate-entries-forward (callback &optional only-visible
validator)
+ "Invoke CALLBACK for successive valid log entries starting at
+point and forward, until it returns nil or end of buffer is
+reached.
+
+CALLBACK is called with three arguments: beginning of the entry,
+end of its first line and its end (the last two are equal unless
+the entry spans multiple lines). CALLBACK may not access match
+data and must make sure point and match data are preserved.
+
+If ONLY-VISIBLE is non-nil, hidden entries are skipped. If
+VALIDATOR is non-nil, entries for which the function returns nil
+are skipped too."
+ (when (logview--match-current-entry)
+ (let ((entry-begin (match-beginning 0))
+ (after-first-line)
+ (entry-end)
+ (limit (point-max))
+ (invalid))
+ (while (progn
+ (setq invalid (or (and only-visible (invisible-p entry-begin))
+ (and validator (not (funcall validator)))))
+ (forward-line)
+ (setq after-first-line (point)
+ entry-end (if (re-search-forward
logview--entry-regexp nil t)
+ (match-beginning 0)
+ limit))
+ (when (or invalid (funcall callback entry-begin
after-first-line entry-end))
+ (/= (setq entry-begin entry-end) limit)))))))
+
+(defun logview--iterate-entries-backward (callback &optional only-visible
validator)
+ "Invoke CALLBACK for successive valid log entries before the
+current entry until it returns nil or beginning of buffer is
+reached.
+
+See `logview--iterate-entries-forward' for details."
+ (when (logview--match-current-entry)
+ (let ((entry-begin (match-beginning 0))
+ (entry-end))
+ (while (and (= (forward-line -1) 0)
+ (or (looking-at logview--entry-regexp)
+ (re-search-backward logview--entry-regexp nil t))
+ (progn
+ (setq entry-end entry-begin
+ entry-begin (match-beginning 0))
+ (or (and only-visible (invisible-p entry-begin))
+ (and validator (not (funcall validator)))
+ (when (funcall callback entry-begin (progn
(forward-line) (point)) entry-end)
+ (goto-char entry-begin)))))))))
+
+(defun logview--iterate-successive-entries (n callback &optional only-visible
validator)
+ (when (/= n 0)
+ (let ((direction (cl-signum n)))
+ (funcall (if (> n 0) 'logview--iterate-entries-forward
'logview--iterate-entries-backward)
+ (lambda (begin after-first-line entry-end)
+ (funcall callback begin after-first-line entry-end)
+ (/= (setq n (- n direction)) 0))
+ only-visible validator)))
+ n)
+
+(defun logview--iterate-entries-in-region (begin end callback &optional
only-visible validator)
+ (goto-char (min begin end))
+ (let ((limit (max begin end)))
+ (logview--iterate-entries-forward (lambda (begin after-first-line end)
+ (funcall callback begin
after-first-line end)
+ (< end limit))
+ only-visible validator)))
+
+
+(defun logview--update-invisibility-spec ()
+ (let ((invisibility-spec '(logview-filtered logview-hidden-entry
logview-hidden-details))
+ (found nil))
+ ;; Initially it's nil.
+ (when logview--min-shown-level
+ (dolist (level-pair logview--submode-level-alist)
+ (when (string= (car level-pair) logview--min-shown-level)
+ (setq found t))
+ (unless found
+ (setq invisibility-spec (cons (nth 0 (cdr (assoc (car level-pair)
logview--submode-level-data))) invisibility-spec)))))
+ (setq buffer-invisibility-spec
+ (if logview-show-ellipses
+ (mapcar (lambda (x) (cons x t)) invisibility-spec)
+ invisibility-spec))
+ ;; This weird looking command was suggested in
+ ;; irc.freenode.net#emacs and seems to force buffer redraw.
+ ;; Otherwise change to 'buffer-invisibility-spec' doesn't have
+ ;; immediate effect here.
+ (force-mode-line-update)))
+
+
+(defun logview--apply-filters (&optional also-cancel-explicit-hiding)
+ (let* ((include-name-regexp (logview--build-filter-regexp
logview--include-name-regexps))
+ (exclude-name-regexp (logview--build-filter-regexp
logview--exclude-name-regexps))
+ (include-thread-regexp (logview--build-filter-regexp
logview--include-thread-regexps))
+ (exclude-thread-regexp (logview--build-filter-regexp
logview--exclude-thread-regexps))
+ (filters (list include-name-regexp exclude-name-regexp
include-thread-regexp exclude-thread-regexp)))
+ (when (or (not (equal logview--applied-filters filters))
also-cancel-explicit-hiding)
+ (logview--std-matching-and-altering
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let ((reporter (make-progress-reporter "Filtering..."
(point-min) (point-max) (point)))
+ (hider (logview--hide-entry-callback
'logview-filtered))
+ (shower (logview--show-entry-callback
'logview-filtered))
+ (explicit-shower (and also-cancel-explicit-hiding
(logview--show-entry-callback 'logview-hidden-entry)))
+ (num-hidden 0)
+ (num-visible 0)
+ (matches))
+ ;; Because 'callback' doesn't get access to match data,
+ ;; while in 'validator' doesn't know all entry limits, we
+ ;; use both and pass 'matches' from the validator to the
+ ;; callback.
+ (logview--iterate-entries-forward (lambda (begin after-first-line
end)
+ (if matches
+ (progn (funcall shower
begin after-first-line end)
+ (setq num-visible
(1+ num-visible)))
+ (funcall hider begin
after-first-line end)
+ (setq num-hidden (1+
num-hidden)))
+ ;; Yeah, it's two modification
of properties on the
+ ;; same text chunk, but that's
rarely used and so
+ ;; hardly important.
+ (when explicit-shower
+ (funcall explicit-shower
begin after-first-line end))
+ (progress-reporter-update
reporter end)
+ ;; Always continue.
+ t)
+ nil
+ (lambda ()
+ (let ((name (match-string
logview--name-group))
+ (thread (match-string
logview--thread-group)))
+ (setq matches (and (or (null
include-name-regexp)
+
(string-match include-name-regexp name))
+ (or (null
exclude-name-regexp)
+ (not
(string-match exclude-name-regexp name)))
+ (or (null
include-thread-regexp)
+
(string-match include-thread-regexp thread))
+ (or (null
exclude-thread-regexp)
+ (not
(string-match exclude-thread-regexp thread))))))
+ ;; Operate on all entries.
+ t))
+ (cond ((= num-hidden 0)
+ (message (if (equal filters '(nil nil nil nil)) "Filters
are reset" "Filtering complete, nothing was hidden")))
+ ((= num-visible 0)
+ (message "Filtering complete, all entries were hidden"))
+ (t
+ (message "Filtering complete, %d %s out of %d (%.1f%%) %s
hidden"
+ num-hidden (if (= num-hidden 1) "entry" "entries")
(+ num-hidden num-visible)
+ (/ (* num-hidden 100.0) (+ num-hidden
num-visible)) (if (= num-hidden 1) "was" "were"))))))))
+ (setq logview--applied-filters filters)))
+
+;; FIXME: Resulting regexp will not be valid if any of the options
+;; uses group backreferences (\N) and maybe some other
+;; constructs.
+(defun logview--build-filter-regexp (options)
+ (when options
+ (mapconcat 'identity options "\\|")))
+
+
+(defun logview--show-entry-callback (hider)
+ (lambda (begin after-first-line end)
+ (let ((value (get-text-property begin 'invisible)))
+ (when (memq hider value)
+ (put-text-property (logview--linefeed-back-checked begin)
(logview--linefeed-back after-first-line)
+ 'invisible (remq hider value))
+ (when (> end after-first-line)
+ (put-text-property (logview--linefeed-back after-first-line)
(logview--linefeed-back end)
+ 'invisible (remq hider (get-text-property
after-first-line 'invisible))))))))
+
+(defun logview--hide-entry-callback (hider)
+ (lambda (begin after-first-line end)
+ (let ((value (get-text-property begin 'invisible)))
+ (unless (memq hider value)
+ (put-text-property (logview--linefeed-back-checked begin)
(logview--linefeed-back after-first-line)
+ 'invisible (cons hider value))
+ (when (> end after-first-line)
+ (put-text-property (logview--linefeed-back after-first-line)
(logview--linefeed-back end)
+ 'invisible (cons hider (get-text-property
after-first-line 'invisible))))))))
+
+
+;; The following (inlined) functions are needed when applying
+;; 'invisible' property. Generally we count entry from start of its
+;; line to the start of next entry's line. This works nice e.g. for
+;; highlighting. However, for hiding entries we need to take linefeed
+;; that _preceeds_ the entry, otherwise ellipses show at line
+;; beginnings, which is ugly and shifts actual buffer text.
+
+(defsubst logview--linefeed-back-checked (position)
+ "Assuming POSITION is at the beginning of a line, return
+position just before the preceding linefeed, if possible."
+ (if (> position 1)
+ (1- position)
+ 1))
+
+(defsubst logview--linefeed-back (position)
+ "Assuming POSITION is at the beginning of a non-first line,
+return position just before the preceding linefeed."
+ (1- position))
+
+
+(defun logview--iterate-split-alists (callback &rest alists)
+ (let ((seen (make-hash-table :test 'equal)))
+ (dolist (alist alists)
+ (dolist (entry alist)
+ (unless (gethash (car entry) seen)
+ (funcall callback (car entry) (cdr entry))
+ (puthash (car entry) t seen)
+ (dolist (alias (cdr (assq 'aliases (cdr entry))))
+ (puthash alias t seen)))))))
+
+(defun logview--get-split-alists (key type &rest alists)
+ (catch 'found
+ (apply 'logview--iterate-split-alists (lambda (name value)
+ (when (or (equal name key) (member
key (cdr (assq 'aliases value))))
+ (throw 'found value)))
+ alists)
+ (error "Unknown %s '%s'" type key)))
+
+
+
+;;; Internal commands meant as hooks.
+
+(defun logview--split-region-into-entries (begin end &optional old-length)
+ "Parse log entries in given region. Optional third argument is
+to make the function suitable for `after-change-functions' and is
+ignored there. Special value 'report-progress for this argument
+is treated differently."
+ (when logview--process-buffer-changes
+ (save-excursion
+ (save-match-data
+ (save-restriction
+ (with-silent-modifications
+ (widen)
+ (goto-char begin)
+ (forward-line 0)
+ (let ((inhibit-read-only t)
+ (case-fold-search nil)
+ (anchored t))
+ ;; Inlining `logview--match-successive-entries' for
+ ;; performance reasons.
+ (unless (or (looking-at logview--entry-regexp)
+ (re-search-backward logview--entry-regexp nil t))
+ (let ((anchor (if (re-search-forward logview--entry-regexp nil
t)
+ (match-beginning 0)
+ (setq anchored nil)
+ (point-max))))
+ (put-text-property 1 anchor 'face nil)
+ (put-text-property 1 anchor 'invisible nil)))
+ (when anchored
+ (let* ((entry-begin (match-beginning 0))
+ (after-first-line)
+ (level-data)
+ (reporter (when (eq old-length 'report-progress)
+ (make-progress-reporter "Parsing
buffer..." entry-begin end entry-begin)))
+ (have-timestamp (memq 'timestamp
logview--submode-features))
+ (have-level (memq 'level
logview--submode-features))
+ (have-name (memq 'name
logview--submode-features))
+ (have-thread (memq 'thread
logview--submode-features)))
+ (while (progn
+ (forward-line)
+ (setq after-first-line (point))
+ (when have-level
+ (setq level-data (cdr (assoc (match-string
logview--level-group) logview--submode-level-data)))
+ (put-text-property entry-begin after-first-line
'face (nth 1 level-data))
+ (put-text-property
(logview--linefeed-back-checked entry-begin) (logview--linefeed-back
after-first-line)
+ 'invisible (list (nth 0
level-data)))
+ (add-face-text-property (match-beginning
logview--level-group)
+ (match-end
logview--level-group)
+ (nth 2 level-data)))
+ (when have-timestamp
+ (add-face-text-property (match-beginning
logview--timestamp-group)
+ (match-end
logview--timestamp-group)
+ 'logview-timestamp))
+ (when have-name
+ (add-face-text-property (match-beginning
logview--name-group)
+ (match-end
logview--name-group)
+ 'logview-name))
+ (when have-thread
+ (add-face-text-property (match-beginning
logview--thread-group)
+ (match-end
logview--thread-group)
+ 'logview-thread))
+ (setq entry-begin (if (or (looking-at
logview--entry-regexp)
+ (re-search-forward
logview--entry-regexp nil t))
+ (match-beginning 0)
+ (point-max)))
+ ;; Here 'entry-begin' is actually for the next
entry.
+ (when (< after-first-line entry-begin)
+ (when have-level
+ (put-text-property after-first-line entry-begin
'face (nth 1 level-data)))
+ (put-text-property (logview--linefeed-back
after-first-line) (logview--linefeed-back entry-begin)
+ 'invisible (list (nth 0
level-data) 'logview-details)))
+ (when reporter
+ (progress-reporter-update reporter end))
+ (< entry-begin end)))
+ (when reporter
+ (progress-reporter-done reporter)))))))))))
+
+(defun logview--buffer-substring-filter (begin end delete)
+ "Optionally remove invisible text from the substring."
+ (let ((substring (funcall (default-value 'filter-buffer-substring-function)
begin end delete)))
+ (if logview-copy-visible-text-only
+ (let ((chunks)
+ (begin 0)
+ (end))
+ (while begin
+ (setq end (next-single-property-change begin 'invisible substring))
+ (when (not (invisible-p (get-text-property begin 'invisible
substring)))
+ (push (substring substring begin end) chunks))
+ (setq begin end))
+ (apply 'concat (nreverse chunks)))
+ substring)))
+
+
+(provide 'logview)
+
+;;; logview.el ends here
