mirror of https://codeberg.org/cage/tinmop/
- removed macro 'defalias', does not works with sbcl 2.3.6;
- optimized 'read-stream-chunks'; - ensured funtions that expand modeline always return a string.
This commit is contained in:
parent
8f67357dd2
commit
6550d3038f
23
LICENSES.org
23
LICENSES.org
|
@ -117,29 +117,6 @@
|
||||||
SOFTWARE.
|
SOFTWARE.
|
||||||
|
|
||||||
- src/misc-utils.lisp
|
- src/misc-utils.lisp
|
||||||
'defalias' derived from
|
|
||||||
Copyright (c) 2014 Paul M. Rodriguez
|
|
||||||
|
|
||||||
Permission is hereby granted, free of charge, to any person obtaining
|
|
||||||
a copy of this software and associated documentation files (the
|
|
||||||
"Software"), to deal in the Software without restriction, including
|
|
||||||
without limitation the rights to use, copy, modify, merge, publish,
|
|
||||||
distribute, sublicense, and/or sell copies of the Software, and to
|
|
||||||
permit persons to whom the Software is furnished to do so, subject to
|
|
||||||
the following conditions:
|
|
||||||
|
|
||||||
The above copyright notice and this permission notice shall be
|
|
||||||
included in all copies or substantial portions of the Software.
|
|
||||||
|
|
||||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
|
||||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
|
||||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
|
||||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
|
||||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
|
||||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
|
||||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
||||||
|
|
||||||
according to: https://github.com/TBRSS/serapeum
|
|
||||||
|
|
||||||
'unsplice' derived from
|
'unsplice' derived from
|
||||||
Copyright (c) 2011-2012, James M. Lawrence. All rights reserved.
|
Copyright (c) 2011-2012, James M. Lawrence. All rights reserved.
|
||||||
|
|
|
@ -846,7 +846,13 @@ node-status-id is not a leaf)."
|
||||||
(climb-fetch-statuses (reply-id status)
|
(climb-fetch-statuses (reply-id status)
|
||||||
(push status branch)))))))
|
(push status branch)))))))
|
||||||
|
|
||||||
(defalias id= #'string=)
|
(defun id= (string1 string2 &key (start1 0) end1 (start2 0) end2)
|
||||||
|
(string= string1
|
||||||
|
string2
|
||||||
|
:start1 start1
|
||||||
|
:end1 end1
|
||||||
|
:start2 start2
|
||||||
|
:end2 end2))
|
||||||
|
|
||||||
(defun make-id= (&optional (test #'id=))
|
(defun make-id= (&optional (test #'id=))
|
||||||
"Returns a comparator function that checks for id equality"
|
"Returns a comparator function that checks for id equality"
|
||||||
|
|
|
@ -796,7 +796,8 @@ to the corresponding row in table +table-account+"
|
||||||
to the corresponding id in table +table-account+"
|
to the corresponding id in table +table-account+"
|
||||||
(db-getf (acct->user acct) :id))
|
(db-getf (acct->user acct) :id))
|
||||||
|
|
||||||
(misc:defalias username->id #'acct->id)
|
(defun username->id (unique-username)
|
||||||
|
(acct->id unique-username))
|
||||||
|
|
||||||
(defun user-exists-p (username)
|
(defun user-exists-p (username)
|
||||||
(acct->user username))
|
(acct->user username))
|
||||||
|
|
|
@ -97,7 +97,8 @@
|
||||||
(getf metadata :version)
|
(getf metadata :version)
|
||||||
(getf metadata :cover))))
|
(getf metadata :cover))))
|
||||||
|
|
||||||
(defalias gempub-file-p #'zip-info:zip-file-p)
|
(defun gempub-file-p (path &key (ignore-errors nil))
|
||||||
|
(zip-info:zip-file-p path :ignore-errors ignore-errors))
|
||||||
|
|
||||||
(defun sync-library (&key (notify nil))
|
(defun sync-library (&key (notify nil))
|
||||||
(when notify
|
(when notify
|
||||||
|
|
|
@ -141,26 +141,6 @@
|
||||||
(and form
|
(and form
|
||||||
(list form)))
|
(list form)))
|
||||||
|
|
||||||
(defmacro defalias (alias &body (def &optional docstring))
|
|
||||||
"Define a value as a top-level function.
|
|
||||||
(defalias string-gensym (compose #'gensym #'string))
|
|
||||||
Like (setf (fdefinition ALIAS) DEF), but with a place to put
|
|
||||||
documentation and some niceties to placate the compiler.
|
|
||||||
Name from Emacs Lisp."
|
|
||||||
`(progn
|
|
||||||
;; Give the function a temporary definition at compile time so
|
|
||||||
;; the compiler doesn't complain about it's being undefined.
|
|
||||||
(eval-when (:compile-toplevel)
|
|
||||||
(unless (fboundp ',alias)
|
|
||||||
(defun ,alias (&rest args)
|
|
||||||
(declare (ignore args)))))
|
|
||||||
(eval-when (:load-toplevel :execute)
|
|
||||||
(compile ',alias ,def)
|
|
||||||
,@(unsplice
|
|
||||||
(when docstring
|
|
||||||
`(setf (documentation ',alias 'function) ,docstring))))
|
|
||||||
',alias))
|
|
||||||
|
|
||||||
(defun a->function (a)
|
(defun a->function (a)
|
||||||
(cond
|
(cond
|
||||||
((functionp a)
|
((functionp a)
|
||||||
|
@ -489,9 +469,14 @@ to the array"
|
||||||
(misc:list->array raw '(unsigned-byte 8))))))
|
(misc:list->array raw '(unsigned-byte 8))))))
|
||||||
|
|
||||||
(defun read-stream-chunks (stream buffer-size processing-function)
|
(defun read-stream-chunks (stream buffer-size processing-function)
|
||||||
|
(assert (functionp processing-function))
|
||||||
|
(assert (typep buffer-size 'fixnum))
|
||||||
|
(assert (> buffer-size 0))
|
||||||
(let ((buffer (make-fresh-array buffer-size 0 '(unsigned-byte 8) t)))
|
(let ((buffer (make-fresh-array buffer-size 0 '(unsigned-byte 8) t)))
|
||||||
(labels ((read-chunk ()
|
(labels ((read-chunk ()
|
||||||
(declare (optimize (debug 0) (speed 3)))
|
(declare (optimize (debug 0) (speed 3)))
|
||||||
|
(declare (function processing-function))
|
||||||
|
(declare (fixnum buffer-size))
|
||||||
(let ((read-so-far (read-sequence buffer stream)))
|
(let ((read-so-far (read-sequence buffer stream)))
|
||||||
(funcall processing-function buffer read-so-far)
|
(funcall processing-function buffer read-so-far)
|
||||||
(when (not (< read-so-far buffer-size))
|
(when (not (< read-so-far buffer-size))
|
||||||
|
|
|
@ -1470,7 +1470,6 @@
|
||||||
:interfaces
|
:interfaces
|
||||||
:text-utils)
|
:text-utils)
|
||||||
(:nicknames :tui)
|
(:nicknames :tui)
|
||||||
(:import-from :misc-utils :defalias)
|
|
||||||
(:shadowing-import-from :text-utils :split-lines)
|
(:shadowing-import-from :text-utils :split-lines)
|
||||||
(:export
|
(:export
|
||||||
:make-win-background
|
:make-win-background
|
||||||
|
|
|
@ -155,9 +155,11 @@
|
||||||
(modeline-bold-expand window folder))))
|
(modeline-bold-expand window folder))))
|
||||||
|
|
||||||
(defun expand-message-hashtags (window)
|
(defun expand-message-hashtags (window)
|
||||||
(a:when-let ((selected-row (selected-row window)))
|
(let ((selected-row (selected-row window)))
|
||||||
(with-tuify-results (window)
|
(if selected-row
|
||||||
(db-utils:db-getf (fields selected-row) :tags))))
|
(with-tuify-results (window)
|
||||||
|
(db-utils:db-getf (fields selected-row) :tags))
|
||||||
|
"")))
|
||||||
|
|
||||||
(defun expand-total-messages (window)
|
(defun expand-total-messages (window)
|
||||||
(with-accessors ((timeline-folder timeline-folder)
|
(with-accessors ((timeline-folder timeline-folder)
|
||||||
|
|
|
@ -182,7 +182,8 @@ as argument `complex-string'."
|
||||||
non nil `b' will inherit all the attributes and color of a."
|
non nil `b' will inherit all the attributes and color of a."
|
||||||
(croatoan:concat-complex-string a b :color-attributes-contagion color-attributes-contagion))
|
(croatoan:concat-complex-string a b :color-attributes-contagion color-attributes-contagion))
|
||||||
|
|
||||||
(defalias cat-tui-string #'cat-complex-string)
|
(misc:definline cat-tui-string (a b &key (color-attributes-contagion nil))
|
||||||
|
(cat-complex-string a b :color-attributes-contagion color-attributes-contagion))
|
||||||
|
|
||||||
(defun tui-char->char (complex-char)
|
(defun tui-char->char (complex-char)
|
||||||
(simple-char complex-char))
|
(simple-char complex-char))
|
||||||
|
|
Loading…
Reference in New Issue