(cdr (setq erc--news-temp-file
(cons (time-add (current-time) (* 60 60 12))
tempfile))))))
- (and-let* ((file (or (eval-when-compile (macroexp-file-name))
- (locate-library "erc")))
+ (and-let* ((file (or load-file-name (locate-library "erc")))
(dir (file-name-directory file))
(adjacent (expand-file-name "ERC-NEWS" dir))
((file-exists-p adjacent)))
(let* ((catname (symbol-name ,catalog))
(prefix (if (eq ?- (aref catname 0)) "erc--message" "erc-message-"))
(name (concat prefix catname "-" (symbol-name ,key))))
- (if ,softp
- (and-let* ((s (intern-soft name)) ((boundp s))) s)
- (intern name)))))
+ ,(cond
+ ((byte-compile-trueconstp softp)
+ (inline-quote (and-let* ((s (intern-soft name)) ((boundp s))) s)))
+ ((byte-compile-nilconstp softp)
+ (inline-quote (intern name)))
+ (t
+ (inline-quote
+ (if ,softp
+ (and-let* ((s (intern-soft name)) ((boundp s))) s)
+ (intern name))))))))
(defun erc-make-message-variable-name (catalog entry)
"Create a variable name corresponding to CATALOG's ENTRY."
(downcase name)
(upcase name))
while (gethash char taken)
- finally (progn
- (setf (gethash char taken) t)
- (cl-return (string char))))
+ finally return
+ (progn
+ (setf (gethash char taken) t)
+ (string char)))
entry)))
(defun emoji--compute-name (entry)
:ascii-compatible-p t
:code-space [0 255]
:map ,map)
- (if ,iso-symbol
- (define-charset ,iso-symbol
- (if ,iso-ir
- (format "Right-Hand Part of %s (%s): ISO-IR-%d"
- ,name ,nickname ,iso-ir)
- (format "Right-Hand Part of %s (%s)" ,name ,nickname))
- :short-name (format "RHP of %s" ,name)
- :long-name (format "RHP of %s (%s)" ,name ,nickname)
- :iso-final-char ,iso-final
- :emacs-mule-id ,emacs-mule-id
- :code-space [32 127]
- :subset (list ,symbol 160 255 -128)))))
+ ,@(when iso-symbol
+ `((define-charset ,iso-symbol
+ ,(if iso-ir
+ `(format "Right-Hand Part of %s (%s): ISO-IR-%d"
+ ,name ,nickname ,iso-ir)
+ `(format "Right-Hand Part of %s (%s)" ,name ,nickname))
+ :short-name (format "RHP of %s" ,name)
+ :long-name (format "RHP of %s (%s)" ,name ,nickname)
+ :iso-final-char ,iso-final
+ :emacs-mule-id ,emacs-mule-id
+ :code-space [32 127]
+ :subset (list ,symbol 160 255 -128))))))
(define-iso-single-byte-charset 'iso-8859-2 'latin-iso8859-2
"ISO/IEC 8859/2" "Latin-2" 101 ?B 130 "8859-2")
(princ "\n Other coding systems cannot be distinguished automatically
from these, and therefore cannot be recognized automatically
with the present coding system priorities.\n\n")
-
- ;; Fixme: should this be replaced or junked?
- (if nil
- (let ((categories '(coding-category-iso-7 coding-category-iso-7-else))
- coding-system codings)
- (while categories
- (setq coding-system (symbol-value (car categories)))
- (mapc
- (lambda (x)
- (if (and (not (eq x coding-system))
- (let ((flags (coding-system-get :flags)))
- (not (or (memq 'use-roman flags)
- (memq 'use-oldjis flags)))))
- (setq codings (cons x codings))))
- (get (car categories) 'coding-systems))
- (if codings
- (let ((max-col (window-width))
- pos)
- (princ (format "\
- The following are decoded correctly but recognized as %s:\n "
- coding-system))
- (while codings
- (setq pos (point))
- (insert (format " %s" (car codings)))
- (when (> (current-column) max-col)
- (goto-char pos)
- (insert "\n ")
- (goto-char (point-max)))
- (setq codings (cdr codings)))
- (insert "\n\n")))
- (setq categories (cdr categories)))))
-
(princ "Particular coding systems specified for certain file names:\n")
(terpri)
(princ " OPERATION\tTARGET PATTERN\t\tCODING SYSTEM(s)\n")
((< index 0)
(if sc-electric-circular-p
(1- last)
- (progn (error msg "preced") 0)))
+ (error msg "preced")))
((>= index last)
(if sc-electric-circular-p
0
- (progn (error msg "follow") (1- last))))))
+ (error msg "follow")))))
(with-current-buffer sc-electric-bufname
(let ((inhibit-read-only t))
(erase-buffer)
;; Trashing directories does not work yet, because
;; `rename-file', called in `move-file-to-trash', does not
;; handle directories.
- (if nil ; (and delete-by-moving-to-trash trash)
- ;; Move non-empty dir to trash only if recursive deletion was
- ;; requested.
- (if (not (or recursive (directory-empty-p dir)))
- (signal 'ftp-error
- (list "Directory is not empty, not moving to trash"))
- (move-file-to-trash dir))
- (let ((parsed (ange-ftp-ftp-name dir)))
- (if recursive
- (mapc
- (lambda (file)
- (if (file-directory-p file)
- (ange-ftp-delete-directory file recursive)
- (delete-file file)))
- (directory-files dir 'full directory-files-no-dot-files-regexp)))
- (if parsed
- (let* ((host (nth 0 parsed))
- (user (nth 1 parsed))
- ;; Some ftp's on unix machines (at least on Suns)
- ;; insist that rmdir take a filename, and not a
- ;; directory-name name as an arg. Argh!! This is a bug.
- ;; Non-unix machines will probably always insist
- ;; that rmdir takes a directory-name as an arg
- ;; (as the ftp man page says it should).
- (name (ange-ftp-quote-string
- (if (eq (ange-ftp-host-type host) 'unix)
- (ange-ftp-real-directory-file-name
- (nth 2 parsed))
- (ange-ftp-real-file-name-as-directory
- (nth 2 parsed)))))
- (abbr (ange-ftp-abbreviate-filename dir))
- (result
- (progn
- ;; CWD must not in this directory.
- (ange-ftp-cd host user "/" 'noerror)
- (ange-ftp-send-cmd host user
- (list 'rmdir name)
- (format "Removing directory %s"
- abbr)))))
- (or (car result)
- (ange-ftp-error host user
- (format "Could not remove directory %s: %s"
- dir
- (cdr result))))
- (ange-ftp-delete-file-entry dir t))
- (ange-ftp-real-delete-directory dir recursive trash))))
+ (let ((parsed (ange-ftp-ftp-name dir)))
+ (if recursive
+ (mapc
+ (lambda (file)
+ (if (file-directory-p file)
+ (ange-ftp-delete-directory file recursive)
+ (delete-file file)))
+ (directory-files dir 'full directory-files-no-dot-files-regexp)))
+ (if parsed
+ (let* ((host (nth 0 parsed))
+ (user (nth 1 parsed))
+ ;; Some ftp's on unix machines (at least on Suns)
+ ;; insist that rmdir take a filename, and not a
+ ;; directory-name name as an arg. Argh!! This is a bug.
+ ;; Non-unix machines will probably always insist
+ ;; that rmdir takes a directory-name as an arg
+ ;; (as the ftp man page says it should).
+ (name (ange-ftp-quote-string
+ (if (eq (ange-ftp-host-type host) 'unix)
+ (ange-ftp-real-directory-file-name
+ (nth 2 parsed))
+ (ange-ftp-real-file-name-as-directory
+ (nth 2 parsed)))))
+ (abbr (ange-ftp-abbreviate-filename dir))
+ (result
+ (progn
+ ;; CWD must not in this directory.
+ (ange-ftp-cd host user "/" 'noerror)
+ (ange-ftp-send-cmd host user
+ (list 'rmdir name)
+ (format "Removing directory %s"
+ abbr)))))
+ (or (car result)
+ (ange-ftp-error host user
+ (format "Could not remove directory %s: %s"
+ dir
+ (cdr result))))
+ (ange-ftp-delete-file-entry dir t))
+ (ange-ftp-real-delete-directory dir recursive trash)))
(error "Not a directory: %s" dir)))
\f
;; Make a local copy of FILE and return its name.
t)
;; GNU SASL may print 'Trying ...' first.
(or (not (looking-at "Trying "))
- (forward-line)
- t)
+ (forward-line))
(not (and (imap-parse-greeting)
;; success in imtest 1.6:
(re-search-forward
(pcase (setq token (read (current-buffer)))
('+ (setq imap-continuation
(or (buffer-substring (min (point-max) (1+ (point)))
- (point-max))
- t)))
+ (point-max)))))
('* (pcase (prog1 (setq token (read (current-buffer)))
(imap-forward))
('OK (imap-parse-resp-text))
(or
(if vec (concat "2>" (tramp-get-remote-null-device vec))
(if (eq system-type 'windows-nt) ""
- (concat "2>" null-device)))
- (throw 'wont-work nil))))
+ (concat "2>" null-device))))))
(ls (when (string-match-p (rx (| bol (not "%")) "%l") script)
(format "%s %s"
(or (tramp-get-ls-command vec)
(setcar elt (dbus-byte-array-to-string (car elt)))
(setq elt (cdr elt)))
- (when nil ;; We discard it, no use so far.
- ;; Register a service resolver.
- (let ((object-path (zeroconf-register-service-resolver name type)))
- ;; Register the signals.
- (dolist (member '("Found" "Failure"))
- (dbus-register-signal
- :system zeroconf-service-avahi object-path
- zeroconf-interface-avahi-service-resolver member
- 'zeroconf-service-resolver-handler)))
- )
-
;; Return the resolved service.
(puthash key result zeroconf-resolved-services-hash))))))
(defun org-babel-lua-initiate-session (&optional session _params)
"Create a session named SESSION according to PARAMS."
(unless (string= session "none")
- (error "Sessions currently not supported, work in progress")
- (org-babel-lua-session-buffer
- (org-babel-lua-initiate-session-by-key session))))
+ (error "Sessions currently not supported, work in progress")))
(defvar org-babel-lua-eoe-indicator "--eoe"
"A string to indicate that evaluation has completed.")
(file-name-nondirectory
(buffer-file-name
(or (buffer-base-buffer)
- (current-buffer)
- (and (org-src-edit-buffer-p)
- (org-src-source-buffer))))))
+ (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
:link (concat "irc:/" link-text)
:description (concat "irc session `" link-text "'")
:server (car (car link))
- :port (or (string-to-number (cadr (pop link))) erc-default-port)
+ :port (or (string-to-number (cadr (pop link))))
:nick (pop link))
t)
(error "Failed to create ('irc:/' style) ERC link")))))
(pcase (org-element-type ,node)
(`nil ,dflt)
(`plain-text
- (or (get-text-property 0 ,property ,node)
- (when ,dflt
- (if
- ;; FIXME: Byte-compiler throws false positives in Emacs 27.
- (with-no-warnings
- (plist-member (text-properties-at 0 ,node) ,property))
- nil ,dflt))))
+ ,(if (byte-compile-nilconstp dflt)
+ (inline-quote (get-text-property 0 ,property ,node))
+ (inline-quote
+ (or (get-text-property 0 ,property ,node)
+ (if
+ ;; FIXME: Byte-compiler throws false positives in Emacs 27.
+ (with-no-warnings
+ (plist-member (text-properties-at 0 ,node) ,property))
+ nil ,dflt)))))
(_
- (or (plist-get (nth 1 ,node) ,property)
- (when ,dflt
- (if
- ;; FIXME: Byte-compiler throws false positives in Emacs 27.
- (with-no-warnings
- (plist-member (nth 1 ,node) ,property))
- nil ,dflt))))))))
+ ,(if (byte-compile-nilconstp dflt)
+ (inline-quote (plist-get (nth 1 ,node) ,property))
+ (inline-quote
+ (or (plist-get (nth 1 ,node) ,property)
+ (if
+ ;; FIXME: Byte-compiler throws false positives in Emacs 27.
+ (with-no-warnings
+ (plist-member (nth 1 ,node) ,property))
+ nil ,dflt)))))))))
(define-inline org-element-property-raw (property node &optional dflt)
"Extract the value for PROPERTY of an NODE.
projects / emacs.git / commitdiff