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.
|
||||
|
||||
- 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
|
||||
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)
|
||||
(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=))
|
||||
"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+"
|
||||
(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)
|
||||
(acct->user username))
|
||||
|
|
|
@ -97,7 +97,8 @@
|
|||
(getf metadata :version)
|
||||
(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))
|
||||
(when notify
|
||||
|
|
|
@ -141,26 +141,6 @@
|
|||
(and 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)
|
||||
(cond
|
||||
((functionp a)
|
||||
|
@ -489,9 +469,14 @@ to the array"
|
|||
(misc:list->array raw '(unsigned-byte 8))))))
|
||||
|
||||
(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)))
|
||||
(labels ((read-chunk ()
|
||||
(declare (optimize (debug 0) (speed 3)))
|
||||
(declare (function processing-function))
|
||||
(declare (fixnum buffer-size))
|
||||
(let ((read-so-far (read-sequence buffer stream)))
|
||||
(funcall processing-function buffer read-so-far)
|
||||
(when (not (< read-so-far buffer-size))
|
||||
|
|
|
@ -1470,7 +1470,6 @@
|
|||
:interfaces
|
||||
:text-utils)
|
||||
(:nicknames :tui)
|
||||
(:import-from :misc-utils :defalias)
|
||||
(:shadowing-import-from :text-utils :split-lines)
|
||||
(:export
|
||||
:make-win-background
|
||||
|
|
|
@ -155,9 +155,11 @@
|
|||
(modeline-bold-expand window folder))))
|
||||
|
||||
(defun expand-message-hashtags (window)
|
||||
(a:when-let ((selected-row (selected-row window)))
|
||||
(let ((selected-row (selected-row window)))
|
||||
(if selected-row
|
||||
(with-tuify-results (window)
|
||||
(db-utils:db-getf (fields selected-row) :tags))))
|
||||
(db-utils:db-getf (fields selected-row) :tags))
|
||||
"")))
|
||||
|
||||
(defun expand-total-messages (window)
|
||||
(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."
|
||||
(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)
|
||||
(simple-char complex-char))
|
||||
|
|
Loading…
Reference in New Issue