Current File : //proc/self/root/kunden/usr/share/emacs/27.2/lisp/emacs-lisp/faceup.elc

;ELC
;;; Compiled
;;; in Emacs version 27.2
;;; with all optimizations.

;;; This file contains utf-8 non-ASCII characters,
;;; and so cannot be loaded into Emacs 22 or earlier.
(and (boundp 'emacs-version)
     (< (aref emacs-version (1- (length emacs-version))) ?A)
     (string-lessp emacs-version "23")
     (error "`%s' was compiled for Emacs 23 or later" #$))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


#@76 The property that should be represented in Faceup without the (prop) part.
(defvar faceup-default-property 'face (#$ . 408))
#@196 List of properties that should be converted to the Faceup format.

Only face-like property use the short format.  All other use the
non-nesting full format.  (See `faceup-face-like-properties'.)
(defvar faceup-properties '(face) (#$ . 540))
#@834 List of properties that behave like `face'.

The following properties are assumed about face-like properties:

* Elements are either symbols or property lists, or lists thereof.

* A plain element and a list containing the same element are
  treated as equal

* Property lists and sequences of property lists are considered
  equal.  For example:

     ((:underline t :foreground "red"))

  and

     ((:underline t) (:foreground "red"))

Face-like properties are converted to faceup in a nesting fashion.

For example, the string AAAXXXAAA (where the property `prop' has
the value `(a)' on the A:s and `(a b)' on the X:s) is converted
as follows, when treated as a face-like property:

    «(prop):a:AAA«(prop):b:XXX»AAAA»

When treated as a non-face-like property:

    «(prop):(a):AAA»«(prop):(a b):XXX»«(prop):(a):AAA»
(defvar faceup-face-like-properties '(face font-lock-face) (#$ . 788))
(defvar faceup-markup-start-char 171)
(defvar faceup-markup-end-char 187)
#@51 Alist from faces to one-character representation.
(defvar faceup-face-short-alist '((bold . "B") (bold-italic . "Q") (default . "D") (error . "E") (highlight . "H") (italic . "I") (underline . "U") (warning . "W") (font-lock-builtin-face . "b") (font-lock-comment-delimiter-face . "m") (font-lock-comment-face . "x") (font-lock-constant-face . "c") (font-lock-doc-face . "d") (font-lock-function-name-face . "f") (font-lock-keyword-face . "k") (font-lock-negation-char-face . "n") (font-lock-preprocessor-face . "p") (font-lock-regexp-grouping-backslash . "h") (font-lock-regexp-grouping-construct . "o") (font-lock-string-face . "s") (font-lock-type-face . "t") (font-lock-variable-name-face . "v") (font-lock-warning-face . "w")) (#$ . 1772))
#@52 Return the faceup version of the string S.

(fn S)
(defalias 'faceup-markup-string #[257 "\300\301!r\211q\210\302\303\304\305\306!\307\"\310$\216
c\210\311 *\207" [generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-markup-buffer] 8 (#$ . 2523)])
#@58 Display the faceup representation of the current buffer.
(defalias 'faceup-view-buffer #[0 "\300\301!r\211q\210ed|\210)\302
!\210\303
!\207" [get-buffer-create "*FaceUp*" faceup-markup-to-buffer display-buffer] 3 (#$ . 2853) nil])
#@420 Save the faceup representation of the current buffer to the file FILE-NAME.

Unless a name is given, the file will be named xxx.faceup, where
xxx is the file name associated with the buffer.

If optional second arg CONFIRM is non-nil, this function
asks for confirmation before overwriting an existing file.
Interactively, confirmation is required unless you supply a prefix argument.

(fn &optional FILE-NAME CONFIRM)
(defalias 'faceup-write-file #[512 "
\204\n\302 \303P\262p\304\305!r\211q\210\306\307\310\311\312!\313\"\314$\216\315p\"\210\316\211\317\",\262
\207" [window-size-change-functions require-final-newline buffer-file-name ".faceup" generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-markup-to-buffer nil write-file] 10 (#$ . 3091) (byte-code "\302 \205	\302 \303P\304\305\306\307!%	?D\207" [default-directory current-prefix-arg buffer-file-name ".faceup" read-file-name "Write faceup file: " nil file-name-nondirectory] 8)])
#@69 Return a string with the content of the buffer using faceup markup.
(defalias 'faceup-markup-buffer #[0 "p\300\301!r\211q\210\302\303\304\305\306!\307\"\310$\216\311p\"\210\312ed\"*\262
\207" [generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-markup-to-buffer buffer-substring-no-properties] 8 (#$ . 4128)])
#@91 Quote and insert the text between START and END into TO-BUFFER.

(fn START END TO-BUFFER)
(defalias 'faceup-copy-and-quote #[771 "\302\303\304\"\303\304	\"Q\212b\210`W\205@`
w\210\305
`\"rq\210\211c\210)\266`U\204grq\210c\210\211c\210)\210\306u\210\202)\207" [faceup-markup-start-char faceup-markup-end-char "^" make-string 1 buffer-substring-no-properties nil] 8 (#$ . 4522)])
#@76 Normalize VALUES into a list of faces and (KEY VALUE) entries.

(fn VALUE)
(defalias 'faceup-normalize-face-property #[257 "\211\204\300\207\2119\203\211C\207\211;\203\301
!C\207\211:\203n\211@\302=\203*\303
ADC\207\211@\304=\2037\305
ADC\207\306
@!\203c\300
\203a
\211A\262\242\211A\262\242\306!\203\\

DB\262\266\202?\211\207\307\310@!\310A!\"\207\311\312\"\207" [nil intern foreground-color :foreground background-color :background keywordp append faceup-normalize-face-property error "Unexpected text property %s"] 6 (#$ . 4920)])
#@229 Alist of properties and values at POS.

Face-like properties are normalized -- value is a list of
faces (symbols) and short (KEY VALUE) lists.  The list is
reversed to that later elements take precedence over earlier.

(fn POS)
(defalias 'faceup-get-text-properties #[257 "\302\211\203,\211@\303\"\211\203$
	>\203\304\305!!\262


BB\262\210
A\266\202\202\210\211\207" [faceup-properties faceup-face-like-properties nil get-text-property reverse faceup-normalize-face-property] 8 (#$ . 5485)])
#@100 Convert content of BUFFER to faceup form and insert in TO-BUFFER.

(fn TO-BUFFER &optional BUFFER)
(defalias 'faceup-markup-to-buffer #[513 "\212\211\203\211q\210\203	\306=\203\n\203\307ed\"\210e\310\211\311!\211\262\203P
\312#\210
\262\313!\310\314!\262\315\203\224\203\224\211\203\224@@@A
\236>\203m

A@\232\203g\211
AA\241\210\202\201\310\262\202\201

A=\203~\316
\"\262\202\201\310\262\266\211\203;\211A\262\242B\262\202;\210\203\256rq\210\317\320\f\"c\210)\211A\262\210\202\225rq\210
\203J

\211A\262\242\211@>\203&
\211A\211\203\"
\211@\317\320
\"c\210@=\204\346\321c\210\322@!c\210\323c\210\2119\203
\211\236\211\203\374\211A\324\261\210\202
\324\322!\324\261\210\210\202
\324c\210\325
p\"\210\324c\210@
BB\262
A\266\202\202\306\210\202F
\317\320
\"c\210\321c\210\322
@!c\210\323c\210\325
Ap\"\210\324c\210\211B\262\210\202\263)\266\202\202\312d#\266\203)\207" [font-lock-mode major-mode font-lock-defaults faceup-face-like-properties faceup-markup-end-char faceup-markup-start-char help-mode font-lock-fontify-region nil faceup-next-property-change faceup-copy-and-quote faceup-get-text-properties reverse t delq make-string 1 "(" symbol-name "):" ":" prin1 faceup-default-property faceup-face-short-alist] 14 (#$ . 5997)])
#@77 True if any properties in `faceup-properties' are defined at POS.

(fn POS)
(defalias 'faceup-has-any-text-property #[257 "\301\211\203\211@\302\"\203\303\262
A\266\202\202\210\211\207" [faceup-properties nil get-text-property t] 7 (#$ . 7319)])
#@86 Next position a property in `faceup-properties' changes after POS, or nil.

(fn POS)
(defalias 'faceup-next-single-property-change #[257 "\301\211\203%\211@\302\"\211\203\203
^\202\211\262\210
A\266\202\202\210\211\207" [faceup-properties nil next-single-property-change] 7 (#$ . 7581)])
#@261 Next position after POS where one of the tracked properties change.

If POS is nil, also include `point-min' in the search.
If last character contains a tracked property, return `point-max'.

See `faceup-properties' for a list of tracked properties.

(fn POS)
(defalias 'faceup-next-property-change #[257 "\211d=?\205;\211\204\300e!\203e\207\211\204e\262
\301
!\211\2048
d=\2048ed=\2048\300dS!\2038d\2029\211\262
\207" [faceup-has-any-text-property faceup-next-single-property-change] 4 (#$ . 7891)])
#@84 Return string with properties from FACEUP written with Faceup markup.

(fn FACEUP)
(defalias 'faceup-render-string #[257 "\300\301!r\211q\210\302\303\304\305\306!\307\"\310$\216
c\210\311 *\207" [generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-render-to-string] 8 (#$ . 8410)])
#@96 Convert BUFFER containing Faceup markup to a new buffer and display it.

(fn &optional BUFFER)
(defalias 'faceup-render-view-buffer #[256 "r\211\206pq\210\300\301!r\211q\210ed|\210)\302
!\210\303
!\262
)\207" [get-buffer-create "*FaceUp rendering*" faceup-render-to-buffer display-buffer] 4 (#$ . 8775) nil])
#@88 Convert BUFFER containing faceup markup to a string with faces.

(fn &optional BUFFER)
(defalias 'faceup-render-to-string #[256 "\211\204p\262
\300\301!r\211q\210\302\303\304\305\306!\307\"\310$\216\311p\"\210ed{*\207" [generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-render-to-buffer] 8 (#$ . 9092)])
#@109 Convert BUFFER containing faceup markup into text with faces in TO-BUFFER.

(fn TO-BUFFER &optional BUFFER)
(defalias 'faceup-render-to-buffer #[513 "r\211\206pq\210eb\210`\304\305\306\307\"\306\307	\"Q\211\304w\210`=\204\217\310`\"\304\211\203S\211@\211@
A
\236\211\204C\304B\262
\211B\262\211\211AB\241\266
A\266\202\202'\210\211\211\203\200\211@\211@\311A!\211G\307=\203l\211@\262
\312\313GD	$\266
A\266\202\202U\210rq\210
c\210)`\262\266m?\205\f
g=\203\377\304u\210g=\204\251g	=\203\262`\262\304u\210\202\ng\314=\203\312\304u\210`\315 \210\316
`{!\266\202\304u\210g\317=\203\344\304u\210`\315 \210\320
`{!\262
\304u\210\202\360\321\310``T\"\"@\322u\210

BB\262\266`\262\202
A\262\304u\210`\262\202\266\203)\207" [faceup-markup-start-char faceup-markup-end-char faceup-default-property faceup-face-short-alist nil "^" make-string 1 buffer-substring-no-properties reverse add-text-properties 0 40 forward-sexp intern 58 read rassoc 2] 16 (#$ . 9485)])
#@35 Remove faceup markup from buffer.
(defalias 'faceup-clean-buffer #[0 "eb\210\302\303\304\"\303\304	\"Q\211\305w\210m?\205og	=\203#\306\304!\210\202
\306\304!\210g=\2043g	=\2039\305u\210\202
g\307=\203H`\310 \210\211`|\266g\311=\203d`\305u\210\310 \210m\204\\\305u\210\211`|\266\202
\306\304!\210\306\304!\210\202
\207" [faceup-markup-start-char faceup-markup-end-char "^" make-string 1 nil delete-char 40 forward-sexp 58] 5 (#$ . 10499) nil])
#@45 Remove faceup markup from string S.

(fn S)
(defalias 'faceup-clean-string #[257 "\300\301!r\211q\210\302\303\304\305\306!\307\"\310$\216
c\210\311 \210ed{*\207" [generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-clean-buffer] 8 (#$ . 10963)])
#@815 When non-nil, tester functions returns a text description on failure.

Of course, this only work for test functions aware of this
variable, like `faceup-test-equal' and functions based on this
function.

This is intended to be used to simplify `ert' explain functions,
which could be defined as:

    (defun my-test (args...) ...)
    (defun my-test-explain (args...)
      (let ((faceup-test-explain t))
        (the-test args...)))
    (put 'my-test 'ert-explainer 'my-test-explain)

Alternative, you can use the macro `faceup-defexplainer' as follows:

    (defun my-test (args...) ...)
    (faceup-defexplainer my-test)

Test functions, like `faceup-test-font-lock-buffer', built on top
of `faceup-test-equal', and other functions that adhere to this
variable, can easily define their own explainer functions.
(defvar faceup-test-explain nil (#$ . 11293))
#@154 Define an Ert explainer function for FUNCTION.

FUNCTION must return an explanation when the test fails and
`faceup-test-explain' is set.

(fn FUNCTION)
(defalias 'faceup-defexplainer '(macro . #[257 "\300\301!\302P!\303\304\305\306\307\310\311	D\312BBEF\313\311D\314\311DFE\207" [intern symbol-name "-explainer" progn defun (&rest args) let ((faceup-test-explain t)) apply quote (args) put 'ert-explainer] 11 (#$ . 12160)]))
#@1206 Compares two (multi-line) strings, LHS and RHS, for equality.

This is intended to be used in Ert regression test rules.

When `faceup-test-explain' is non-nil, instead of returning nil
on inequality, a list is returned with a explanation what
differs.  Currently, this function reports 1) if the number of
lines in the strings differ.  2) the lines and the line numbers on
which the string differed.

For example:
    (let ((a "ABC\nDEF\nGHI")
          (b "ABC\nXXX\nGHI\nZZZ")
          (faceup-test-explain t))
      (message "%s" (faceup-test-equal a b)))

    ==> (4 3 number-of-lines-differ (on-line 2 (DEF) (XXX)))

When used in an `ert' rule, the output is as below:

    (ert-deftest faceup-test-equal-example ()
      (let ((a "ABC\nDEF\nGHI")
            (b "ABC\nXXX\nGHI\nZZZ"))
        (should (faceup-test-equal a b))))

    F faceup-test-equal-example
        (ert-test-failed
         ((should
           (faceup-test-equal a b))
          :form
          (faceup-test-equal "ABC\nDEF\nGHI" "ABC\nXXX\nGHI\nZZZ")
          :value nil :explanation
          (4 3 number-of-lines-differ
             (on-line 2
                      ("DEF")
                      ("XXX")))))

(fn LHS RHS)
(defalias 'faceup-test-equal #[514 "

\232\203\301\207\205R\302\303\"\302\303\"\304\305GGU\204&\306GGE\262\203N\211A\262\242\211A\262\242

\232\204G\307CCFB\262T\266\203\202&
\237\266\204\207" [faceup-test-explain t split-string "\n" nil 1 number-of-lines-differ on-line] 12 (#$ . 12600)])
#@19 

(fn &rest ARGS)
(defalias 'faceup-test-equal-explainer #[128 "\301\302\303\")\207" [faceup-test-explain t apply faceup-test-equal] 4 (#$ . 14127)])
(put 'faceup-test-equal 'ert-explainer 'faceup-test-equal-explainer)
#@367 Verify that BUFFER is fontified as FACEUP for major mode MODE.

If BUFFER is not specified the current buffer is used.

Note that the major mode of the buffer is set to MODE and that
the buffer is fontified.

If MODE is a list, the first element is the major mode, the
remaining are additional functions to call, e.g. minor modes.

(fn MODE FACEUP &optional BUFFER)
(defalias 'faceup-test-font-lock-buffer #[770 "\212\211\203\211q\210<\203\"\211\203\211@\211 \210
A\266\202\202\210\202% \210\300ed\"\210\301 \302\"\262
)\207" [font-lock-fontify-region faceup-markup-buffer faceup-test-equal] 7 (#$ . 14355)])
#@19 

(fn &rest ARGS)
(defalias 'faceup-test-font-lock-buffer-explainer #[128 "\301\302\303\")\207" [faceup-test-explain t apply faceup-test-font-lock-buffer] 4 (#$ . 14983)])
(put 'faceup-test-font-lock-buffer 'ert-explainer 'faceup-test-font-lock-buffer-explainer)
#@310 True if FACEUP is re-fontified as the faceup markup for major mode MODE.

The string FACEUP is stripped from markup, inserted into a
buffer, the requested major mode activated, the buffer is
fontified, the result is again converted to the faceup form, and
compared with the original string.

(fn MODE FACEUP)
(defalias 'faceup-test-font-lock-string #[514 "\300\301!r\211q\210\302\303\304\305\306!\307\"\310$\216
c\210\311 \210\312\"*\207" [generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 faceup-clean-buffer faceup-test-font-lock-buffer] 9 (#$ . 15255)])
#@19 

(fn &rest ARGS)
(defalias 'faceup-test-font-lock-string-explainer #[128 "\301\302\303\")\207" [faceup-test-explain t apply faceup-test-font-lock-string] 4 (#$ . 15892)])
(put 'faceup-test-font-lock-string 'ert-explainer 'faceup-test-font-lock-string-explainer)
#@154 Verify that FILE is fontified as FACEUP-FILE for major mode MODE.

If FACEUP-FILE is omitted, FILE.faceup is used.

(fn MODE FILE &optional FACEUP-FILE)
(defalias 'faceup-test-font-lock-file #[770 "\211\204	
\300P\262
\301\302!r\211q\210\303\304\305\306\307!\310\"\311$\216\312!\210\313ed\"*\262
\301\302!r\211q\210\303\304\305\306\307!\314\"\311$\216\312!\210\315\"*\262
\207" [".faceup" generate-new-buffer " *temp*" make-byte-code 0 "\301\300!\205	\302\300!\207" vconcat vector [buffer-name kill-buffer] 2 insert-file-contents buffer-substring-no-properties [buffer-name kill-buffer] faceup-test-font-lock-buffer] 11 (#$ . 16164)])
#@19 

(fn &rest ARGS)
(defalias 'faceup-test-font-lock-file-explainer #[128 "\301\302\303\")\207" [faceup-test-explain t apply faceup-test-font-lock-file] 4 (#$ . 16813)])
(put 'faceup-test-font-lock-file 'ert-explainer 'faceup-test-font-lock-file-explainer)
#@119 The directory of the file where the call to this function is located in.
Intended to be called when a file is loaded.
(defalias 'faceup-this-file-directory #[0 "\302\203\303!\202\f	!\207" [load-file-name default-directory expand-file-name file-name-directory] 3 (#$ . 17077)])
(provide 'faceup)