From 6550d3038f871cc9cb6f83e708ec8082d5ebf53d Mon Sep 17 00:00:00 2001 From: cage Date: Wed, 26 Jul 2023 14:44:05 +0200 Subject: [PATCH] - removed macro 'defalias', does not works with sbcl 2.3.6; - optimized 'read-stream-chunks'; - ensured funtions that expand modeline always return a string. --- LICENSES.org | 23 ----------------------- src/api-client.lisp | 8 +++++++- src/db.lisp | 3 ++- src/gempub.lisp | 3 ++- src/misc-utils.lisp | 25 +++++-------------------- src/package.lisp | 1 - src/thread-window.lisp | 8 +++++--- src/tui-utils.lisp | 3 ++- 8 files changed, 23 insertions(+), 51 deletions(-) diff --git a/LICENSES.org b/LICENSES.org index dfe5e81..130f22e 100644 --- a/LICENSES.org +++ b/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. diff --git a/src/api-client.lisp b/src/api-client.lisp index bd9e0cf..c14a375 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -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" diff --git a/src/db.lisp b/src/db.lisp index c26581d..3d58df9 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -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)) diff --git a/src/gempub.lisp b/src/gempub.lisp index c9efedc..bbe1d19 100644 --- a/src/gempub.lisp +++ b/src/gempub.lisp @@ -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 diff --git a/src/misc-utils.lisp b/src/misc-utils.lisp index 371817d..d58a758 100644 --- a/src/misc-utils.lisp +++ b/src/misc-utils.lisp @@ -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)) diff --git a/src/package.lisp b/src/package.lisp index a1a0e22..2e6503e 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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 diff --git a/src/thread-window.lisp b/src/thread-window.lisp index 1f7f29b..c926786 100644 --- a/src/thread-window.lisp +++ b/src/thread-window.lisp @@ -155,9 +155,11 @@ (modeline-bold-expand window folder)))) (defun expand-message-hashtags (window) - (a:when-let ((selected-row (selected-row window))) - (with-tuify-results (window) - (db-utils:db-getf (fields selected-row) :tags)))) + (let ((selected-row (selected-row window))) + (if selected-row + (with-tuify-results (window) + (db-utils:db-getf (fields selected-row) :tags)) + ""))) (defun expand-total-messages (window) (with-accessors ((timeline-folder timeline-folder) diff --git a/src/tui-utils.lisp b/src/tui-utils.lisp index 435b319..d35f9f6 100644 --- a/src/tui-utils.lisp +++ b/src/tui-utils.lisp @@ -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))